home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PSCRIPT / GS23A.ZIP / GHOST.PS < prev    next >
Encoding:
Text File  |  1991-01-15  |  21.0 KB  |  632 lines
  1. %    Copyright (C) 1989, 1990, 1991 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % Initialization file for Ghostscript.
  21. % When this is run, systemdict is still writable.
  22.  
  23. % Acquire the debugging flags.
  24. currentdict /DEBUG known   /DEBUG exch def
  25.   /VMDEBUG
  26.     DEBUG {{vmstatus pop (      ) cvs print pop ( ) print
  27.             systemdict length (      ) cvs print (\n) print flush}}
  28.       {{}} ifelse
  29.   def
  30. currentdict /NODISPLAY known   not /DISPLAYING exch def
  31. currentdict /NOBIND known { /bind { } def } if
  32. currentdict /NOCACHE known   /NOCACHE exch def
  33. currentdict /QUIET known   /QUIET exch def
  34.  
  35. %************************** Disable save and restore
  36. /save {gsave null} bind def
  37. /restore {pop grestore} bind def
  38.  
  39. % Acquire systemdict and userdict.
  40. % Note that the dictionary stack only has 1 element at this point!
  41. /systemdict currentdict def
  42. /userdict 200 dict def
  43. userdict begin        % 2 elements now
  44. systemdict begin
  45.  
  46. VMDEBUG
  47.  
  48. % Define true and false.
  49. /true 0 0 eq def
  50. /false 0 1 eq def
  51.  
  52. % Define predefined procedures substituting for operators,
  53. % in alphabetical order.
  54. /[    /mark load def
  55. /]     {counttomark array astore exch pop} bind def
  56. /abs    {dup 0 lt {neg} if} bind def
  57. /cleardictstack
  58.     {countdictstack 2 sub {end} repeat} bind def
  59. /.copypage /copypage load def
  60. /copypage
  61.     {.copypage
  62.      (>>copypage, press <return> to continue<<\n) .confirm} bind def
  63. /defaultmatrix
  64.     {currentdevice exch deviceparams pop pop
  65.      counttomark 1 add 1 roll cleartomark} bind def
  66. /.echo /echo load def
  67. /.echo.mode true def
  68. /echo    {dup /.echo.mode exch def .echo} bind def
  69. /eexec    {55665 exch type1decryptfile
  70.      % eexec sections have 4 garbage characters at the beginning.
  71.      % We should detect binary vs. hex encoding here.
  72.        4 {dup read pop pop} repeat
  73.      cvx systemdict begin stopped end
  74.      $error /newerror get and {handleerror} if} bind def
  75. /executive
  76.     {{prompt (%statementedit) (r) file
  77.      dup bytesavailable 0 lt
  78.       {(%stdin) (r) file bytesavailable 0 lt {closefile exit} if}
  79.      if cvx execute} loop} bind def
  80. /framedevice            % dummy definition
  81.     {(Warning: framedevice is not implemented.\n) print flush
  82.      pop pop pop setmatrix initclip} bind def
  83. /handleerror
  84.     {errordict /handleerror get exec} bind def
  85. /identmatrix
  86.     {{1.0 0.0 0.0 1.0 0.0 0.0} cvlit exch copy} bind def
  87. /initgraphics
  88.     {initmatrix newpath initclip 1 setlinewidth 0 setlinecap 0 setlinejoin
  89.      {} 0 setdash 0 setgray 10 setmiterlimit} bind def
  90. /initmatrix
  91.     {.tempmatrix defaultmatrix setmatrix} bind def
  92. %.nulldevice does all of nulldevice except initclip and initmatrix.
  93. /nulldevice
  94.     {.nulldevice initclip initmatrix} bind def
  95. /matrix    {6 array identmatrix} bind def
  96. /prompt    {flush flushpage
  97.      (GS) print count 0 ne
  98.       {(<) print count =only}
  99.      if (>) print flush} bind def
  100. /pstack    {0 1 count 3 sub {index ==} for} bind def
  101. /run    {dup type /filetype eq { true } { findlibfile } ifelse
  102.       {cvx execute}
  103.       {(r) file}        % let the error happen
  104.      ifelse} bind def
  105. %.setgray is the same as setgray without the transfer function.
  106. /setgray
  107.     {currenttransfer exec .setgray} bind def
  108. /showpage
  109.     {.copypage (>>showpage, press <return> to continue<<\n) .confirm
  110.      erasepage initgraphics} bind def
  111. /stack    {0 1 count 3 sub {index =} for} bind def
  112. /start    { QUIET not
  113.       {(Ghostscript ) print version print
  114.        (  Copyright (C) 1990 Aladdin Enterprises,\n) print
  115.        (   Menlo Park, CA.  All rights reserved.\n) print
  116.        (Distributed by Free Software Foundation, Inc.\n) print
  117.        (Ghostscript comes with NO WARRANTY: see the file COPYING for details.\n) print
  118.        flush
  119.       } if
  120.       executive
  121.     } def
  122. %.typenumber is a non-standard operator.
  123. /type    {.typenumber
  124.         {arraytype booleantype dicttype filetype fonttype
  125.          integertype marktype nametype nulltype operatortype
  126.          packedarraytype realtype savetype stringtype
  127.          colortype devicetype}
  128.      exch get} def
  129. /version
  130.     (2.1.1) def
  131.  
  132. % Provide semi-fake but usable definitions for
  133. % the color PostScript extensions (except for colorimage,
  134. % which is actually implemented as an operator).
  135. /setcmykcolor {
  136.     1 exch sub dup dup        % C, M, Y, S, S, S
  137.     6 -1 roll 1 exch sub mul    % M, Y, S, S, red
  138.     exch 5 -1 roll 1 exch sub mul    % Y, S, red, green
  139.     4 -2 roll exch 1 exch sub mul    % red, green, blue
  140.     setrgbcolor
  141. } bind def
  142. /currentcmykcolor {
  143.     currentrgbcolor 0
  144. } bind def
  145. /setcolortransfer {
  146.     settransfer pop pop pop
  147. } bind def
  148. /currentcolortransfer {
  149.     {} dup dup currenttransfer
  150. } bind def
  151. /setblackgeneration {
  152.     pop
  153. } bind def
  154. /currentblackgeneration {
  155.     {}
  156. } bind def
  157. /setundercolorremoval {
  158.     pop
  159. } bind def
  160. /currentundercolorremoval {
  161.     {}
  162. } bind def
  163. /setcolorscreen {
  164.     setscreen 9 {pop} repeat
  165. } bind def
  166. /currentcolorscreen {
  167.     currentscreen 3 copy 6 copy
  168. } bind def
  169.  
  170. % Define some additional built-in procedures (beyond the ones defined by
  171. % the PostScript Language Reference Manual).
  172. /concatprocs
  173.     { exch cvlit exch cvlit        % proc1 proc2
  174.       dup length 2 index length add array    % proc1 proc2 newproc
  175.       dup 0 4 index putinterval
  176.       dup 3 index length 3 index putinterval
  177.       exch pop exch pop cvx
  178.     } bind def
  179. /concatstrings
  180.     { 1 index length 1 index length add string
  181.       2 index 1 index copy pop
  182.       dup 3 index length 3 index length getinterval
  183.       2 index exch copy pop
  184.       exch pop exch pop
  185.     } bind def
  186. /copystring
  187.     { dup length string copy } bind def
  188. /defaultdevice
  189.     { 0 getdevice } bind def
  190. /finddevice
  191.     { systemdict /devicedict get exch get } bind def
  192. /rgbcolor
  193.     { gsave setrgbcolor currentgscolor grestore } bind def
  194. %.setdevice does all of setdevice except initclip and initmatrix.
  195. /setdevice
  196.     { .setdevice initclip initmatrix } bind def
  197.  
  198. % Define auxiliary procedures needed for the above.
  199. /.confirm
  200.     {DISPLAYING
  201.       {% Print a message and wait for the user to type something.
  202.        % If the user just types a newline, flush it.
  203.        print flush
  204.        .echo.mode false echo
  205.          (%stdin) (r) file dup read
  206.          {dup (\n) 0 get eq {pop pop} {unread} ifelse} {pop} ifelse
  207.        echo}
  208.       {pop} ifelse} bind def
  209. /.identmatrix        % a read-only identity matrix
  210.     matrix readonly def
  211. /.tempmatrix        % a temporary matrix
  212.     matrix def
  213.  
  214. % If the interpreter includes the Level 2 functions,
  215. % load the initialization file for them.
  216. systemdict /uappend known        % pick any one
  217.  { (ghost2.ps) run }
  218. if
  219.  
  220. % Define the procedure used by the C executive for executing user input,
  221. % and also by the run operator.
  222. % This is called with a procedure or file on the operand stack.
  223. /execute
  224.     {stopped $error /newerror get and {handleerror} if} bind def
  225.  
  226. % Create the error handling machinery.
  227. % The interpreter knows the name ErrorNames.
  228. {/unknown /dictfull /dictstackoverflow /dictstackunderflow
  229.  /execstackoverflow /interrupt /invalidaccess /invalidexit
  230.  /invalidfileaccess /invalidfont /invalidrestore /ioerror
  231.  /limitcheck /nocurrentpoint /rangecheck /stackoverflow
  232.  /stackunderflow /syntaxerror /timeout /typecheck
  233.  /undefined /undefinedfilename /undefinedresult /unmatchedmark
  234.  /VMerror
  235. } cvlit readonly
  236. dup length 2 add dict        % ErrorNames, handleerror
  237. /errordict exch def
  238. errordict begin
  239.   /ErrorNames exch def
  240.   { $error /.inerror get { = flush quit } if    % detect error recursion
  241.     $error /.inerror true put
  242.     countdictstack array dictstack
  243.     $error begin
  244.       /newerror true def
  245.       /dstack exch def
  246.       /errorname exch def
  247.       /command exch def
  248.       countexecstack array execstack /estack exch def
  249.       count array astore /ostack exch def
  250.       ostack aload pop
  251.     end
  252.     $error /.inerror false put
  253.     stop
  254.   } bind
  255.   ErrorNames
  256.    { [ 1 index 3 index /exec load ] cvx def
  257.    } forall
  258.   pop
  259.   /handleerror
  260.    { (Error: ) print
  261.      $error begin
  262.        errorname ==only
  263.        ( in ) print
  264.        /command load ==
  265.        (  ostack:) print
  266.          ostack {( ) print =only} forall
  267.        (\n  estack: ) print
  268.          estack {( ) print =only} forall
  269.        (\n  dstack:) print
  270.          dstack {dup ( ) print length =only (/) print maxlength =only} forall
  271.        (\n) print
  272.        /newerror false def
  273.        flush
  274.      end
  275.    } bind def
  276. end
  277. /$error 7 dict def        % newerror, .inerror, errorname, command,
  278.                 % 3 stacks
  279. $error begin
  280.   /newerror false def
  281.   /.inerror false def
  282. end
  283.  
  284. % Define the =[only] procedures.  Also define =print, which is used
  285. % by LaserPrep even though it isn't documented anywhere.
  286. /=    {=only (\n) print} bind def
  287. /=print    {=} bind def
  288. /.dict 16 dict dup
  289. begin def
  290.   /.buf 128 string def
  291.   /.cvp {.buf cvs .p} bind def
  292.   /.print
  293.     {dup type .dict exch known
  294.      {dup type exec} {.buf cvs print} ifelse
  295.     } bind def
  296.   /stringtype
  297.     {dup rcheck not {pop (--nostringval--)} if print} bind def
  298.   /nametype
  299.     {dup length .buf length gt
  300.      {dup length string}
  301.      {.buf}
  302.     ifelse cvs print} bind def
  303. {0 begin .print end} bind dup 0 .dict put
  304. end
  305. /=only exch def
  306.  
  307. % Define the [write]==[only] procedures.
  308. /==    {==only (\n) print} bind def
  309. /==only    {(%stdout) (w) file exch write==only} bind def
  310. /write==
  311.     {2 copy write==only pop (\n) writestring} bind def
  312. /.dict 17 dict dup
  313. begin def
  314.   /.buf 128 string def
  315.   /.cvp {.buf cvs .p} bind def
  316. % /.f {the_output_file} def
  317.   /.nop {(-) .p type .cvp (-) .p} bind def
  318.   /.p {.f exch writestring} bind def
  319.   /.p1 {.f exch write} bind def
  320.   /.print
  321.     {dup type .dict exch known
  322.      {dup type exec} {.nop} ifelse
  323.     } bind def
  324.   /integertype /.cvp load def
  325.   /realtype /.cvp load def
  326.   /booleantype /.cvp load def
  327.   /nametype
  328.     {dup xcheck not {(/) .p} if
  329.      dup length .buf length gt
  330.       {dup length string}
  331.       {.buf}
  332.      ifelse cvs .p} bind def
  333.   /arraytype
  334.     {dup rcheck
  335.       {dup xcheck {(})({)} {(])([)} ifelse .p
  336.        exch () exch
  337.        {exch .p .print ( )} forall pop .p}
  338.       {.nop}
  339.      ifelse} bind def
  340.   /operatortype
  341.       {(--) .p .cvp (--) .p} bind def
  342.   /packedarraytype /arraytype load def
  343.   /stringtype
  344.     {dup rcheck
  345.       {(\() .p
  346.        {/.ch exch def
  347.         .ch 32 lt .ch 127 ge or
  348.         {(\\) .p .ch 8#1000 add 8 .buf cvrs 1 3 getinterval .p}
  349.         {.ch 40 eq .ch 41 eq or .ch 92 eq or
  350.          {(\\) .p} if
  351.          .ch .p1}
  352.         ifelse}
  353.        forall (\)) .p}
  354.       {.nop}
  355.      ifelse} bind def
  356. {0 begin exch /.f exch def .print end} bind dup 0 .dict put
  357. end
  358. /write==only exch def
  359.  
  360. VMDEBUG
  361.  
  362. % Define the font directory.
  363. % Make it big to leave room for transformed fonts.
  364. /FontDirectory 100 dict def
  365.  
  366. % Define the standard encoding vector.
  367. /StandardEncoding {
  368. % \00x
  369.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  370.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  371.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  372.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  373. % \04x
  374.     /space /exclam /quotedbl /numbersign
  375.     /dollar /percent /ampersand /quoteright
  376.     /parenleft /parenright /asterisk /plus
  377.     /comma /hyphen /period /slash
  378.     /zero /one /two /three
  379.     /four /five /six /seven
  380.     /eight /nine /colon /semicolon
  381.     /less /equal /greater /question
  382. % \10x
  383.     /at /A /B /C /D /E /F /G
  384.     /H /I /J /K /L /M /N /O
  385.     /P /Q /R /S /T /U /V /W
  386.     /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
  387. % \14x
  388.     /quoteleft /a /b /c /d /e /f /g
  389.     /h /i /j /k /l /m /n /o
  390.     /p /q /r /s /t /u /v /w
  391.     /x /y /z /braceleft /bar /braceright /asciitilde /.notdef
  392. % \20x
  393.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  394.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  395.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  396.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  397. % \24x
  398.     /.notdef /exclamdown /cent /sterling
  399.     /fraction /yen /florin /section
  400.     /currency /quotesingle /quotedblleft /guillemotleft
  401.     /guilsinglleft /guilsinglright /fi /fl
  402.     /.notdef /endash /dagger /daggerdbl
  403.     /periodcentered /.notdef /paragraph /bullet
  404.     /quotesinglbase /quotedblbase /quotedblright /guillemotright
  405.     /ellipsis /perthousand /.notdef /questiondown
  406. % \30x
  407.     /.notdef /grave /acute /circumflex /tilde /macron /breve /dotaccent
  408.     /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
  409.     /emdash /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  410.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  411. % \34x
  412.     /.notdef /AE /.notdef /ordfeminine /.notdef /.notdef /.notdef /.notdef
  413.     /Lslash /Oslash /OE /ordmasculine /.notdef /.notdef /.notdef /.notdef
  414.     /.notdef /ae /.notdef /.notdef /.notdef /dotlessi /.notdef /.notdef
  415.     /lslash /oslash /oe /germandbls /.notdef /.notdef /.notdef /.notdef
  416. } cvlit readonly def
  417.  
  418. % Define the ISO Latin-1 encoding vector.
  419. % The first half is the same as the standard encoding.
  420. /ISOLatin1Encoding
  421. StandardEncoding 256 array copy
  422. dup 128 128 getinterval
  423. %****** NOTE: the following are missing in the Adobe documentation,
  424. %****** but appear in the displayed table:
  425. %****** macron at 225, dieresis at 230, cedilla at 233, space at 240.
  426. % \20x
  427.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  428.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  429.     /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
  430.     /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
  431. % \24x
  432.     /space /exclamdown /cent /sterling
  433.     /currency /yen /brokenbar /section
  434.     /dieresis /copyright /ordfeminine /guillemotleft
  435.     /logicalnot /hyphen /registered /macron
  436.     /degree /plusminus /twosuperior /threesuperior
  437.     /acute /mu /paragraph /periodcentered
  438.     /cedilla /onesuperior /ordmasculine /guillemotright
  439.     /onequarter /onehalf /threequarters /questiondown
  440. % \30x
  441.     /Agrave /Aacute /Acircumflex /Atilde
  442.     /Adieresis /Aring /AE /Ccedilla
  443.     /Egrave /Eacute /Ecircumflex /Edieresis
  444.     /Igrave /Iacute /Icircumflex /Idieresis
  445.     /Eth /Ntilde /Ograve /Oacute
  446.     /Ocircumflex /Otilde /Odieresis /multiply
  447.     /Oslash /Ugrave /Uacute /Ucircumflex
  448.     /Udieresis /Yacute /Thorn /germandbls
  449. % \34x
  450.     /agrave /aacute /acircumflex /atilde
  451.     /adieresis /aring /ae /ccedilla
  452.     /egrave /eacute /ecircumflex /edieresis
  453.     /igrave /iacute /icircumflex /idieresis
  454.     /eth /ntilde /ograve /oacute
  455.     /ocircumflex /otilde /odieresis /divide
  456.     /oslash /ugrave /uacute /ucircumflex
  457.     /udieresis /yacute /thorn /ydieresis
  458. 129 -1 roll astore pop readonly def
  459.  
  460. % Define the Symbol encoding vector.
  461. /SymbolEncoding {
  462. % \000
  463.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  464.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  465.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  466.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  467. % \040
  468.     /space /exclam /universal /numbersign
  469.     /existential /percent /ampersand /suchthat
  470.     /parenleft /parenright /asteriskmath /plus
  471.     /comma /minus /period /slash
  472.     /zero /one /two /three
  473.     /four /five /six /seven
  474.     /eight /nine /colon /semicolon
  475.     /less /equal /greater /question
  476. % \100
  477.     /congruent /Alpha /Beta /Chi
  478.     /Delta /Epsilon /Phi /Gamma
  479.     /Eta /Iota /theta1 /Kappa
  480.     /Lambda /Mu /Nu /Omicron
  481.     /Pi /Theta /Rho /Sigma
  482.     /Tau /Upsilon /sigma1 /Omega
  483.     /Xi /Psi /Zeta /bracketleft
  484.     /therefore /bracketright /perpendicular /underscore
  485. % \140
  486.     /radicalex /alpha /beta /chi
  487.     /delta /epsilon /phi /gamma
  488.     /eta /iota /phi1 /kappa
  489.     /lambda /mu /nu /omicron
  490.     /pi /theta /rho /sigma
  491.     /tau /upsilon /omega1 /omega
  492.     /xi /psi /zeta /braceleft
  493.     /bar /braceright /similar /.notdef
  494. % \200
  495.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  496.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  497.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  498.     /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  499. % \240
  500.     /.notdef /Upsilon1 /minute /lessequal
  501.     /fraction /infinity /florin /club
  502.     /diamond /heart /spade /arrowboth
  503.     /arrowleft /arrowup /arrowright /arrowdown
  504.     /degree /plusminus /second /greaterequal
  505.     /multiply /proportional /partialdiff /bullet
  506.     /divide /notequal /equivalence /approxequal
  507.     /ellipsis /arrowvertex /arrowhorizex /carriagereturn
  508. % \300
  509.     /aleph /Ifraktur /Rfraktur /weierstrass
  510.     /circlemultiply /circleplus /emptyset /intersection
  511.     /union /propersuperset /reflexsuperset /notsubset
  512.     /propersubset /reflexsubset /element /notelement
  513.     /angle /gradient /registerserif /copyrightserif
  514.     /trademarkserif /product /radical /dotmath
  515.     /logicalnot /logicaland /logicalor /arrowdblboth
  516.     /arrowdblleft /arrowdblup /arrowdblright /arrowdbldown
  517. % \340
  518.     /lozenge /angleleft /registersans /copyrightsans
  519.     /trademarksans /summation /parenlefttp /parenleftex
  520.     /parenleftbt /bracketlefttp /bracketleftex /bracketleftbt
  521.     /bracelefttp /braceleftmid /braceleftbt /braceex
  522.     /.notdef /angleright /integral /integraltp
  523.     /integralex /integralbt /parenrighttp /parenrightex
  524.     /parenrightbt /bracketrighttp /bracketrightex /bracketrightbt
  525.     /bracerighttp /bracerightmid /bracerightbt /.notdef
  526. } cvlit readonly def
  527.  
  528. % Construct a dictionary of all available devices.
  529. mark
  530.     % Loop until the getdevice gets a rangecheck.
  531.   0 { {dup getdevice exch 1 add} loop} stopped pop
  532.   pop 1 add dict /devicedict exch def
  533.   devicedict begin
  534.     counttomark {dup devicename cvn exch def} repeat
  535.   end
  536. pop        % pop the mark
  537. $error /newerror false put        % remove error indication
  538.  
  539. % Define statusdict, for the benefit of programs
  540. % that think they are running on a LaserWriter or similar printer.
  541. (statusd.ps) run
  542.  
  543. % Establish a default upper limit in the character cache,
  544. % namely, 10 times the average expected character size.
  545. mark
  546.  cachestatus 5 index 10 mul 2 index 1 max idiv        % bmax, cmax
  547.   mark exch dup 10 idiv exch setcacheparams
  548. cleartomark
  549. % Conditionally disable the character cache.
  550. NOCACHE { 1 setcachelimit } if
  551.     
  552. VMDEBUG
  553.  
  554. % Create a null font.  This is the initial font.
  555. 8 dict dup begin
  556.   /FontMatrix [ 1 0 0 1 0 0 ] def
  557.   /PaintType 0 def
  558.   /FontType 3 def
  559.   /FontName () def
  560.   /Encoding StandardEncoding def
  561.   /FontBBox { 0 0 0 0 } def
  562.   /BuildChar { pop pop 0 0 setcharwidth } bind def
  563. end
  564. /NullFont exch definefont setfont
  565.  
  566. % Load the standard font environment.
  567. (gfonts.ps) run
  568.  
  569. % Close up systemdict.
  570. end
  571. % We should make systemdict readonly; however, statusd.ps adds new entries
  572. % to systemdict.  Maybe dictionaries should have an "add-only" mode....
  573. %%%%%% systemdict readonly pop
  574.  
  575. % Establish a default environment.
  576. DISPLAYING
  577.  { defaultdevice
  578.    systemdict /DEVICEWIDTH known systemdict /DEVICEHEIGHT known or
  579.     { matrix deviceparams
  580.       exch /DEVICEWIDTH where
  581.        { pop pop DEVICEWIDTH }
  582.       if
  583.       exch /DEVICEHEIGHT where
  584.        { pop pop DEVICEHEIGHT
  585.          % Replace the Y translation if the Y axis is inverted
  586.      2 index 5 get 0 gt
  587.       { 2 index 5 2 index put
  588.       }
  589.      if
  590.        }
  591.       if
  592.       defaultdevice 4 1 roll makedevice
  593.       counttomark 1 add 1 roll cleartomark
  594.     }
  595.    if setdevice
  596.  }
  597.  { nulldevice
  598.  }
  599. ifelse
  600. 1 setflat        % initgraphics doesn't set this
  601. { } settransfer        % ditto
  602. % The following 'ordered dither' spot function was contributed by
  603. % Gregg Townsend.  Thanks, Gregg!
  604.   72 72 dtransform abs exch abs min    % min(|dpi x|,|dpi y|)
  605.   16.001 div 0            % not 16: avoids rounding problems
  606.    { 1 add 7.9999 mul cvi exch 1 add 7.9999 mul cvi 16 mul add <
  607.     0E 8E 2E AE 06 86 26 A6 0C 8C 2C AC 04 84 24 A4
  608.     CE 4E EE 6E C6 46 E6 66 CC 4C EC 6C C4 44 E4 64
  609.     3E BE 1E 9E 36 B6 16 96 3C BC 1C 9C 34 B4 14 94
  610.     FE 7E DE 5E F6 76 D6 56 FC 7C DC 5C F4 74 D4 54
  611.     01 81 21 A1 09 89 29 A9 03 83 23 A3 0B 8B 2B AB
  612.     C1 41 E1 61 C9 49 E9 69 C3 43 E3 63 CB 4B EB 6B
  613.     31 B1 11 91 39 B9 19 99 33 B3 13 93 3B BB 1B 9B
  614.     F1 71 D1 51 F9 79 D9 59 F3 73 D3 53 FB 7B DB 5B
  615.     0D 8D 2D AD 05 85 25 A5 0F 8F 2F AF 07 87 27 A7
  616.     CD 4D ED 6D C5 45 E5 65 CF 4F EF 6F C7 47 E7 67
  617.     3D BD 1D 9D 35 B5 15 95 3F BF 1F 9F 37 B7 17 97
  618.     FD 7D DD 5D F5 75 D5 55 FF 7F DF 5F F7 77 D7 57
  619.     02 82 22 A2 0A 8A 2A AA 00 80 20 A0 08 88 28 A8
  620.     C2 42 E2 62 CA 4A EA 6A C0 40 E0 60 C8 48 E8 68
  621.     32 B2 12 92 3A BA 1A 9A 30 B0 10 90 38 B8 18 98
  622.     F2 72 D2 52 FA 7A DA 5A F0 70 D0 50 F8 78 D8 58
  623.    > exch get 256 div } bind setscreen
  624. initgraphics
  625. DISPLAYING
  626.  { erasepage
  627.  } if
  628.  
  629. VMDEBUG
  630.  
  631. % The interpreter will run the initial procedure (start).
  632.