1*32175Sedward% @(#)psdit.pro 1.1 09/15/87 2*32175Sedward% lib/psdit.pro -- prolog for psdit (ditroff) files 3*32175Sedward% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved. 4*32175Sedward% last edit: shore Sat Nov 23 20:28:03 1985 5*32175Sedward% RCSID: $Header: psdit.pro,v 2.1 85/11/24 12:19:43 shore Rel $ 6*32175Sedward 7*32175Sedward/$DITroff 140 dict def $DITroff begin 8*32175Sedward/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def 9*32175Sedward/xi {0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto 10*32175Sedward /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F 11*32175Sedward /pagesave save def}def 12*32175Sedward/PB{save /psv exch def currentpoint translate 13*32175Sedward resolution 72 div dup neg scale 0 0 moveto}def 14*32175Sedward/PE{psv restore}def 15*32175Sedward/arctoobig 90 def /arctoosmall .05 def 16*32175Sedward/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def 17*32175Sedward/tan{dup sin exch cos div}def 18*32175Sedward/point{resolution 72 div mul}def 19*32175Sedward/dround {transform round exch round exch itransform}def 20*32175Sedward/xT{/devname exch def}def 21*32175Sedward/xr{/mh exch def /my exch def /resolution exch def}def 22*32175Sedward/xp{}def 23*32175Sedward/xs{docsave restore end}def 24*32175Sedward/xt{}def 25*32175Sedward/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not 26*32175Sedward {fonts slotno fontname findfont put fontnames slotno fontname put}if}def 27*32175Sedward/xH{/fontheight exch def F}def 28*32175Sedward/xS{/fontslant exch def F}def 29*32175Sedward/s{/fontsize exch def /fontheight fontsize def F}def 30*32175Sedward/f{/fontnum exch def F}def 31*32175Sedward/F{fontheight 0 le {/fontheight fontsize def}if 32*32175Sedward fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore 33*32175Sedward fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if 34*32175Sedward makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def 35*32175Sedward/X{exch currentpoint exch pop moveto show}def 36*32175Sedward/N{3 1 roll moveto show}def 37*32175Sedward/Y{exch currentpoint pop exch moveto show}def 38*32175Sedward/S{show}def 39*32175Sedward/ditpush{}def/ditpop{}def 40*32175Sedward/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def 41*32175Sedward/AN{4 2 roll moveto 0 exch ashow}def 42*32175Sedward/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def 43*32175Sedward/AS{0 exch ashow}def 44*32175Sedward/MX{currentpoint exch pop moveto}def 45*32175Sedward/MY{currentpoint pop exch moveto}def 46*32175Sedward/MXY{moveto}def 47*32175Sedward/cb{pop}def % action on unknown char -- nothing for now 48*32175Sedward/n{}def/w{}def 49*32175Sedward/p{pop showpage pagesave restore /pagesave save def}def 50*32175Sedward/abspoint{currentpoint exch pop add exch currentpoint pop add exch}def 51*32175Sedward/distance{dup mul exch dup mul add sqrt}def 52*32175Sedward/dstroke{currentpoint stroke moveto}def 53*32175Sedward/Dl{2 copy gsave rlineto stroke grestore rmoveto}def 54*32175Sedward/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop 55*32175Sedward currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def 56*32175Sedward currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def 57*32175Sedward/Dc{dup arcellipse dstroke}def 58*32175Sedward/De{arcellipse dstroke}def 59*32175Sedward/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def 60*32175Sedward /cradius centerv centerv mul centerh centerh mul add sqrt def 61*32175Sedward /eradius endv endv mul endh endh mul add sqrt def 62*32175Sedward /endang endv endh atan def 63*32175Sedward /startang centerv neg centerh neg atan def 64*32175Sedward /sweep startang endang sub dup 0 lt{360 add}if def 65*32175Sedward sweep arctoobig gt 66*32175Sedward {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def 67*32175Sedward /midh midang cos midrad mul def /midv midang sin midrad mul def 68*32175Sedward midh neg midv neg endh endv centerh centerv midh midv Da 69*32175Sedward currentpoint moveto Da} 70*32175Sedward {sweep arctoosmall ge 71*32175Sedward {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def 72*32175Sedward centerv neg controldelt mul centerh controldelt mul 73*32175Sedward endv neg controldelt mul centerh add endh add 74*32175Sedward endh controldelt mul centerv add endv add 75*32175Sedward centerh endh add centerv endv add rcurveto dstroke} 76*32175Sedward {centerh endh add centerv endv add rlineto dstroke}ifelse}ifelse}def 77*32175Sedward 78*32175Sedward/Barray 200 array def % 200 values in a wiggle 79*32175Sedward/D~{mark}def 80*32175Sedward/D~~{counttomark Barray exch 0 exch getinterval astore /Bcontrol exch def pop 81*32175Sedward /Blen Bcontrol length def Blen 4 ge Blen 2 mod 0 eq and 82*32175Sedward {Bcontrol 0 get Bcontrol 1 get abspoint /Ycont exch def /Xcont exch def 83*32175Sedward Bcontrol 0 2 copy get 2 mul put Bcontrol 1 2 copy get 2 mul put 84*32175Sedward Bcontrol Blen 2 sub 2 copy get 2 mul put 85*32175Sedward Bcontrol Blen 1 sub 2 copy get 2 mul put 86*32175Sedward /Ybi /Xbi currentpoint 3 1 roll def def 0 2 Blen 4 sub 87*32175Sedward {/i exch def 88*32175Sedward Bcontrol i get 3 div Bcontrol i 1 add get 3 div 89*32175Sedward Bcontrol i get 3 mul Bcontrol i 2 add get add 6 div 90*32175Sedward Bcontrol i 1 add get 3 mul Bcontrol i 3 add get add 6 div 91*32175Sedward /Xbi Xcont Bcontrol i 2 add get 2 div add def 92*32175Sedward /Ybi Ycont Bcontrol i 3 add get 2 div add def 93*32175Sedward /Xcont Xcont Bcontrol i 2 add get add def 94*32175Sedward /Ycont Ycont Bcontrol i 3 add get add def 95*32175Sedward Xbi currentpoint pop sub Ybi currentpoint exch pop sub rcurveto 96*32175Sedward }for dstroke}if}def 97*32175Sedwardend 98*32175Sedward/ditstart{$DITroff begin 99*32175Sedward /nfonts 60 def % NFONTS makedev/ditroff dependent! 100*32175Sedward /fonts[nfonts{0}repeat]def 101*32175Sedward /fontnames[nfonts{()}repeat]def 102*32175Sedward/docsave save def 103*32175Sedward}def 104*32175Sedward 105*32175Sedward% character outcalls 106*32175Sedward/oc {/pswid exch def /cc exch def /name exch def 107*32175Sedward /ditwid pswid fontsize mul resolution mul 72000 div def 108*32175Sedward /ditsiz fontsize resolution mul 72 div def 109*32175Sedward ocprocs name known{ocprocs name get exec}{name cb} 110*32175Sedward ifelse}def 111*32175Sedward/fractm [.65 0 0 .6 0 0] def 112*32175Sedward/fraction 113*32175Sedward {/fden exch def /fnum exch def gsave /cf currentfont def 114*32175Sedward cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto 115*32175Sedward fnum show rmoveto currentfont cf setfont(\244)show setfont fden show 116*32175Sedward grestore ditwid 0 rmoveto} def 117*32175Sedward/oce {grestore ditwid 0 rmoveto}def 118*32175Sedward/dm {ditsiz mul}def 119*32175Sedward/ocprocs 50 dict def ocprocs begin 120*32175Sedward(14){(1)(4)fraction}def 121*32175Sedward(12){(1)(2)fraction}def 122*32175Sedward(34){(3)(4)fraction}def 123*32175Sedward(13){(1)(3)fraction}def 124*32175Sedward(23){(2)(3)fraction}def 125*32175Sedward(18){(1)(8)fraction}def 126*32175Sedward(38){(3)(8)fraction}def 127*32175Sedward(58){(5)(8)fraction}def 128*32175Sedward(78){(7)(8)fraction}def 129*32175Sedward(sr){gsave 0 .06 dm rmoveto(\326)show oce}def 130*32175Sedward(is){gsave 0 .15 dm rmoveto(\362)show oce}def 131*32175Sedward(->){gsave 0 .02 dm rmoveto(\256)show oce}def 132*32175Sedward(<-){gsave 0 .02 dm rmoveto(\254)show oce}def 133*32175Sedward(==){gsave 0 .05 dm rmoveto(\272)show oce}def 134*32175Sedwardend 135*32175Sedward 136*32175Sedward% an attempt at a PostScript FONT to implement ditroff special chars 137*32175Sedward% this will enable us to 138*32175Sedward% cache the little buggers 139*32175Sedward% generate faster, more compact PS out of psdit 140*32175Sedward% confuse everyone (including myself)! 141*32175Sedward50 dict dup begin 142*32175Sedward/FontType 3 def 143*32175Sedward/FontName /DIThacks def 144*32175Sedward/FontMatrix [.001 0 0 .001 0 0] def 145*32175Sedward/FontBBox [-260 -260 900 900] def% a lie but ... 146*32175Sedward/Encoding 256 array def 147*32175Sedward0 1 255{Encoding exch /.notdef put}for 148*32175SedwardEncoding 149*32175Sedward dup 8#040/space put %space 150*32175Sedward dup 8#110/rc put %right ceil 151*32175Sedward dup 8#111/lt put %left top curl 152*32175Sedward dup 8#112/bv put %bold vert 153*32175Sedward dup 8#113/lk put %left mid curl 154*32175Sedward dup 8#114/lb put %left bot curl 155*32175Sedward dup 8#115/rt put %right top curl 156*32175Sedward dup 8#116/rk put %right mid curl 157*32175Sedward dup 8#117/rb put %right bot curl 158*32175Sedward dup 8#120/rf put %right floor 159*32175Sedward dup 8#121/lf put %left floor 160*32175Sedward dup 8#122/lc put %left ceil 161*32175Sedward dup 8#140/sq put %square 162*32175Sedward dup 8#141/bx put %box 163*32175Sedward dup 8#142/ci put %circle 164*32175Sedward dup 8#143/br put %box rule 165*32175Sedward dup 8#144/rn put %root extender 166*32175Sedward dup 8#145/vr put %vertical rule 167*32175Sedward dup 8#146/ob put %outline bullet 168*32175Sedward dup 8#147/bu put %bullet 169*32175Sedward dup 8#150/ru put %rule 170*32175Sedward dup 8#151/ul put %underline 171*32175Sedward pop 172*32175Sedward/DITfd 100 dict def 173*32175Sedward/BuildChar{0 begin 174*32175Sedward /cc exch def /fd exch def 175*32175Sedward /charname fd /Encoding get cc get def 176*32175Sedward /charwid fd /Metrics get charname get def 177*32175Sedward /charproc fd /CharProcs get charname get def 178*32175Sedward charwid 0 fd /FontBBox get aload pop setcachedevice 179*32175Sedward 2 setlinejoin 40 setlinewidth 180*32175Sedward newpath 0 0 moveto gsave charproc grestore 181*32175Sedward end}def 182*32175Sedward/BuildChar load 0 DITfd put 183*32175Sedward%/UniqueID 5 def 184*32175Sedward/CharProcs 50 dict def 185*32175SedwardCharProcs begin 186*32175Sedward/space{}def 187*32175Sedward/.notdef{}def 188*32175Sedward/ru{500 0 rls}def 189*32175Sedward/rn{0 840 moveto 500 0 rls}def 190*32175Sedward/vr{0 800 moveto 0 -770 rls}def 191*32175Sedward/bv{0 800 moveto 0 -1000 rls}def 192*32175Sedward/br{0 750 moveto 0 -1000 rls}def 193*32175Sedward/ul{0 -140 moveto 500 0 rls}def 194*32175Sedward/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def 195*32175Sedward/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def 196*32175Sedward/sq{80 0 rmoveto currentpoint dround newpath moveto 197*32175Sedward 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def 198*32175Sedward/bx{80 0 rmoveto currentpoint dround newpath moveto 199*32175Sedward 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def 200*32175Sedward/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc 201*32175Sedward 50 setlinewidth stroke}def 202*32175Sedward 203*32175Sedward/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def 204*32175Sedward/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def 205*32175Sedward/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def 206*32175Sedward/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def 207*32175Sedward/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub 208*32175Sedward 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def 209*32175Sedward/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub 210*32175Sedward 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def 211*32175Sedward/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def 212*32175Sedward/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def 213*32175Sedward/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def 214*32175Sedward/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def 215*32175Sedwardend 216*32175Sedward 217*32175Sedward/Metrics 50 dict def Metrics begin 218*32175Sedward/.notdef 0 def 219*32175Sedward/space 500 def 220*32175Sedward/ru 500 def 221*32175Sedward/br 0 def 222*32175Sedward/lt 416 def 223*32175Sedward/lb 416 def 224*32175Sedward/rt 416 def 225*32175Sedward/rb 416 def 226*32175Sedward/lk 416 def 227*32175Sedward/rk 416 def 228*32175Sedward/rc 416 def 229*32175Sedward/lc 416 def 230*32175Sedward/rf 416 def 231*32175Sedward/lf 416 def 232*32175Sedward/bv 416 def 233*32175Sedward/ob 350 def 234*32175Sedward/bu 350 def 235*32175Sedward/ci 750 def 236*32175Sedward/bx 750 def 237*32175Sedward/sq 750 def 238*32175Sedward/rn 500 def 239*32175Sedward/ul 500 def 240*32175Sedward/vr 0 def 241*32175Sedwardend 242*32175Sedward 243*32175SedwardDITfd begin 244*32175Sedward/s2 500 def /s4 250 def /s3 333 def 245*32175Sedward/a4p{arcto pop pop pop pop}def 246*32175Sedward/2cx{2 copy exch}def 247*32175Sedward/rls{rlineto stroke}def 248*32175Sedward/currx{currentpoint pop}def 249*32175Sedward/dround{transform round exch round exch itransform} def 250*32175Sedwardend 251*32175Sedwardend 252*32175Sedward/DIThacks exch definefont pop 253