home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 273.img / VP30-04.ZIP / POSTSCPT / PERMVP.PS < prev    next >
Encoding:
Text File  |  1990-03-15  |  13.3 KB  |  326 lines
  1. %!PS-Adobe-1.0
  2. %%Title: GEM Permanent Prologue
  3. %%Creator: GEM
  4. %%EndComments
  5.  
  6. userdict /gemdict known{stop}if
  7.  
  8. %%BeginExitServer: 000000
  9. 000000 serverdict begin exitserver
  10. %%EndExitServer
  11.  
  12. /gemdict 250 dict def
  13.  
  14. % Copyright (C) Digital Research, Inc. 1986-1988. All rights reserved.
  15. systemdict /setpacking known
  16. {/svp currentpacking def true setpacking}if
  17. gemdict begin
  18.  
  19. /bd{bind def}bind def
  20. /ed{exch def}bind def
  21.  
  22. % User defined Start of Page procedure:  this operator will be
  23. % executed at the beginning of each page output through GEM
  24. % and is provided to allow user-defined page initialization.
  25. /UserSoP{}bd
  26.  
  27. % Halftone screen spot function procedure array: this array is indexed
  28. % into as follows: 0 = dot screen, 1 = line screen, 2 = ellipse screen,
  29. % 3 = custom (user-definable) screen.
  30. /ScreenProc[
  31.     { % Dot screen
  32.         abs exch abs 2 copy add 1 gt{
  33.             1 sub dup mul exch 1 sub dup mul add 1 sub}{
  34.             dup mul exch dup mul add 1 exch sub}ifelse}bind
  35.     { % Line screen
  36.         pop}bind
  37.     { % Ellipse screen
  38.         dup 5 mul 8 div mul exch dup mul exch add sqrt 1 exch sub}bind
  39.     { % Custom screen
  40.         dup mul exch dup mul add sqrt 1 exch sub}bind
  41.     ]def
  42.  
  43. /GEMINISUB{pop pop pop pop pop}bd
  44. /GEMINIDOC{3 -1 roll settray
  45.     dup userdict exch known{cvx exec}{pop}ifelse
  46.     /#copies ed
  47.     statusdict /setpageparams known
  48.     {statusdict begin 0 1 setpageparams end}{pop pop}ifelse}bd
  49. /geminit{np 1 setlinejoin /mpf true def
  50.     /cmat matrix def /smat matrix def /rmat matrix def
  51.     /encstr 80 string def /patname null def /patbits null def gs}bd
  52. /GEMMATSUB{pop pop pop pop gr 72 300 div exch div dup scale gs}bd
  53. /GEMMATINI{/landscape ed /p3 ed /p2 ed /p1 ed
  54.     gr 72 300 div exch div dup scale clippath pathbbox
  55.     exch /prx ed exch dup /ply ed sub 1 add p3 sub 2 div ply
  56.     add /ty ed dup prx exch sub 1 add p2 sub 2 div add
  57.     landscape{p1 add}if ty translate landscape{90 rotate}if gs}bd
  58. /gr /grestore load def
  59. /np /newpath load def
  60. /cp /currentpoint load def
  61. /gi /getinterval load def
  62. /lto /lineto load def
  63. /mto /moveto load def
  64. /cto /curveto load def
  65. /clw /currentlinewidth load def
  66. /gs /gsave load def 
  67. /greset{gr gs}bd
  68. /settray{dup 0 lt mf dup 0 ge{tray}{pop}ifelse}bd
  69. /mf{statusdict /manualfeed known
  70.     {statusdict begin /manualfeed ed end}{pop}ifelse}bd
  71. /tray{statusdict begin true
  72.     product(Dataproducts LZR 1260)eq{not exch dup 2 gt{pop 0}if
  73.         dup 0 eq{pop defaultpapertray}if setpapertray}if
  74.     product(QMS-PS 1200)eq product(Silentwriter)eq or{not exch dup 1 gt
  75.         {pop 0}if defaultpapertray exch 0 ne{3 exch sub}if
  76.         setpapertray}if
  77.     product(IBM Personal Page Printer II)eq{
  78.         statusdict /defaultpapertray known
  79.         statusdict /setpapertray known and
  80.             {not exch dup 2 gt{pop 0}if
  81.             dup 0 eq{pop defaultpapertray}
  82.             {dup defaultpapertray ge{1 add}if}ifelse
  83.             setpapertray}if}if
  84.     product dup(PrintServer 40)eq exch(QMS-PS 2400)eq or{
  85.         not exch dup 2 gt{pop 0}if
  86.         dup 0 eq{pop defaultpapertray}
  87.         {dup defaultpapertray ge{1 add}if}ifelse setpapertray}if
  88.     {statusdict /defaultpapertray known statusdict /setpapertray known and
  89.         {defaultpapertray exch 0 ne{1 exch sub}if setpapertray}
  90.         {pop}ifelse}if end}bd
  91. /R{findfont begin currentdict dup maxlength dict begin
  92.     {1 index /FID ne{def}{pop pop}ifelse}forall
  93.     /FontName ed dup length 0 ne{
  94.         /Encoding Encoding 256 array copy def 0 exch
  95.         {dup type /nametype eq{
  96.             Encoding 2 index 2 index put pop 1 add}
  97.             {exch pop}ifelse}forall}if pop
  98.     currentdict dup end end /FontName get exch definefont pop}bd
  99. /gemenvec[8#200 /Ccedilla 8#201 /udieresis 8#202 /eacute 8#203 /acircumflex
  100.     8#204 /adieresis 8#205 /agrave 8#206 /aring 8#207 /ccedilla
  101.     8#210 /ecircumflex 8#211 /edieresis 8#212 /egrave 8#213 /idieresis
  102.     8#214 /icircumflex  8#215 /igrave 8#216 /Adieresis 8#217 /Aring
  103.     8#220 /Eacute 8#221 /ae 8#222 /AE 8#223 /ocircumflex 8#224 /odieresis
  104.     8#225 /ograve 8#226 /ucircumflex 8#227 /ugrave 8#230 /ydieresis
  105.     8#231 /Odieresis 8#232 /Udieresis 8#233 /cent 8#234 /sterling
  106.     8#235 /yen 8#236 /currency 8#237 /florin 8#240 /aacute 8#241 /iacute
  107.     8#242 /oacute 8#243 /uacute 8#244 /ntilde 8#245 /Ntilde
  108.     8#246 /ordfeminine 8#247 /ordmasculine 8#250 /questiondown
  109.     8#251 /quotedblleft 8#252 /quotedblright 8#253 /guilsinglleft
  110.     8#254 /guilsinglright 8#255 /exclamdown 8#256 /guillemotleft
  111.     8#257 /guillemotright 8#260 /atilde 8#261 /otilde 8#262 /Oslash
  112.     8#263 /oslash 8#264 /oe 8#265 /OE 8#266 /Agrave 8#267 /Atilde
  113.     8#270 /Otilde 8#271 /section 8#272 /daggerdbl 8#273 /dagger
  114.     8#274 /paragraph
  115.     8#300 /quotedblbase 8#301 /ellipsis 8#302 /perthousand 8#303 /bullet
  116.     8#304 /endash 8#305 /emdash 8#306 /ring 8#307 /Aacute
  117.     8#310 /Acircumflex 8#311 /Egrave 8#312 /Ecircumflex 8#313 /Edieresis
  118.     8#314 /Igrave 8#315 /Iacute 8#316 /Icircumflex 8#317 /Idieresis
  119.     8#320 /Ograve 8#321 /Oacute 8#322 /Ocircumflex 8#323 /Scaron
  120.     8#324 /scaron 8#325 /Ugrave 8#326 /Uacute 8#327 /Ucircumflex
  121.     8#330 /Ydieresis 8#331 /germandbls 8#332 /Zcaron 8#333 /zcaron
  122.     8#334 /fraction 8#335 /space 8#336 /space 8#337 /space 8#340 /grave
  123.     8#341 /acute 8#342 /circumflex 8#343 /tilde 8#344 /dieresis
  124.     8#345 /ring 8#346 /cedilla 8#347 /caron
  125.     version(23.0)eq{8#275 /space 8#276 /space 8#277 /space}
  126.     {8#275 /copyright 8#276 /registered 8#277 /trademark}ifelse]def
  127. /addfont{fonts exch fpt exch put /fpt fpt 1 add def}bd
  128. /encfont{gemenvec exch fonts exch get dup encstr cvs length 1 sub encstr
  129.     exch 1 exch getinterval cvn R}bd
  130. /dpath{mto{lto}repeat}bd
  131. /path{np dpath}bd
  132. /addpath{lto{lto}repeat}bd
  133. /rxy{.25 sub round .25 add}bd
  134. /rpt{transform rxy exch rxy exch itransform}bd
  135. /fa{np rpt mto 3{rpt lto}repeat}bd
  136. /circle{np 0 0 1 0 360 arc}bd
  137. /deflin{0 0 0 setrgbcolor []0 setdash 1 setlinewidth}bd
  138. /dot{gs np 2 copy mto lto 1 setlinecap stroke gr}bd
  139. /rend{gs 1 setlinecap np mto cp 0.1 add lto stroke gr}bd
  140. /rl{gs 1 setlinecap stroke gr}bd
  141. /vl{dup /st ed dup apath exch get tx sub dup mul
  142.     exch 1 add apath exch get ty sub dup mul add sqrt}bd
  143. /doarrow{/rot ed /ty ed /tx ed 6 array currentmatrix
  144.     tx ty translate clw 4 lt{4}{clw}ifelse dup scale rot rotate np
  145.     0 0 mto -3 1.5 lto -3 -1.5 lto fill setmatrix}bd
  146. /arpath{np apath 0 get apath 1 get mto 2 2 points 1 sub
  147.     {dup apath exch get exch 1 add apath exch get lto}for}bd
  148. /arrowline{/apath ed /lend ed /lbeg ed /len clw 3 mul def
  149.     /points apath length def lbeg
  150.     {apath 0 get dup /tx ed /x1 ed apath 1 get dup
  151.         /ty ed /y1 ed true 2 2 points 1 sub
  152.         {vl len ge{pop false exit}if}for
  153.         {/lbeg false def /lend false def}
  154.         {apath 2 apath st points st sub gi putinterval /r1 y1
  155.             apath 3 get sub x1 apath 2 get sub atan def apath 0
  156.             x1 r1 cos len mul sub put apath 1 y1 r1 sin len mul
  157.             sub put /points points st 2 sub sub def}ifelse}if
  158.     lend{apath points 2 sub get dup /tx ed /x2 ed
  159.         apath points 1 sub get dup /ty ed /y2 ed
  160.         true points 4 sub -2 0
  161.         {vl len ge{pop false exit}if}for
  162.         {/lbeg false def /lend false def}
  163.         {/r2 y2 apath st 1 add get sub x2 apath st get sub
  164.             atan def /st st 2 add def apath st x2 r2 cos len mul
  165.             sub put apath st 1 add y2 r2 sin len mul sub put
  166.             /points st 2 add def}ifelse}if
  167.     lbeg{x1 y1 r1 doarrow}if lend{x2 y2 r2 doarrow}if arpath}bd
  168. /ac{6 array currentmatrix xt yt translate xs ys scale}bd
  169. /shorten{dup mul exch dup mul add sqrt clw 150 mul exch div}bd
  170. /xang{dup 360 ge{360}{0}ifelse exch dup sin xs mul exch cos ys mul atan
  171.     dup 360 lt{add}{exch pop}ifelse}bd
  172. /arrowarc{/eang ed /bang ed /ys ed /xs ed /yt ed
  173.     /xt ed /lend ed /lbeg ed ac np 0 0 1 bang xang
  174.     eang xang arc setmatrix cp /y2 ed /x2 ed ac np 0 0 1 bang
  175.     xang dup arc setmatrix cp /y1 ed /x1 ed lbeg
  176.     {/bang bang xs ys shorten add def}if
  177.     lend{/eang eang xs ys shorten sub def}if ac np 0 0 1 bang xang eang
  178.     xang arc setmatrix gs stroke gr
  179.     lend{x2 y2 cp y2 exch sub exch x2 exch sub atan doarrow}if
  180.     lbeg{ac np 0 0 1 bang xang dup arc setmatrix x1 y1 cp y1 exch sub
  181.         exch x1 exch sub atan doarrow}if}bd
  182. /rbox{/ury ed /urx ed /lly ed /llx ed urx llx sub
  183.     4 div dup 50 gt{pop 50}if /radius ed ury lly sub 4 div dup
  184.     radius gt{pop radius}if /radius ed np urx radius sub ury mto llx
  185.     ury llx lly radius arcto 4{pop}repeat llx lly urx lly radius arcto
  186.     4{pop}repeat urx lly urx ury radius arcto 4{pop}repeat urx ury llx ury
  187.     radius arcto 4{pop}repeat}bd
  188. /marker{1 sub mdef exch get /mproc ed 32 div /msize ed
  189.     {gs np translate msize dup scale mproc stroke gr}repeat}bd
  190. /mdef[{0 0 0.5 0 360 arc}bind
  191.     {-16 0 mto 16 0 lto 0 -16 mto 0 16 lto}bind
  192.     {0 -16 mto 0 16 lto 13.9 8 mto -13.9 -8 lto 13.9 -8 mto
  193.         -13.9 8 lto}bind
  194.     {16 16 mto -16 16 lto -16 -16 lto 16 -16 lto closepath}bind
  195.     {16 16 mto -16 -16 lto -16 16 mto 16 -16 lto}bind
  196.     {16 0 mto 0 16 lto -16 0 lto 0 -16 lto closepath}bind
  197.     {0 0 16 0 360 arc}bind
  198.     {0 13.86 mto -16 -13.86 lto 16 -13.86 lto closepath}bind]def
  199. /bon{2 mul exch dup 3 1 roll 8 idiv add pstr exch get
  200.     exch 8 mod 7 exch sub 1 exch bitshift and 0 ne}bd
  201. /bpsf{1 add 8 mul cvi exch 1 add 8 mul cvi exch bon
  202.     {/onb onb 1 add def 1}{/ofb ofb 1 add def 0}ifelse}bd
  203. /frs{72 0 rmat defaultmatrix dtransform dup mul exch dup mul add sqrt}bd
  204. /sus{/m cmat currentmatrix def /sm 32 dup smat scale def sm m m concatmatrix
  205.     pop 1 0 m dtransform dup abs 0.1 gt{exch 90}{0}ifelse exch pop exch
  206.     dup 0 lt{exch 180 add exch neg}if frs exch div exch /bpsf load
  207.     setscreen}bd
  208. /setpat{/onb 0 def /ofb 0 def sus{}settransfer ofb ofb onb add div setgray}bd
  209. /ellpie{/pie ed /eang ed /bang ed /ys ed /xs ed
  210.     /yt ed /xt ed 6 array currentmatrix xt yt translate xs ys
  211.     scale np pie{0 0 mto}if 0 0 1 bang xang eang xang arc setmatrix}bd
  212. /roundarc{gs 1 setlinecap cp np mto cp lto stroke gr}bd
  213. /ss{currentscreen /scp ed /sca ed /scf ed
  214.     dup 0 lt{pop}{ScreenProc exch get /scp ed}ifelse
  215.     dup 0 lt{pop}{/sca ed}ifelse
  216.     dup 0 le{pop}{/scf ed}ifelse
  217.     scf sca /scp load setscreen}bd
  218. /grayimg{{vrep 0.1 gt{/vrep vrep 1 sub def}{
  219.             {currentfile token pop 0 eq
  220.                 {currentfile scan readhexstring pop pop exit}
  221.                 {/vrep currentfile token pop def}ifelse
  222.             }loop}ifelse scan}image}bd
  223. /fstimg{{vrep 0.1 gt{/vrep vrep 1 sub def}{
  224.             {currentfile token pop 0 eq
  225.                 {currentfile scan readhexstring pop pop exit}
  226.                 {/vrep currentfile token pop def}ifelse
  227.             }loop}ifelse scan}imagemask}bd
  228. /decode{/patstring patlen string def /bonestr 1 string def
  229.     {vrep 0.1 gt{/vrep vrep 1 sub def scan}
  230.         {/spos 0 def
  231.             {currentfile token pop currentfile token pop
  232.                 exch imop exch get exec spos smax ge
  233.                 {scan exit}if}loop}ifelse}imagemask}bd
  234. /imop[{<ff> psc}bind
  235.     {<00> psc}bind
  236.     {currentfile patstring readhexstring pop psc}bind
  237.     {1 exch 1 exch
  238.         {pop currentfile bonestr readhexstring pop scan exch
  239.             spos exch 0 get put /spos spos 1 add def}for}bind
  240.     {1 sub /vrep ed}bind]def
  241. /psc{dup length /plen ed exch -1 1
  242.     {pop dup scan exch spos exch putinterval /spos spos plen add def}for
  243.     pop}bd
  244. /nf{/svf currentflat def 10 setflat}bd
  245. /rf{svf setflat}bd
  246. /gtext{gs /msg ed /ty ed /tx ed tx ty translate trotate
  247.     rotate nf horz halign get exec
  248.     vert valign get exec np tx ty mto rf msg show tunder
  249.     {cp cp extents pop pop 5 div dup neg setlinewidth [] 0 setdash 1.5 mul
  250.         ty add /ty ed pop np pop ty mto tx ty lto stroke np mto}if
  251.     gr}bd
  252. /etext{gs translate trotate rotate /tx 0 def /ty 0 def
  253.     {tx add dup /tx ed np ty mto show}repeat gr}bd
  254. /jtext{/msg ed /sps ed /dx ed /ty ed /tx ed
  255.     gs tx ty translate trotate rotate nf
  256.     jhorz halign get exec vert valign get exec
  257.     msg stringwidth pop dx exch sub sps 0 eq{pop 0}{sps div}ifelse
  258.     /xsp ed rf msg jo gr}bd
  259. /fet{gs translate /tx 0 def /ty 0 def
  260.     {tx add dup /tx ed np ty mto show}repeat gr}bd
  261. /fjt{/msg ed /sps ed /dx ed /ty ed
  262.     gs ty translate nf /tx 0 def /ty 0 def
  263.     msg stringwidth pop dx exch sub sps 0 eq{pop 0}{sps div}ifelse
  264.     /xsp ed rf msg jo gr}bd
  265. /tsel{tszabs{dup /FontBBox get aload pop exch pop dup 3 1 roll exch sub
  266.     exch dup 0 eq{pop pop 1.25}{div}ifelse exch pop}{1}ifelse}bd
  267. /sf{fonts tface get findfont tsel dup txscale mul exch tyscale mul
  268.     matrix scale makefont setfont}bd
  269. /jo{xsp exch 0 exch 32 exch np tx ty mto widthshow tunder
  270.     {cp cp extents pop pop 5 div dup neg setlinewidth 1.5 mul ty add
  271.     /ty ed []0 setdash pop np pop ty mto tx ty lto stroke np mto}if}bd
  272. /horz[{/tx 0 def}bind
  273.     {msg stringwidth pop -2 div /tx ed}bind
  274.     {msg stringwidth pop neg /tx ed}bind]def
  275. /extents{(_)bbox pop pop msg stringwidth pop (])bbox 3{exch pop}repeat}bd
  276. /bbox{np 0 0 mto false charpath flattenpath pathbbox np}bd
  277. /vert[{/ty 0 def}bind
  278.     {extents -2 div /ty ed pop pop pop}bind
  279.     {extents neg /ty ed pop pop pop}bind
  280.     {extents pop pop neg /ty ed pop}bind]def
  281. /jhorz[{/tx 0 def}bind
  282.     {/tx dx -2 div def}bind
  283.     {/tx dx neg def}bind]def
  284. /symindex 12 def
  285. /CR{/ah 0 def}bd
  286. /LF{0 -50 translate}bd
  287. /atext{gs np ah av mto
  288.     show tunder{cp cp (_)bbox pop pop exch pop 5 div dup neg
  289.     setlinewidth 1.5 mul add dup ah exch [] 0 setdash np mto lto
  290.     stroke np mto}if cp pop /ah ed gr}bd
  291. /colmap[
  292.     [1 1 1]
  293.     [0 0 0]
  294.     [1 0 0]
  295.     [0 1 0]
  296.     [0 0 1]
  297.     [0 1 1]
  298.     [1 1 0]
  299.     [1 0 1]
  300.     [.5 .5 .5]
  301.     [0 0 0]
  302.     [.5 0 0]
  303.     [0 .5 0]
  304.     [0 0 .5]
  305.     [0 .5 .5]
  306.     [.5 .5 0]
  307.     [.5 0 .5]
  308.     ]def
  309. /sci{colmap exch get aload pop setrgbcolor}bd
  310. /stint{/tint ed currentrgbcolor
  311.     3{dup 0 eq{pop tint}if 3 1 roll}repeat setrgbcolor}bd
  312.  
  313. end
  314. /vpdict 1 dict def
  315. systemdict /setpacking known{svp setpacking}if
  316. %%EndProlog
  317.  
  318. save
  319.     /Times-Roman findfont 12 scalefont setfont newpath 72 700 moveto
  320.     (GEM PostScript preamble loaded.)show
  321.     newpath 72 680 moveto vmstatus exch sub 10 string cvs show
  322.     ( bytes of VM available.)show showpage pop
  323. restore
  324.  
  325. %%EOF
  326.