xref: /csrg-svn/local/transcript/lib/psdit.pro (revision 32181)
1*32181Sedward%	@(#)psdit.pro	1.2 09/15/87
232175Sedward% lib/psdit.pro -- prolog for psdit (ditroff) files
332175Sedward% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved.
432175Sedward% last edit: shore Sat Nov 23 20:28:03 1985
532175Sedward% RCSID: $Header: psdit.pro,v 2.1 85/11/24 12:19:43 shore Rel $
632175Sedward
7*32181Sedward% Changed by Edward Wang (edward@ucbarpa.berkeley.edu) to handle graphics,
8*32181Sedward% 17 Feb, 87.
9*32181Sedward
1032175Sedward/$DITroff 140 dict def $DITroff begin
1132175Sedward/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def
12*32181Sedward/xi{0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto
13*32181Sedward /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F
14*32181Sedward /pagesave save def}def
1532175Sedward/PB{save /psv exch def currentpoint translate
16*32181Sedward resolution 72 div dup neg scale 0 0 moveto}def
1732175Sedward/PE{psv restore}def
1832175Sedward/arctoobig 90 def /arctoosmall .05 def
1932175Sedward/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def
2032175Sedward/tan{dup sin exch cos div}def
2132175Sedward/point{resolution 72 div mul}def
2232175Sedward/dround	{transform round exch round exch itransform}def
2332175Sedward/xT{/devname exch def}def
2432175Sedward/xr{/mh exch def /my exch def /resolution exch def}def
2532175Sedward/xp{}def
2632175Sedward/xs{docsave restore end}def
2732175Sedward/xt{}def
2832175Sedward/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not
2932175Sedward {fonts slotno fontname findfont put fontnames slotno fontname put}if}def
3032175Sedward/xH{/fontheight exch def F}def
3132175Sedward/xS{/fontslant exch def F}def
3232175Sedward/s{/fontsize exch def /fontheight fontsize def F}def
3332175Sedward/f{/fontnum exch def F}def
34*32181Sedward/F{fontheight 0 le{/fontheight fontsize def}if
35*32181Sedward fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore
36*32181Sedward fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if
37*32181Sedward makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def
3832175Sedward/X{exch currentpoint exch pop moveto show}def
3932175Sedward/N{3 1 roll moveto show}def
4032175Sedward/Y{exch currentpoint pop exch moveto show}def
4132175Sedward/S{show}def
4232175Sedward/ditpush{}def/ditpop{}def
4332175Sedward/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def
4432175Sedward/AN{4 2 roll moveto 0 exch ashow}def
4532175Sedward/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def
4632175Sedward/AS{0 exch ashow}def
4732175Sedward/MX{currentpoint exch pop moveto}def
4832175Sedward/MY{currentpoint pop exch moveto}def
4932175Sedward/MXY{moveto}def
5032175Sedward/cb{pop}def	% action on unknown char -- nothing for now
5132175Sedward/n{}def/w{}def
5232175Sedward/p{pop showpage pagesave restore /pagesave save def}def
53*32181Sedward/Dt{/Dlinewidth exch def}def 1 Dt
54*32181Sedward/Ds{/Ddash exch def}def -1 Ds
55*32181Sedward/Di{/Dstipple exch def}def 1 Di
56*32181Sedward/Dsetlinewidth{2 Dlinewidth mul setlinewidth}def
57*32181Sedward/Dsetdash{Ddash 4 eq{[8 12]}{Ddash 16 eq{[32 36]}
58*32181Sedward {Ddash 20 eq{[32 12 8 12]}{[]}ifelse}ifelse}ifelse 0 setdash}def
59*32181Sedward/Dstroke{gsave Dsetlinewidth Dsetdash 1 setlinecap stroke grestore
60*32181Sedward currentpoint newpath moveto}def
61*32181Sedward/Dl{rlineto Dstroke}def
6232175Sedward/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop
6332175Sedward currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def
6432175Sedward currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def
65*32181Sedward/Dc{dup arcellipse Dstroke}def
66*32181Sedward/De{arcellipse Dstroke}def
6732175Sedward/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def
6832175Sedward /cradius centerv centerv mul centerh centerh mul add sqrt def
6932175Sedward /eradius endv endv mul endh endh mul add sqrt def
7032175Sedward /endang endv endh atan def
7132175Sedward /startang centerv neg centerh neg atan def
7232175Sedward /sweep startang endang sub dup 0 lt{360 add}if def
7332175Sedward sweep arctoobig gt
7432175Sedward {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def
7532175Sedward  /midh midang cos midrad mul def /midv midang sin midrad mul def
7632175Sedward  midh neg midv neg endh endv centerh centerv midh midv Da
77*32181Sedward  Da}
7832175Sedward {sweep arctoosmall ge
7932175Sedward  {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def
80*32181Sedward   centerv neg controldelt mul centerh controldelt mul
81*32181Sedward   endv neg controldelt mul centerh add endh add
82*32181Sedward   endh controldelt mul centerv add endv add
83*32181Sedward   centerh endh add centerv endv add rcurveto Dstroke}
84*32181Sedward  {centerh endh add centerv endv add rlineto Dstroke}
85*32181Sedward  ifelse}
86*32181Sedward ifelse}def
87*32181Sedward/Dpatterns[
88*32181Sedward[%cf[widthbits]
89*32181Sedward[8<0000000000000010>]
90*32181Sedward[8<0411040040114000>]
91*32181Sedward[8<0204081020408001>]
92*32181Sedward[8<0000103810000000>]
93*32181Sedward[8<6699996666999966>]
94*32181Sedward[8<0000800100001008>]
95*32181Sedward[8<81c36666c3810000>]
96*32181Sedward[8<0f0e0c0800000000>]
97*32181Sedward[8<0000000000000010>]
98*32181Sedward[8<0411040040114000>]
99*32181Sedward[8<0204081020408001>]
100*32181Sedward[8<0000001038100000>]
101*32181Sedward[8<6699996666999966>]
102*32181Sedward[8<0000800100001008>]
103*32181Sedward[8<81c36666c3810000>]
104*32181Sedward[8<0f0e0c0800000000>]
105*32181Sedward[8<0042660000246600>]
106*32181Sedward[8<0000990000990000>]
107*32181Sedward[8<0804020180402010>]
108*32181Sedward[8<2418814242811824>]
109*32181Sedward[8<6699996666999966>]
110*32181Sedward[8<8000000008000000>]
111*32181Sedward[8<00001c3e363e1c00>]
112*32181Sedward[8<0000000000000000>]
113*32181Sedward[32<00000040000000c00000004000000040000000e0000000000000000000000000>]
114*32181Sedward[32<00000000000060000000900000002000000040000000f0000000000000000000>]
115*32181Sedward[32<000000000000000000e0000000100000006000000010000000e0000000000000>]
116*32181Sedward[32<00000000000000002000000060000000a0000000f00000002000000000000000>]
117*32181Sedward[32<0000000e0000000000000000000000000000000f000000080000000e00000001>]
118*32181Sedward[32<0000090000000600000000000000000000000000000007000000080000000e00>]
119*32181Sedward[32<00010000000200000004000000040000000000000000000000000000000f0000>]
120*32181Sedward[32<0900000006000000090000000600000000000000000000000000000006000000>]]
121*32181Sedward[%ug
122*32181Sedward[8<0000020000000000>]
123*32181Sedward[8<0000020000002000>]
124*32181Sedward[8<0004020000002000>]
125*32181Sedward[8<0004020000402000>]
126*32181Sedward[8<0004060000402000>]
127*32181Sedward[8<0004060000406000>]
128*32181Sedward[8<0006060000406000>]
129*32181Sedward[8<0006060000606000>]
130*32181Sedward[8<00060e0000606000>]
131*32181Sedward[8<00060e000060e000>]
132*32181Sedward[8<00070e000060e000>]
133*32181Sedward[8<00070e000070e000>]
134*32181Sedward[8<00070e020070e000>]
135*32181Sedward[8<00070e020070e020>]
136*32181Sedward[8<04070e020070e020>]
137*32181Sedward[8<04070e024070e020>]
138*32181Sedward[8<04070e064070e020>]
139*32181Sedward[8<04070e064070e060>]
140*32181Sedward[8<06070e064070e060>]
141*32181Sedward[8<06070e066070e060>]
142*32181Sedward[8<06070f066070e060>]
143*32181Sedward[8<06070f066070f060>]
144*32181Sedward[8<060f0f066070f060>]
145*32181Sedward[8<060f0f0660f0f060>]
146*32181Sedward[8<060f0f0760f0f060>]
147*32181Sedward[8<060f0f0760f0f070>]
148*32181Sedward[8<0e0f0f0760f0f070>]
149*32181Sedward[8<0e0f0f07e0f0f070>]
150*32181Sedward[8<0e0f0f0fe0f0f070>]
151*32181Sedward[8<0e0f0f0fe0f0f0f0>]
152*32181Sedward[8<0f0f0f0fe0f0f0f0>]
153*32181Sedward[8<0f0f0f0ff0f0f0f0>]
154*32181Sedward[8<1f0f0f0ff0f0f0f0>]
155*32181Sedward[8<1f0f0f0ff1f0f0f0>]
156*32181Sedward[8<1f0f0f8ff1f0f0f0>]
157*32181Sedward[8<1f0f0f8ff1f0f0f8>]
158*32181Sedward[8<9f0f0f8ff1f0f0f8>]
159*32181Sedward[8<9f0f0f8ff9f0f0f8>]
160*32181Sedward[8<9f0f0f9ff9f0f0f8>]
161*32181Sedward[8<9f0f0f9ff9f0f0f9>]
162*32181Sedward[8<9f8f0f9ff9f0f0f9>]
163*32181Sedward[8<9f8f0f9ff9f8f0f9>]
164*32181Sedward[8<9f8f1f9ff9f8f0f9>]
165*32181Sedward[8<9f8f1f9ff9f8f1f9>]
166*32181Sedward[8<bf8f1f9ff9f8f1f9>]
167*32181Sedward[8<bf8f1f9ffbf8f1f9>]
168*32181Sedward[8<bf8f1fdffbf8f1f9>]
169*32181Sedward[8<bf8f1fdffbf8f1fd>]
170*32181Sedward[8<ff8f1fdffbf8f1fd>]
171*32181Sedward[8<ff8f1fdffff8f1fd>]
172*32181Sedward[8<ff8f1ffffff8f1fd>]
173*32181Sedward[8<ff8f1ffffff8f1ff>]
174*32181Sedward[8<ff9f1ffffff8f1ff>]
175*32181Sedward[8<ff9f1ffffff9f1ff>]
176*32181Sedward[8<ff9f9ffffff9f1ff>]
177*32181Sedward[8<ff9f9ffffff9f9ff>]
178*32181Sedward[8<ffbf9ffffff9f9ff>]
179*32181Sedward[8<ffbf9ffffffbf9ff>]
180*32181Sedward[8<ffbfdffffffbf9ff>]
181*32181Sedward[8<ffbfdffffffbfdff>]
182*32181Sedward[8<ffffdffffffbfdff>]
183*32181Sedward[8<ffffdffffffffdff>]
184*32181Sedward[8<fffffffffffffdff>]
185*32181Sedward[8<ffffffffffffffff>]]
186*32181Sedward[%mg
187*32181Sedward[8<8000000000000000>]
188*32181Sedward[8<0822080080228000>]
189*32181Sedward[8<0204081020408001>]
190*32181Sedward[8<40e0400000000000>]
191*32181Sedward[8<66999966>]
192*32181Sedward[8<8001000010080000>]
193*32181Sedward[8<81c36666c3810000>]
194*32181Sedward[8<f0e0c08000000000>]
195*32181Sedward[16<07c00f801f003e007c00f800f001e003c007800f001f003e007c00f801f003e0>]
196*32181Sedward[16<1f000f8007c003e001f000f8007c003e001f800fc007e003f001f8007c003e00>]
197*32181Sedward[8<c3c300000000c3c3>]
198*32181Sedward[16<0040008001000200040008001000200040008000000100020004000800100020>]
199*32181Sedward[16<0040002000100008000400020001800040002000100008000400020001000080>]
200*32181Sedward[16<1fc03fe07df0f8f8f07de03fc01f800fc01fe03ff07df8f87df03fe01fc00f80>]
201*32181Sedward[8<80>]
202*32181Sedward[8<8040201000000000>]
203*32181Sedward[8<84cc000048cc0000>]
204*32181Sedward[8<9900009900000000>]
205*32181Sedward[8<08040201804020100800020180002010>]
206*32181Sedward[8<2418814242811824>]
207*32181Sedward[8<66999966>]
208*32181Sedward[8<8000000008000000>]
209*32181Sedward[8<70f8d8f870000000>]
210*32181Sedward[8<0814224180402010>]
211*32181Sedward[8<aa00440a11a04400>]
212*32181Sedward[8<018245aa45820100>]
213*32181Sedward[8<221c224180808041>]
214*32181Sedward[8<88000000>]
215*32181Sedward[8<0855800080550800>]
216*32181Sedward[8<2844004482440044>]
217*32181Sedward[8<0810204080412214>]
218*32181Sedward[8<00>]]]def
219*32181Sedward/Dfill{
220*32181Sedward transform /maxy exch def /maxx exch def
221*32181Sedward transform /miny exch def /minx exch def
222*32181Sedward minx maxx gt{/minx maxx /maxx minx def def}if
223*32181Sedward miny maxy gt{/miny maxy /maxy miny def def}if
224*32181Sedward Dpatterns Dstipple 1 sub get exch 1 sub get
225*32181Sedward aload pop /stip exch def /stipw exch def /stiph 128 def
226*32181Sedward /imatrix[stipw 0 0 stiph 0 0]def
227*32181Sedward /tmatrix[stipw 0 0 stiph 0 0]def
228*32181Sedward /minx minx cvi stiph idiv stiph mul def
229*32181Sedward /miny miny cvi stipw idiv stipw mul def
230*32181Sedward gsave eoclip 0 setgray
231*32181Sedward miny stiph maxy{
232*32181Sedward  tmatrix exch 5 exch put
233*32181Sedward  minx stipw maxx{
234*32181Sedward   tmatrix exch 4 exch put tmatrix setmatrix
235*32181Sedward   stipw stiph true imatrix {stip} imagemask
236*32181Sedward  }for
237*32181Sedward }for
238*32181Sedward grestore
239*32181Sedward}def
240*32181Sedward/Dp{Dfill Dstroke}def
241*32181Sedward/DP{Dfill currentpoint newpath moveto}def
242*32181Sedwardend
24332175Sedward
24432175Sedward/ditstart{$DITroff begin
24532175Sedward /nfonts 60 def			% NFONTS makedev/ditroff dependent!
24632175Sedward /fonts[nfonts{0}repeat]def
24732175Sedward /fontnames[nfonts{()}repeat]def
24832175Sedward/docsave save def
24932175Sedward}def
25032175Sedward
25132175Sedward% character outcalls
252*32181Sedward/oc{
253*32181Sedward /pswid exch def /cc exch def /name exch def
254*32181Sedward /ditwid pswid fontsize mul resolution mul 72000 div def
255*32181Sedward /ditsiz fontsize resolution mul 72 div def
256*32181Sedward ocprocs name known{ocprocs name get exec}{name cb}ifelse
257*32181Sedward}def
25832175Sedward/fractm [.65 0 0 .6 0 0] def
259*32181Sedward/fraction{
260*32181Sedward /fden exch def /fnum exch def gsave /cf currentfont def
261*32181Sedward cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto
262*32181Sedward fnum show rmoveto currentfont cf setfont(\244)show setfont fden show
263*32181Sedward grestore ditwid 0 rmoveto
264*32181Sedward}def
265*32181Sedward/oce{grestore ditwid 0 rmoveto}def
266*32181Sedward/dm{ditsiz mul}def
26732175Sedward/ocprocs 50 dict def ocprocs begin
26832175Sedward(14){(1)(4)fraction}def
26932175Sedward(12){(1)(2)fraction}def
27032175Sedward(34){(3)(4)fraction}def
27132175Sedward(13){(1)(3)fraction}def
27232175Sedward(23){(2)(3)fraction}def
27332175Sedward(18){(1)(8)fraction}def
27432175Sedward(38){(3)(8)fraction}def
27532175Sedward(58){(5)(8)fraction}def
27632175Sedward(78){(7)(8)fraction}def
27732175Sedward(sr){gsave 0 .06 dm rmoveto(\326)show oce}def
27832175Sedward(is){gsave 0 .15 dm rmoveto(\362)show oce}def
27932175Sedward(->){gsave 0 .02 dm rmoveto(\256)show oce}def
28032175Sedward(<-){gsave 0 .02 dm rmoveto(\254)show oce}def
28132175Sedward(==){gsave 0 .05 dm rmoveto(\272)show oce}def
28232175Sedwardend
28332175Sedward
28432175Sedward% an attempt at a PostScript FONT to implement ditroff special chars
28532175Sedward% this will enable us to
28632175Sedward%	cache the little buggers
28732175Sedward%	generate faster, more compact PS out of psdit
28832175Sedward%	confuse everyone (including myself)!
28932175Sedward50 dict dup begin
29032175Sedward/FontType 3 def
29132175Sedward/FontName /DIThacks def
29232175Sedward/FontMatrix [.001 0 0 .001 0 0] def
29332175Sedward/FontBBox [-260 -260 900 900] def% a lie but ...
29432175Sedward/Encoding 256 array def
29532175Sedward0 1 255{Encoding exch /.notdef put}for
29632175SedwardEncoding
29732175Sedward dup 8#040/space put %space
29832175Sedward dup 8#110/rc put %right ceil
29932175Sedward dup 8#111/lt put %left  top curl
30032175Sedward dup 8#112/bv put %bold vert
30132175Sedward dup 8#113/lk put %left  mid curl
30232175Sedward dup 8#114/lb put %left  bot curl
30332175Sedward dup 8#115/rt put %right top curl
30432175Sedward dup 8#116/rk put %right mid curl
30532175Sedward dup 8#117/rb put %right bot curl
30632175Sedward dup 8#120/rf put %right floor
30732175Sedward dup 8#121/lf put %left  floor
30832175Sedward dup 8#122/lc put %left  ceil
30932175Sedward dup 8#140/sq put %square
31032175Sedward dup 8#141/bx put %box
31132175Sedward dup 8#142/ci put %circle
31232175Sedward dup 8#143/br put %box rule
31332175Sedward dup 8#144/rn put %root extender
31432175Sedward dup 8#145/vr put %vertical rule
31532175Sedward dup 8#146/ob put %outline bullet
31632175Sedward dup 8#147/bu put %bullet
31732175Sedward dup 8#150/ru put %rule
31832175Sedward dup 8#151/ul put %underline
31932175Sedward pop
32032175Sedward/DITfd 100 dict def
32132175Sedward/BuildChar{0 begin
32232175Sedward /cc exch def /fd exch def
32332175Sedward /charname fd /Encoding get cc get def
32432175Sedward /charwid fd /Metrics get charname get def
32532175Sedward /charproc fd /CharProcs get charname get def
32632175Sedward charwid 0 fd /FontBBox get aload pop setcachedevice
32732175Sedward 2 setlinejoin 40 setlinewidth
32832175Sedward newpath 0 0 moveto gsave charproc grestore
32932175Sedward end}def
33032175Sedward/BuildChar load 0 DITfd put
33132175Sedward/CharProcs 50 dict def
33232175SedwardCharProcs begin
33332175Sedward/space{}def
33432175Sedward/.notdef{}def
33532175Sedward/ru{500 0 rls}def
33632175Sedward/rn{0 840 moveto 500 0 rls}def
33732175Sedward/vr{0 800 moveto 0 -770 rls}def
33832175Sedward/bv{0 800 moveto 0 -1000 rls}def
339*32181Sedward/br{0 840 moveto 0 -1000 rls}def
34032175Sedward/ul{0 -140 moveto 500 0 rls}def
34132175Sedward/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def
34232175Sedward/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def
34332175Sedward/sq{80 0 rmoveto currentpoint dround newpath moveto
34432175Sedward    640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def
34532175Sedward/bx{80 0 rmoveto currentpoint dround newpath moveto
34632175Sedward    640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def
34732175Sedward/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc
34832175Sedward    50 setlinewidth stroke}def
34932175Sedward
35032175Sedward/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def
35132175Sedward/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def
35232175Sedward/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def
35332175Sedward/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def
35432175Sedward/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub
35532175Sedward    0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def
35632175Sedward/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub
35732175Sedward    0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def
35832175Sedward/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def
35932175Sedward/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def
36032175Sedward/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def
36132175Sedward/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def
36232175Sedwardend
36332175Sedward
36432175Sedward/Metrics 50 dict def Metrics begin
36532175Sedward/.notdef 0 def
36632175Sedward/space 500 def
36732175Sedward/ru 500 def
36832175Sedward/br 0 def
36932175Sedward/lt 416 def
37032175Sedward/lb 416 def
37132175Sedward/rt 416 def
37232175Sedward/rb 416 def
37332175Sedward/lk 416 def
37432175Sedward/rk 416 def
37532175Sedward/rc 416 def
37632175Sedward/lc 416 def
37732175Sedward/rf 416 def
37832175Sedward/lf 416 def
37932175Sedward/bv 416 def
38032175Sedward/ob 350 def
38132175Sedward/bu 350 def
38232175Sedward/ci 750 def
38332175Sedward/bx 750 def
38432175Sedward/sq 750 def
38532175Sedward/rn 500 def
38632175Sedward/ul 500 def
38732175Sedward/vr 0 def
38832175Sedwardend
38932175Sedward
39032175SedwardDITfd begin
39132175Sedward/s2 500 def /s4 250 def /s3 333 def
39232175Sedward/a4p{arcto pop pop pop pop}def
39332175Sedward/2cx{2 copy exch}def
39432175Sedward/rls{rlineto stroke}def
39532175Sedward/currx{currentpoint pop}def
39632175Sedward/dround{transform round exch round exch itransform} def
39732175Sedwardend
39832175Sedwardend
39932175Sedward/DIThacks exch definefont pop
400