%! % $Header: /usr/jjc/dvitops/RCS/dvitops.pro,v 1.4 90/03/12 18:44:05 jjc Exp $ /dvitops 200 dict def dvitops begin systemdict /setpacking known { /savepacking currentpacking def true setpacking } if % Z /Z { 3 1 roll moveto show } bind def % X /X { exch currentpoint exch pop moveto show } bind def % W /W { exch 0 rmoveto show } bind def /M /moveto load def % When PostScript fills a path, it seems to blacken any pixel that % wholly ***or partly*** lies within the path. Thus we can achieve % results predictable down to the pixel level by ensuring that % the corners of the rule do ***not*** lie on pixel boundaries. % This procedure is made more complex by the fact that we do % not know what the orientation of device space is---it cannot be % assumed to be same as the default user coordinate system. % This procedure assumes that the height and width are both > 0. % height width x y R /R { newpath % transform the coordinates of the bottom left hand corner % to device space and round them to the nearest pixel transform round exch round exch % compute and moveto the point half a pixel up from and half a pixel to the % right of this position .5 .5 idtransform abs neg exch abs exch dtransform 3 -1 roll add 3 1 roll add exch itransform moveto % compute the height and width of the rule exch dtransform abs ceiling 1 sub exch abs ceiling 1 sub exch idtransform abs exch abs exch % draw the rule dup 0 exch neg rlineto exch 0 rlineto 0 exch rlineto fill } bind def /BP { /level0 save def } bind def /EP { level0 restore showpage } bind def /BO { /level1 save def } bind def /EO { level1 restore } bind def % landscape % page width is in PostScript points /landscape { /pw exch def [0 1 -1 0 pw 0] concat } def % SC % hoffset and voffset are in PostScript points % page height is in PostScript points /SC { /ph exch def /voffset exch def /hoffset exch def /mag exch def /den exch def /num exch def 0 ph translate 1 -1 scale hoffset voffset translate num 254000 div 72 mul den div mag mul 1000 div dup scale } bind def /FF { findfont def } bind def /SF { /a exch def [a 0 0 a neg 0 0] makefont def } bind def /F /setfont load def % newdictname newfontname newencoding basefontdict RE - /RE { dup maxlength dict /f exch def { exch dup dup /FID ne exch /Encoding ne and { exch f 3 1 roll put } { pop pop } ifelse } forall f /Encoding 3 -1 roll put dup f /FontName 3 -1 roll put f definefont def } bind def % makelong /makelong { /i exch def /s exch def s i get 24 bitshift s i 1 add get 16 bitshift or s i 2 add get 8 bitshift or s i 3 add get or } bind def /BuildPK { /char exch def /fontdict exch def /charname fontdict /Encoding get char get def /charinfo fontdict /CharData get charname get def /flag charinfo 0 get def flag 0 eq { /dm charinfo 1 get def /dn 0 def /cols charinfo 2 get def /rows charinfo 3 get def /hoff charinfo 4 get dup 127 gt { 256 sub } if def /voff charinfo 5 get dup 127 gt { 256 sub } if def /prelen 6 def } { flag 1 eq { /dm charinfo 1 get 256 mul charinfo 2 get add def /dn 0 def /cols charinfo 3 get 256 mul charinfo 4 get add def /rows charinfo 5 get 256 mul charinfo 6 get add def /hoff charinfo 7 get 256 mul charinfo 8 get add dup 32767 gt { 65536 sub } if def /voff charinfo 9 get 256 mul charinfo 10 get add dup 32767 gt { 65536 sub } if def /prelen 11 def } { /dm charinfo 1 makelong 65536 div def /dn charinfo 5 makelong 65536 div def /cols charinfo 9 makelong def /rows charinfo 13 makelong def /hoff charinfo 17 makelong def /voff charinfo 21 makelong def /prelen 25 def } ifelse } ifelse /llx hoff neg .5 sub def /lly voff 1 add rows sub .5 add def dm dn llx lly llx cols add lly rows add setcachedevice cols rows true fontdict /ImageMaskMatrix get dup 4 llx neg put dup 5 rows lly add put { charinfo prelen charinfo length prelen sub getinterval } imagemask } bind def /EmptyEncoding 256 array def 0 1 255 {EmptyEncoding exch /.notdef put} for % /DefinePKFont { 4 array astore /bbox exch def /data exch def /encoding exch def /vppp exch def /hppp exch def /ds exch def 9 dict dup begin /FontType 3 def /Encoding encoding def /BuildChar /BuildPK load def /ImageMaskMatrix [1 0 0 -1 0 0] def /FontMatrix [ 65536 ds 1048576 div hppp mul div 0 0 65536 ds 1048576 div vppp mul div 0 0 ] def /FontBBox bbox def /CharData data def CharData /.notdef <000000000000> put end definefont pop } def % this comes from the Adobe Ilustrator manual /Locate { 8 dict begin [/newury /newurx /newlly /newllx /ury /urx /lly /llx] { exch def } forall newllx newlly translate newurx newllx sub urx llx sub div newury newlly sub ury lly sub div scale llx neg lly neg translate end } bind def % tpic stuff /MT { transform round exch round exch itransform moveto } bind def /LT { transform round exch round exch itransform lineto } bind def /CT { transform round exch round exch itransform curveto } bind def /ST /stroke load def /FI /fill load def /CP /closepath load def /SG /setgray load def /LW /setlinewidth load def /GR /grestore load def /GS /gsave load def % dash-len gap-len DH - /DH { [ 3 1 roll ] 0 setdash } bind def /SO { [] 0 setdash } bind def /AR /arc load def /TM matrix def /EL { TM currentmatrix pop translate scale newpath 0 0 1 0 360 arc closepath TM setmatrix } bind def /TP { 1 setlinecap 1 setlinejoin } bind def systemdict /setpacking known { savepacking setpacking } if end