xref: /original-bsd/local/transcript/lib/psdit.pro (revision 5d3a6356)
1%	@(#)psdit.pro	1.3 04/15/88
2% lib/psdit.pro -- prolog for psdit (ditroff) files
3% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved.
4% last edit: shore Sat Nov 23 20:28:03 1985
5% RCSID: $Header: psdit.pro,v 2.1 85/11/24 12:19:43 shore Rel $
6
7% Changed by Edward Wang (edward@ucbarpa.berkeley.edu) to handle graphics,
8% 17 Feb, 87.
9
10/$DITroff 140 dict def $DITroff begin
11/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def
12/xi{0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto
13 /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F
14 /pagesave save def}def
15/PB{save /psv exch def currentpoint translate
16 resolution 72 div dup neg scale 0 0 moveto}def
17/PE{psv restore}def
18/arctoobig 90 def /arctoosmall .05 def
19/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def
20/tan{dup sin exch cos div}def
21/point{resolution 72 div mul}def
22/dround	{transform round exch round exch itransform}def
23/xT{/devname exch def}def
24/xr{/mh exch def /my exch def /resolution exch def}def
25/xp{}def
26/xs{docsave restore end}def
27/xt{}def
28/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not
29 {fonts slotno fontname findfont put fontnames slotno fontname put}if}def
30/xH{/fontheight exch def F}def
31/xS{/fontslant exch def F}def
32/s{/fontsize exch def /fontheight fontsize def F}def
33/f{/fontnum exch def F}def
34/F{fontheight 0 le{/fontheight fontsize def}if
35 fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore
36 fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if
37 makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def
38/X{exch currentpoint exch pop moveto show}def
39/N{3 1 roll moveto show}def
40/Y{exch currentpoint pop exch moveto show}def
41/S{show}def
42/ditpush{}def/ditpop{}def
43/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def
44/AN{4 2 roll moveto 0 exch ashow}def
45/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def
46/AS{0 exch ashow}def
47/MX{currentpoint exch pop moveto}def
48/MY{currentpoint pop exch moveto}def
49/MXY{moveto}def
50/cb{pop}def	% action on unknown char -- nothing for now
51/n{}def/w{}def
52/p{pop showpage pagesave restore /pagesave save def}def
53/Dt{/Dlinewidth exch def}def 1 Dt
54/Ds{/Ddash exch def}def -1 Ds
55/Di{/Dstipple exch def}def 1 Di
56/Dsetlinewidth{2 Dlinewidth mul setlinewidth}def
57/Dsetdash{Ddash 4 eq{[8 12]}{Ddash 16 eq{[32 36]}
58 {Ddash 20 eq{[32 12 8 12]}{[]}ifelse}ifelse}ifelse 0 setdash}def
59/Dstroke{gsave Dsetlinewidth Dsetdash 1 setlinecap stroke grestore
60 currentpoint newpath moveto}def
61/Dl{rlineto Dstroke}def
62/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop
63 currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def
64 currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def
65/Dc{dup arcellipse Dstroke}def
66/De{arcellipse Dstroke}def
67/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def
68 /cradius centerv centerv mul centerh centerh mul add sqrt def
69 /eradius endv endv mul endh endh mul add sqrt def
70 /endang endv endh atan def
71 /startang centerv neg centerh neg atan def
72 /sweep startang endang sub dup 0 lt{360 add}if def
73 sweep arctoobig gt
74 {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def
75  /midh midang cos midrad mul def /midv midang sin midrad mul def
76  midh neg midv neg endh endv centerh centerv midh midv Da
77  Da}
78 {sweep arctoosmall ge
79  {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def
80   centerv neg controldelt mul centerh controldelt mul
81   endv neg controldelt mul centerh add endh add
82   endh controldelt mul centerv add endv add
83   centerh endh add centerv endv add rcurveto Dstroke}
84  {centerh endh add centerv endv add rlineto Dstroke}
85  ifelse}
86 ifelse}def
87/Dpatterns[
88[%cf[widthbits]
89[8<0000000000000010>]
90[8<0411040040114000>]
91[8<0204081020408001>]
92[8<0000103810000000>]
93[8<6699996666999966>]
94[8<0000800100001008>]
95[8<81c36666c3810000>]
96[8<0f0e0c0800000000>]
97[8<0000000000000010>]
98[8<0411040040114000>]
99[8<0204081020408001>]
100[8<0000001038100000>]
101[8<6699996666999966>]
102[8<0000800100001008>]
103[8<81c36666c3810000>]
104[8<0f0e0c0800000000>]
105[8<0042660000246600>]
106[8<0000990000990000>]
107[8<0804020180402010>]
108[8<2418814242811824>]
109[8<6699996666999966>]
110[8<8000000008000000>]
111[8<00001c3e363e1c00>]
112[8<0000000000000000>]
113[32<00000040000000c00000004000000040000000e0000000000000000000000000>]
114[32<00000000000060000000900000002000000040000000f0000000000000000000>]
115[32<000000000000000000e0000000100000006000000010000000e0000000000000>]
116[32<00000000000000002000000060000000a0000000f00000002000000000000000>]
117[32<0000000e0000000000000000000000000000000f000000080000000e00000001>]
118[32<0000090000000600000000000000000000000000000007000000080000000e00>]
119[32<00010000000200000004000000040000000000000000000000000000000f0000>]
120[32<0900000006000000090000000600000000000000000000000000000006000000>]]
121[%ug
122[8<0000020000000000>]
123[8<0000020000002000>]
124[8<0004020000002000>]
125[8<0004020000402000>]
126[8<0004060000402000>]
127[8<0004060000406000>]
128[8<0006060000406000>]
129[8<0006060000606000>]
130[8<00060e0000606000>]
131[8<00060e000060e000>]
132[8<00070e000060e000>]
133[8<00070e000070e000>]
134[8<00070e020070e000>]
135[8<00070e020070e020>]
136[8<04070e020070e020>]
137[8<04070e024070e020>]
138[8<04070e064070e020>]
139[8<04070e064070e060>]
140[8<06070e064070e060>]
141[8<06070e066070e060>]
142[8<06070f066070e060>]
143[8<06070f066070f060>]
144[8<060f0f066070f060>]
145[8<060f0f0660f0f060>]
146[8<060f0f0760f0f060>]
147[8<060f0f0760f0f070>]
148[8<0e0f0f0760f0f070>]
149[8<0e0f0f07e0f0f070>]
150[8<0e0f0f0fe0f0f070>]
151[8<0e0f0f0fe0f0f0f0>]
152[8<0f0f0f0fe0f0f0f0>]
153[8<0f0f0f0ff0f0f0f0>]
154[8<1f0f0f0ff0f0f0f0>]
155[8<1f0f0f0ff1f0f0f0>]
156[8<1f0f0f8ff1f0f0f0>]
157[8<1f0f0f8ff1f0f0f8>]
158[8<9f0f0f8ff1f0f0f8>]
159[8<9f0f0f8ff9f0f0f8>]
160[8<9f0f0f9ff9f0f0f8>]
161[8<9f0f0f9ff9f0f0f9>]
162[8<9f8f0f9ff9f0f0f9>]
163[8<9f8f0f9ff9f8f0f9>]
164[8<9f8f1f9ff9f8f0f9>]
165[8<9f8f1f9ff9f8f1f9>]
166[8<bf8f1f9ff9f8f1f9>]
167[8<bf8f1f9ffbf8f1f9>]
168[8<bf8f1fdffbf8f1f9>]
169[8<bf8f1fdffbf8f1fd>]
170[8<ff8f1fdffbf8f1fd>]
171[8<ff8f1fdffff8f1fd>]
172[8<ff8f1ffffff8f1fd>]
173[8<ff8f1ffffff8f1ff>]
174[8<ff9f1ffffff8f1ff>]
175[8<ff9f1ffffff9f1ff>]
176[8<ff9f9ffffff9f1ff>]
177[8<ff9f9ffffff9f9ff>]
178[8<ffbf9ffffff9f9ff>]
179[8<ffbf9ffffffbf9ff>]
180[8<ffbfdffffffbf9ff>]
181[8<ffbfdffffffbfdff>]
182[8<ffffdffffffbfdff>]
183[8<ffffdffffffffdff>]
184[8<fffffffffffffdff>]
185[8<ffffffffffffffff>]]
186[%mg
187[8<8000000000000000>]
188[8<0822080080228000>]
189[8<0204081020408001>]
190[8<40e0400000000000>]
191[8<66999966>]
192[8<8001000010080000>]
193[8<81c36666c3810000>]
194[8<f0e0c08000000000>]
195[16<07c00f801f003e007c00f800f001e003c007800f001f003e007c00f801f003e0>]
196[16<1f000f8007c003e001f000f8007c003e001f800fc007e003f001f8007c003e00>]
197[8<c3c300000000c3c3>]
198[16<0040008001000200040008001000200040008000000100020004000800100020>]
199[16<0040002000100008000400020001800040002000100008000400020001000080>]
200[16<1fc03fe07df0f8f8f07de03fc01f800fc01fe03ff07df8f87df03fe01fc00f80>]
201[8<80>]
202[8<8040201000000000>]
203[8<84cc000048cc0000>]
204[8<9900009900000000>]
205[8<08040201804020100800020180002010>]
206[8<2418814242811824>]
207[8<66999966>]
208[8<8000000008000000>]
209[8<70f8d8f870000000>]
210[8<0814224180402010>]
211[8<aa00440a11a04400>]
212[8<018245aa45820100>]
213[8<221c224180808041>]
214[8<88000000>]
215[8<0855800080550800>]
216[8<2844004482440044>]
217[8<0810204080412214>]
218[8<00>]]]def
219/Dfill{
220 transform /maxy exch def /maxx exch def
221 transform /miny exch def /minx exch def
222 minx maxx gt{/minx maxx /maxx minx def def}if
223 miny maxy gt{/miny maxy /maxy miny def def}if
224 Dpatterns Dstipple 1 sub get exch 1 sub get
225 aload pop /stip exch def /stipw exch def /stiph 128 def
226 /imatrix[stipw 0 0 stiph 0 0]def
227 /tmatrix[stipw 0 0 stiph 0 0]def
228 /minx minx cvi stiph idiv stiph mul def
229 /miny miny cvi stipw idiv stipw mul def
230 gsave eoclip 0 setgray
231 miny stiph maxy{
232  tmatrix exch 5 exch put
233  minx stipw maxx{
234   tmatrix exch 4 exch put tmatrix setmatrix
235   stipw stiph true imatrix {stip} imagemask
236  }for
237 }for
238 grestore
239}def
240/Dp{Dfill Dstroke}def
241/DP{Dfill currentpoint newpath moveto}def
242end
243
244/ditstart{$DITroff begin
245 /nfonts 60 def			% NFONTS makedev/ditroff dependent!
246 /fonts[nfonts{0}repeat]def
247 /fontnames[nfonts{()}repeat]def
248/docsave save def
249}def
250
251% character outcalls
252/oc{
253 /pswid exch def /cc exch def /name exch def
254 /ditwid pswid fontsize mul resolution mul 72000 div def
255 /ditsiz fontsize resolution mul 72 div def
256 ocprocs name known{ocprocs name get exec}{name cb}ifelse
257}def
258/fractm [.65 0 0 .6 0 0] def
259/fraction{
260 /fden exch def /fnum exch def gsave /cf currentfont def
261 cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto
262 fnum show rmoveto currentfont cf setfont(\244)show setfont fden show
263 grestore ditwid 0 rmoveto
264}def
265/oce{grestore ditwid 0 rmoveto}def
266/dm{ditsiz mul}def
267/ocprocs 50 dict def ocprocs begin
268(14){(1)(4)fraction}def
269(12){(1)(2)fraction}def
270(34){(3)(4)fraction}def
271(13){(1)(3)fraction}def
272(23){(2)(3)fraction}def
273(18){(1)(8)fraction}def
274(38){(3)(8)fraction}def
275(58){(5)(8)fraction}def
276(78){(7)(8)fraction}def
277(sr){gsave 0 .06 dm rmoveto(\326)show oce}def
278(is){gsave 0 .15 dm rmoveto(\362)show oce}def
279(->){gsave 0 .02 dm rmoveto(\256)show oce}def
280(<-){gsave 0 .02 dm rmoveto(\254)show oce}def
281(==){gsave 0 .05 dm rmoveto(\272)show oce}def
282(uc){gsave currentpoint 400 .009 dm mul add translate
283     8 -8 scale ucseal oce}def
284end
285
286% an attempt at a PostScript FONT to implement ditroff special chars
287% this will enable us to
288%	cache the little buggers
289%	generate faster, more compact PS out of psdit
290%	confuse everyone (including myself)!
29150 dict dup begin
292/FontType 3 def
293/FontName /DIThacks def
294/FontMatrix [.001 0 0 .001 0 0] def
295/FontBBox [-260 -260 900 900] def% a lie but ...
296/Encoding 256 array def
2970 1 255{Encoding exch /.notdef put}for
298Encoding
299 dup 8#040/space put %space
300 dup 8#110/rc put %right ceil
301 dup 8#111/lt put %left  top curl
302 dup 8#112/bv put %bold vert
303 dup 8#113/lk put %left  mid curl
304 dup 8#114/lb put %left  bot curl
305 dup 8#115/rt put %right top curl
306 dup 8#116/rk put %right mid curl
307 dup 8#117/rb put %right bot curl
308 dup 8#120/rf put %right floor
309 dup 8#121/lf put %left  floor
310 dup 8#122/lc put %left  ceil
311 dup 8#140/sq put %square
312 dup 8#141/bx put %box
313 dup 8#142/ci put %circle
314 dup 8#143/br put %box rule
315 dup 8#144/rn put %root extender
316 dup 8#145/vr put %vertical rule
317 dup 8#146/ob put %outline bullet
318 dup 8#147/bu put %bullet
319 dup 8#150/ru put %rule
320 dup 8#151/ul put %underline
321 pop
322/DITfd 100 dict def
323/BuildChar{0 begin
324 /cc exch def /fd exch def
325 /charname fd /Encoding get cc get def
326 /charwid fd /Metrics get charname get def
327 /charproc fd /CharProcs get charname get def
328 charwid 0 fd /FontBBox get aload pop setcachedevice
329 2 setlinejoin 40 setlinewidth
330 newpath 0 0 moveto gsave charproc grestore
331 end}def
332/BuildChar load 0 DITfd put
333/CharProcs 50 dict def
334CharProcs begin
335/space{}def
336/.notdef{}def
337/ru{500 0 rls}def
338/rn{0 840 moveto 500 0 rls}def
339/vr{0 800 moveto 0 -770 rls}def
340/bv{0 800 moveto 0 -1000 rls}def
341/br{0 840 moveto 0 -1000 rls}def
342/ul{0 -140 moveto 500 0 rls}def
343/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def
344/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def
345/sq{80 0 rmoveto currentpoint dround newpath moveto
346    640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def
347/bx{80 0 rmoveto currentpoint dround newpath moveto
348    640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def
349/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc
350    50 setlinewidth stroke}def
351
352/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def
353/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def
354/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def
355/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def
356/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub
357    0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def
358/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub
359    0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def
360/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def
361/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def
362/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def
363/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def
364end
365
366/Metrics 50 dict def Metrics begin
367/.notdef 0 def
368/space 500 def
369/ru 500 def
370/br 0 def
371/lt 416 def
372/lb 416 def
373/rt 416 def
374/rb 416 def
375/lk 416 def
376/rk 416 def
377/rc 416 def
378/lc 416 def
379/rf 416 def
380/lf 416 def
381/bv 416 def
382/ob 350 def
383/bu 350 def
384/ci 750 def
385/bx 750 def
386/sq 750 def
387/rn 500 def
388/ul 500 def
389/vr 0 def
390end
391
392DITfd begin
393/s2 500 def /s4 250 def /s3 333 def
394/a4p{arcto pop pop pop pop}def
395/2cx{2 copy exch}def
396/rls{rlineto stroke}def
397/currx{currentpoint pop}def
398/dround{transform round exch round exch itransform} def
399end
400end
401/DIThacks exch definefont pop
402