home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-08-02 | 32.2 KB | 1,090 lines |
- % Copyright (C) 1989, 1992, 1993, 1994 Aladdin Enterprises. All rights reserved.
- %
- % This file is part of Aladdin Ghostscript.
- %
- % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND. No author
- % or distributor accepts any responsibility for the consequences of using it,
- % or for whether it serves any particular purpose or works at all, unless he
- % or she says so in writing. Refer to the Aladdin Ghostscript Free Public
- % License (the "License") for full details.
- %
- % Every copy of Aladdin Ghostscript must include a copy of the License,
- % normally in a plain ASCII text file named PUBLIC. The License grants you
- % the right to copy, modify and redistribute Aladdin Ghostscript, but only
- % under certain conditions described in the License. Among other things, the
- % License requires that the copyright notice and this notice be preserved on
- % all copies.
-
- % Initialization file for the interpreter.
- % When this is run, systemdict is still writable.
-
- % Comment lines of the form
- % %% Replace <n> <file(s)>
- % indicate places where the next <n> lines should be replaced by
- % the contents of <file(s)>, when creating a single merged init file.
-
- % Check the interpreter revision. NOTE: the interpreter code requires
- % that the first non-comment token in this file be an integer
- % that matches the interpreter's revision.
- 3000
- dup revision ne
- { (gs: Interpreter revision \() print revision 10 string cvs print
- (\) does not match gs_init.ps revision \() print 10 string cvs print
- (\).\n) print flush null 1 .quit
- }
- if pop
-
- % Acquire userdict.
- currentdict dup 200 .setmaxlength % userdict
- systemdict begin
- /userdict exch def
-
- % Define true and false.
- /true 0 0 eq def
- /false 0 1 eq def
-
- % Define dummy local/global operators if needed.
- systemdict /.setglobal known
- { true .setglobal
- }
- { /.setglobal { pop } def
- /.currentglobal { false } def
- /.gcheck { pop false } def
- }
- ifelse
-
- % Define .languagelevel if needed.
- systemdict /.languagelevel known not { /.languagelevel 1 def } if
-
- % Optionally choose a default paper size other than U.S. letter.
- % (a4) /PAPERSIZE where { pop pop } { /PAPERSIZE exch def } ifelse
-
- % Turn on array packing for the rest of initialization.
- true setpacking
-
- % Acquire the debugging flags.
- currentdict /DEBUG known /DEBUG exch def
- /VMDEBUG
- DEBUG {{print mark
- systemdict /level2dict known
- { .currentglobal false .setglobal vmstatus
- true .setglobal vmstatus 3 -1 roll pop
- 6 -2 roll pop .setglobal
- }
- { vmstatus 3 -1 roll pop
- }
- ifelse counttomark
- { ( ) print ( ) cvs print }
- repeat pop
- ( ) print systemdict length ( ) cvs print
- ( <) print count ( ) cvs print (>\n) print flush
- }}
- {{pop
- }}
- ifelse
- def
- currentdict /DISKFONTS known /DISKFONTS exch def
- currentdict /ESTACKPRINT known /ESTACKPRINT exch def
- currentdict /NOBIND known /NOBIND exch def
- /.bind /bind load def
- NOBIND { /bind { } def } if
- currentdict /NOCACHE known /NOCACHE exch def
- currentdict /NODISPLAY known not /DISPLAYING exch def
- currentdict /NOPAUSE known /NOPAUSE exch def
- currentdict /NOPLATFONTS known /NOPLATFONTS exch def
- currentdict /OSTACKPRINT known /OSTACKPRINT exch def
- currentdict /OUTPUTFILE known % obsolete
- { /OutputFile /OUTPUTFILE load def
- currentdict /OUTPUTFILE undef
- } if
- currentdict /QUIET known /QUIET exch def
- currentdict /SAFER known /SAFER exch def
- currentdict /WRITESYSTEMDICT known /WRITESYSTEMDICT exch def
-
- % Acquire environment variables.
- currentdict /DEVICE known not
- { (GS_DEVICE) getenv { /DEVICE exch def } if } if
-
- (START) VMDEBUG
-
- % Acquire the standard files.
- /.stdin (%stdin) (r) file def
- /.stdout (%stdout) (w) file def
- /.stderr (%stderr) (w) file def
-
- % Define a procedure for skipping over an unneeded section of code.
- % This avoids allocating space for the skipped procedures.
- /.skipeof % string ->
- { { dup currentfile =string readline pop eq { exit } if } loop pop
- } bind def
-
- % Define =string, which is used by some PostScript programs even though
- % it isn't documented anywhere.
- /=string 128 string def
-
- % Print the greeting.
-
- /printgreeting
- { mark
- product (Ghostscript) search
- { pop pop pop
- (This software comes with NO WARRANTY: see the file PUBLIC for details.\n)
- }
- { pop
- }
- ifelse
- ( All rights reserved.\n) copyright
- (\)\n) revisiondate 10000 idiv (/)
- revisiondate 100 mod (/)
- revisiondate 100 idiv 100 mod ( \()
- revision 1000 div ( )
- product
- counttomark { =string cvs print } repeat pop
- } bind def
-
- QUIET not { printgreeting flush } if
-
- % Define a special version of def for making operator procedures.
- /odef
- {1 index exch .makeoperator def} bind def
-
- %**************** BACKWARD COMPATIBILITY
- /getdeviceprops
- { null .getdeviceparams
- } bind odef
- /.putdeviceprops
- { null counttomark 1 add 2 roll .putdeviceparams
- dup type /nametype eq
- { counttomark 3 add 1 roll cleartomark pop pop
- /.putdeviceprops load exch signalerror
- }
- if
- } bind odef
- /.devicenamedict 1 dict dup /OutputDevice dup put def
- /.devicename
- { //.devicenamedict .getdeviceparams exch pop exch pop
- } bind odef
-
- % Define predefined procedures substituting for operators,
- % in alphabetical order.
-
- userdict /#copies 1 put
- /[ /mark load def
- /] {counttomark array astore exch pop} odef
- /abs {dup 0 lt {neg} if} odef
- % .beginpage is an operator in Level 2.
- /.beginpage { } odef
- /copypage
- { 1 .endpage
- { 1 false .outputpage
- (>>copypage, press <return> to continue<<\n) .confirm
- }
- if .beginpage
- } odef
- /setcolorscreen where { pop % not in all Level 1 configurations
- /currentcolorscreen
- { .currenthalftone
- { { 60 exch 0 exch 3 copy 6 copy } % halftone
- { 3 copy 6 copy } % screen
- { } % colorscreen
- }
- exch get exec
- } odef
- } if
- /currentscreen
- { .currenthalftone
- { { 60 exch 0 exch } % halftone
- { } % screen
- { 12 3 roll 9 { pop } repeat } % colorscreen
- }
- exch get exec
- } odef
- /defaultmatrix
- {currentdevice exch deviceinitialmatrix} odef
- /.echo /echo load def
- userdict /.echo.mode true put
- /echo {dup /.echo.mode exch store .echo} odef
- /eexec
- { 55665 .filter_eexecDecode
- cvx systemdict begin stopped
- % Only pop systemdict if it is still the top element,
- % because this is apparently what Adobe interpreters do.
- currentdict systemdict eq { end } if
- { stop } if
- } odef
- % .endpage is an operator in Level 2.
- /.endpage { 2 ne } odef
- % erasepage mustn't use gsave/grestore, because we call it before
- % the graphics state stack has been fully initialized.
- /erasepage
- { /currentcolor where
- { pop currentcolor currentcolorspace { setcolorspace setcolor } }
- { /currentcmykcolor where
- { pop currentcmykcolor { setcmykcolor } }
- { currentrgbcolor { setrgbcolor } }
- ifelse
- }
- ifelse 1 setgray .fillpage exec
- } odef
- /executive
- { { prompt
- { (%statementedit) (r) file } stopped { exit } if
- cvx execute
- } loop
- } odef
- /handleerror
- {errordict /handleerror get exec} bind def
- /identmatrix [1.0 0.0 0.0 1.0 0.0 0.0] readonly def
- /identmatrix
- { //identmatrix exch copy} odef
- /initgraphics
- {initmatrix newpath initclip 1 setlinewidth 0 setlinecap 0 setlinejoin
- [] 0 setdash 0 setgray 10 setmiterlimit} odef
- /languagelevel 1 def % gs_lev2.ps may change this
- /matrix {6 array identmatrix} odef
- /prompt {flush flushpage
- (GS) print count 0 ne
- {(<) print count =only}
- if (>) print flush} bind def
- /pstack {0 1 count 3 sub {index ==} for} bind def
- /putdeviceprops
- { .putdeviceprops { erasepage } if } odef
- /quit {/quit load 0 .quit} odef
- /run {dup type /filetype ne { (r) file } if cvx execute} odef
- /setdevice
- { .setdevice { erasepage } if } odef
- /showpage
- { 0 .endpage
- { #copies true .outputpage
- (>>showpage, press <return> to continue<<\n) .confirm
- erasepage
- }
- if initgraphics .beginpage
- } odef
- % Code output by Adobe Illustrator relies on the fact that
- % `stack' is a procedure, not an operator!!!
- /stack {0 1 count 3 sub {index =} for} bind def
- /start { executive } def
- /stop { true .stop } odef
- /stopped { false .stopped } odef
- /store { 1 index where { 3 1 roll put } { def } ifelse } odef
- % When running in Level 1 mode, this interpreter is supposed to be
- % compatible with PostScript "version" 54.0 (I think).
- /version (54.0) def
-
- % Define some additional built-in procedures (beyond the ones defined by
- % the PostScript Language Reference Manual).
- % Warning: these are not guaranteed to stay the same from one release
- % to the next!
- /concatstrings
- { exch dup length 2 index length add string % str2 str1 new
- dup dup 4 2 roll copy % str2 new new new1
- length 4 -1 roll putinterval
- } bind def
- /copyarray
- { dup length array copy } bind def
- /copystring
- { dup length string copy } bind def
- /.dicttomark % (the Level 2 >> operator)
- { counttomark 2 idiv dup dict begin
- { def } repeat pop currentdict end
- } bind def
- /finddevice
- { systemdict /devicedict get exch get } bind def
- /.growdictlength % get size for growing a dictionary
- { length 3 mul 2 idiv 1 add
- } bind def
- /.growdict % grow a dictionary
- { dup .growdictlength .setmaxlength
- } bind def
- /.growput % put, grow the dictionary if needed
- { 2 index length 3 index maxlength eq
- { 3 copy pop known not { 2 index .growdict } if
- } if
- put
- } bind def
- /.packtomark
- { counttomark packedarray exch pop } bind def
- /runlibfile
- { findlibfile
- { exch pop run }
- { /undefinedfilename signalerror }
- ifelse
- } bind def
- /selectdevice
- { finddevice setdevice } bind def
- /signalerror % <object> <errorname> signalerror -
- { errordict exch get exec } bind def
-
- % Define the =[only] procedures. Also define =print,
- % which is used by some PostScript programs even though
- % it isn't documented anywhere.
- /write=only
- { { .writecvs } null .stopped null ne
- { pop (--nostringval--) writestring
- }
- if
- } bind def
- /write=
- { 1 index exch write=only (\n) writestring
- } bind def
- /=only { .stdout exch write=only } bind def
- /= { =only (\n) print } bind def
- /=print /=only load def
- % Temporarily define == as = for the sake of runlibfile0.
- /== /= load def
-
- % Define the filter operator.
-
- /.filterstring (.filter_01234567890123456789) def
- /.filterstring1 .filterstring 8 .filterstring length 8 sub getinterval def
- /filter
- { //.filterstring exch 0 exch
- //.filterstring1 cvs length 8 add getinterval cvn load exec
- } odef
-
- % Define procedures for getting and setting the current device resolution.
-
- /gsgetdeviceprop
- { 1 index getdeviceprops
- { 1 index counttomark 1 add index eq { exit } if pop pop } loop
- dup mark eq % if true, not found
- { pop dup /undefined signalerror }
- { counttomark 1 add 1 roll cleartomark exch pop exch pop }
- ifelse
- } bind def
- /gscurrentresolution
- { currentdevice /HWResolution gsgetdeviceprop
- } bind def
- /gssetresolution
- { 2 array astore mark exch /HWResolution exch
- currentdevice copydevice putdeviceprops setdevice
- } bind def
-
- % Define auxiliary procedures needed for the above.
- /shellarguments % -> shell_arguments true (or) false
- { /ARGUMENTS where
- { /ARGUMENTS get dup type /arraytype eq
- { aload pop /ARGUMENTS null store true }
- { pop false }
- ifelse }
- { false } ifelse
- } bind def
- /.confirm
- {DISPLAYING NOPAUSE not and
- {% Print a message and wait for the user to type something.
- % If the user just types a newline, flush it.
- print flush
- .echo.mode false echo
- .stdin dup read
- {dup (\n) 0 get eq {pop pop} {unread} ifelse} {pop} ifelse
- echo}
- {pop} ifelse} bind def
-
- % Define the procedure used by the C executive for executing user input,
- % and also by the run operator.
- % This is called with a procedure or file on the operand stack.
- /execute
- {stopped $error /newerror get and {handleerror} if} odef
- % Define an execute analogue of runlibfile0.
- /execute0
- { stopped $error /newerror get and
- { handleerror flush /execute0 cvx 1 .quit
- } if
- } bind def
- % Define the procedure that the C code uses for running files
- % named on the command line.
- /.runfile /runlibfile load def
-
- % Define a special version of runlibfile that aborts on errors.
- /runlibfile0
- { cvlit dup /.currentfilename exch def
- { findlibfile not { stop } if }
- stopped
- { (Can't find (or open) initialization file ) print
- .currentfilename == flush /runlibfile0 cvx 1 .quit
- } if
- exch pop cvx stopped
- { (While reading ) print .currentfilename print (:\n) print flush
- handleerror /runlibfile0 1 .quit
- } if
- } bind def
- % Temporarily substitute it for the real runlibfile.
- /.runlibfile /runlibfile load def
- /runlibfile /runlibfile0 load def
-
- % Create the error handling machinery.
- % Define the standard error handlers.
- % The interpreter has created the ErrorNames array.
- /.unstoppederrorhandler % <command> <errorname> .unstoppederrorhandler -
- { % This is the handler that gets used for recursive errors,
- % or errors outside the scope of a 'stopped'.
- (Unrecoverable error: ) print dup =only flush
- ( in ) print 1 index = flush
- count 2 gt
- { (Operand stack:\n ) print
- 2 1 count 3 sub { ( ) print index =only flush } for
- (\n) print flush
- } if
- -1 0 1 //ErrorNames length 1 sub
- { dup //ErrorNames exch get 3 index eq
- { not exch pop exit } { pop } ifelse
- }
- for exch pop .quit
- } bind def
- /.errorhandler % <command> <errorname> .errorhandler -
- { % Detect an internal 'stopped'.
- .instopped { null eq { pop pop stop } if } if
- $error /.inerror get .instopped { pop } { pop true } ifelse
- { .unstoppederrorhandler
- } if % detect error recursion
- $error /globalmode .currentglobal false .setglobal put
- $error /.inerror true put
- $error /newerror true put
- $error exch /errorname exch put
- $error exch /command exch put
- $error /recordstacks get $error /errorname get /VMerror ne and
- { % Attempt to store the stack contents atomically.
- count array astore dup $error /ostack 4 -1 roll
- countexecstack array execstack $error /estack 3 -1 roll
- countdictstack array dictstack $error /dstack 3 -1 roll
- put put put aload pop
- }
- { $error /dstack undef
- $error /estack undef
- $error /ostack undef
- }
- ifelse
- $error /position currentfile status
- { currentfile { fileposition } null .stopped null ne { pop null } if
- }
- { null
- }
- ifelse put
- % During initialization, we don't reset the allocation
- % mode on errors.
- $error /globalmode get $error /.nosetlocal get and .setglobal
- $error /.inerror false put
- stop
- } bind def
- % Define the standard handleerror. We break out the printing procedure
- % (.printerror) so that it can be extended for binary output
- % if the Level 2 facilities are present.
- /.printerror
- { (Error: ) print
- $error begin
- errorname ==only flush
- ( in ) print
- /command load ==only flush
- currentdict /errorinfo .knownget
- { (\nAdditional information: ) print ==only flush
- } if
-
- % Push the (anonymous) stack printing procedure.
- % <heading> <==flag> <override-name> <stackname> proc
- {
- currentdict exch .knownget % stackname defined in errordict?
- {
- 4 1 roll % stack: <stack> <head> <==flag> <over>
- currentdict exch .knownget % overridename defined?
- {
- exch pop exch pop exec } % call override with <stack>
- {
- exch print exch % print heading. stack <==flag> <stack>
- { ( ) print
- dup type /dicttype eq
- {
- (--dict:) print dup length =only (/) print maxlength =only
- (--) print
- }
- {
- dup type /stringtype eq 2 index or
- { ==only } { =only } ifelse
- } ifelse
- } forall
- pop
- }
- ifelse % overridden
- }
- { pop pop pop
- }
- ifelse % stack known
- }
-
- (\nOperand stack:\n ) OSTACKPRINT /.printostack /ostack 4 index exec
- (\nExecution stack:\n ) ESTACKPRINT /.printestack /estack 4 index exec
- (\nBacktrace:\n ) true /.printbacktrace /backtrace 4 index exec
- (\nDictionary stack:\n ) true /.printdstack /dstack 4 index exec
- (\n) print
- pop % printing procedure
-
- errorname /VMerror eq
- { (VM status:) print mark vmstatus
- counttomark { ( ) print counttomark -1 roll dup =only } repeat
- cleartomark (\n) print
- } if
-
- .languagelevel 2 ge
- { (Current allocation mode is ) print
- globalmode { (global\n) } { (local\n) } ifelse print
- } if
-
- .oserrno dup 0 ne
- { (Last OS error: ) print
- errorname /VMerror ne
- { dup .oserrorstring { = pop } { = } ifelse }
- { = }
- ifelse
- }
- { pop
- }
- ifelse
-
- position null ne
- { (Current file position is ) print position = }
- if
-
- .clearerror
- end
- flush
- } bind def
- % Define a procedure for clearing the error indication.
- /.clearerror
- { $error /newerror false put
- $error /errorinfo undef
- 0 .setoserrno
- } bind def
-
- % Define $error. This must be in local VM.
- .currentglobal false .setglobal
- /$error 40 dict def % newerror, errorname, command, errorinfo,
- % ostack, estack, dstack, recordstacks,
- % binary, globalmode,
- % .inerror, .nosetlocal, position,
- % plus extra space for badly designed error handers.
- $error begin
- /newerror false def
- /recordstacks true def
- /binary false def
- /globalmode .currentglobal def
- /.inerror false def
- /.nosetlocal true def
- /position null def
- end
- % Define errordict similarly. It has one entry per error name,
- % plus handleerror.
- /errordict ErrorNames length 1 add dict def
- errordict begin
- ErrorNames
- { [ 1 index systemdict /.errorhandler get /exec load ] cvx def
- } forall
- /handleerror
- { systemdict /.printerror get exec
- } bind def
- end
- .setglobal
-
- % Define the [write]==[only] procedures.
- /.dict 26 dict dup
- begin def
- /.cvp {1 index exch .writecvs} bind def
- /.nop {exch pop .p} bind def
- /.p {1 index exch writestring} bind def
- /.p1 {2 index exch writestring} bind def
- /.p2 {3 index exch writestring} bind def
- /.print
- { dup type .dict exch .knownget
- { dup type /stringtype eq { .nop } { exec } ifelse }
- { (-) .p1 type .cvp (-) .p }
- ifelse
- } bind def
- /.pstring
- { { dup dup 32 lt exch 127 ge or
- { (\\) .p1 2 copy -6 bitshift 48 add write
- 2 copy -3 bitshift 7 and 48 add write
- 7 and 48 add
- }
- { dup dup -2 and 40 eq exch 92 eq or {(\\) .p1} if
- }
- ifelse 1 index exch write
- }
- forall
- } bind def
- /booleantype /.cvp load def
- /conditiontype (-condition-) def
- /devicetype (-device-) def
- /dicttype (-dict-) def
- /filetype (-file-) def
- /fonttype (-fontID-) def
- /gstatetype (-gstate-) def
- /integertype /.cvp load def
- /locktype (-lock-) def
- /marktype (-mark-) def
- /nulltype (-null-) def
- /realtype /.cvp load def
- /savetype (-save-) def
- /nametype
- {dup xcheck not {(/) .p1} if
- 1 index exch .writecvs} bind def
- /arraytype
- {dup rcheck
- {() exch dup xcheck
- {({) .p2
- {exch .p1
- 1 index exch .print pop ( )} forall
- (})}
- {([) .p2
- {exch .p1
- 1 index exch .print pop ( )} forall
- (])}
- ifelse exch pop .p}
- {(-array-) .nop}
- ifelse} bind def
- /operatortype
- {(--) .p1 .cvp (--) .p} bind def
- /packedarraytype
- { dup rcheck
- { arraytype }
- { (-packedarray-) .nop }
- ifelse
- } bind def
- /stringtype
- { dup rcheck
- { (\() .p1 dup length 200 le
- { .pstring }
- { 0 200 getinterval .pstring (...) .p }
- ifelse (\)) .p
- }
- { (-string-) .nop
- }
- ifelse
- } bind def
- {//.dict begin .print pop end}
- bind cvx
- end
-
- /write==only exch def
- /write==
- {1 index exch write==only (\n) writestring} bind def
- /==only {.stdout exch write==only} bind def
- /== {==only (\n) print} bind def
-
- (END PROCS) VMDEBUG
-
- % Define the font directory.
- % Make it big to leave room for transformed fonts.
- /FontDirectory false .setglobal 100 dict true .setglobal def
-
- % Define the encoding dictionary.
- /.encodingdict 5 dict def % leave 1 extra for KanjiSubEncoding
-
- % Define findencoding. (This is redefined in Level 2.)
- /.findencoding
- { //.encodingdict exch get exec
- } bind def
- /.defineencoding
- { //.encodingdict 3 1 roll put
- } bind def
-
- % Load StandardEncoding.
- %% Replace 1 (gs_std_e.ps)
- (gs_std_e.ps) dup runlibfile VMDEBUG
-
- % Load ISOLatin1Encoding.
- %% Replace 1 (gs_iso_e.ps)
- (gs_iso_e.ps) dup runlibfile VMDEBUG
-
- % Define stubs for the Symbol and Dingbats encodings.
- % Note that the first element of the procedure must be the file name,
- % since gs_lev2.ps extracts it to set up the Encoding resource category.
-
- /SymbolEncoding { /SymbolEncoding .findencoding } bind def
- %% Replace 3 (gs_sym_e.ps)
- .encodingdict /SymbolEncoding
- { (gs_sym_e.ps) systemdict begin runlibfile SymbolEncoding end }
- bind put
-
- /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def
- %% Replace 3 (gs_dbt_e.ps)
- .encodingdict /DingbatsEncoding
- { (gs_dbt_e.ps) systemdict begin runlibfile DingbatsEncoding end }
- bind put
-
- (END FONTDIR/ENCS) VMDEBUG
-
- % Construct a dictionary of all available devices.
- mark
- % Loop until the .getdevice gets a rangecheck.
- errordict /rangecheck 2 copy get
- errordict /rangecheck { pop stop } put % pop the command
- 0 { {dup .getdevice exch 1 add} loop} stopped pop
- dict /devicedict exch def
- devicedict begin % 2nd copy of count is on stack
- { dup .devicename dup 3 -1 roll def
- counttomark 1 roll
- } repeat
- end put
- counttomark packedarray /devicenames exch def pop
- .clearerror
-
- (END DEVS) VMDEBUG
-
- % Define statusdict, for the benefit of programs
- % that think they are running on a LaserWriter or similar printer.
- %% Replace 1 (gs_statd.ps)
- (gs_statd.ps) runlibfile
-
- (END STATD) VMDEBUG
-
- % Load the standard font environment.
- %% Replace 1 (gs_fonts.ps)
- (gs_fonts.ps) runlibfile
-
- (END GS_FONTS) VMDEBUG
-
- % Create a null font. This is the initial font.
- 8 dict dup begin
- /FontMatrix [ 1 0 0 1 0 0 ] readonly def
- /FontType 3 def
- /FontName () def
- /Encoding StandardEncoding def
- /FontBBox { 0 0 0 0 } readonly def % executable is bogus, but customary ...
- /BuildChar { pop pop 0 0 setcharwidth } bind def
- /PaintType 0 def % shouldn't be needed!
- end
- /NullFont exch definefont setfont
-
- % Define NullFont as the font, but remove it from FontDirectory.
- /NullFont currentfont def
- FontDirectory /NullFont undef
-
- (END FONTS) VMDEBUG
-
- % Load the initialization files for optional features.
- %% Replace 4 INITFILES
- systemdict /INITFILES known
- { INITFILES { dup runlibfile VMDEBUG } forall
- }
- if
-
- % If Level 2 functionality is implemented, enable it now.
- /.setlanguagelevel where { pop 2 .setlanguagelevel } if
-
- (END INITFILES) VMDEBUG
-
- % Restore the real definition of runlibfile.
- /runlibfile /.runlibfile load def
- currentdict /.runlibfile undef
-
- % Bind all the operators defined as procedures.
- /.bindoperators % binds operators in currentdict
- { % Temporarily disable the typecheck error.
- errordict /typecheck 2 copy get
- errordict /typecheck { pop } put % pop the command
- currentdict
- { dup type /operatortype eq
- { % This might be a real operator, so bind might cause a typecheck,
- % but we've made the error a no-op temporarily.
- .bind % do a real bind even if NOBIND is set
- }
- if pop pop
- } forall
- put
- } def
- NOBIND not { .bindoperators } if
-
- % Establish a default environment.
-
- DISPLAYING not
- { nulldevice (%END DISPLAYING) .skipeof
- } if
- /defaultdevice 0 .getdevice systemdict /DEVICE known
- { pop devicedict DEVICE known not
- { (Unknown device: ) print DEVICE =
- flush /defaultdevice cvx 1 .quit
- }
- if DEVICE finddevice
- }
- if def
- defaultdevice
- systemdict /DEVICEWIDTH known
- systemdict /DEVICEHEIGHT known or
- systemdict /DEVICEWIDTHPOINTS known or
- systemdict /DEVICEHEIGHTPOINTS known or
- systemdict /DEVICEXRESOLUTION known or
- systemdict /DEVICEYRESOLUTION known or
- systemdict /PAPERSIZE known or
- not { (%END DEVICE) .skipeof } if
- systemdict /PAPERSIZE known
- { % Convert the paper size to device dimensions.
- true statusdict /.pagetypenames get
- { PAPERSIZE eq
- { PAPERSIZE load
- dup 0 get /DEVICEWIDTHPOINTS exch def
- 1 get /DEVICEHEIGHTPOINTS exch def
- pop false exit
- }
- if
- }
- forall
- { (Unknown paper size: ) print PAPERSIZE ==only (.\n) print
- }
- if
- }
- if
- % Adjust the device parameters per the command line.
- getdeviceprops .dicttomark begin
- 6 dict begin
- /dw HWSize 0 get def
- /dh HWSize 1 get def
- /dmat InitialMatrix def
- /dxres HWResolution 0 get def
- /dyres HWResolution 1 get def
- /DEVICEXRESOLUTION where
- { pop /drq DEVICEXRESOLUTION dxres div def
- 0 2 4
- { dup
- dmat exch get drq mul
- dmat 3 1 roll put
- }
- for
- dw drq mul round cvi /dw exch def
- /dxres DEVICEXRESOLUTION def
- }
- if
- /DEVICEYRESOLUTION where
- { pop /drq DEVICEYRESOLUTION dyres div def
- 1 2 5
- { dup
- dmat exch get drq mul
- dmat 3 1 roll put
- }
- for
- dh drq mul round cvi /dh exch def
- /dyres DEVICEYRESOLUTION def
- }
- if
- % Check for device sizes specified in pixels.
- /DEVICEWIDTH where
- { pop /dw DEVICEWIDTH def
- }
- if
- /DEVICEHEIGHT where
- { pop /dh DEVICEHEIGHT def
- }
- if
- % Check for device sizes specified in points.
- /DEVICEWIDTHPOINTS where
- { pop /dw DEVICEWIDTHPOINTS dxres mul 72 div round cvi def
- }
- if
- /DEVICEHEIGHTPOINTS where
- { pop /dh DEVICEHEIGHTPOINTS dyres mul 72 div round cvi def
- }
- if
- mark
- /HWSize [ dw dh ] /HWResolution [ dxres dyres ] %/InitialMatrix dmat
- defaultdevice putdeviceprops
- end end
- %END DEVICE
- % Set any device properties defined on the command line.
- dup getdeviceprops
- counttomark 2 idiv
- { systemdict 2 index known
- { pop dup load counttomark 2 roll }
- { pop pop }
- ifelse
- } repeat
- systemdict /BufferSpace known
- systemdict /MaxBitmap known not and
- { /MaxBitmap BufferSpace
- } if
- counttomark dup 0 ne
- { 2 add -1 roll putdeviceprops }
- { pop pop }
- ifelse
- setdevice % does an erasepage
- %END DISPLAYING
-
- (END DEVICE) VMDEBUG
-
- % Establish a default upper limit in the character cache,
- % namely, enough room for a 1/4" x 1/4" character at the resolution
- % of the default device, or for 5 x the "average" character size,
- % whichever is larger.
- mark
- % Compute limit based on character size.
- 18 18 dtransform % 1/4" x 1/4"
- exch abs cvi 31 add 32 idiv 4 mul % X raster
- exch abs cvi mul % Y
- % Compute limit based on allocated space.
- cachestatus 5 2 roll pop pop pop pop div 5 mul cvi exch pop
- max dup 10 idiv exch
- setcacheparams
- % Conditionally disable the character cache.
- NOCACHE { 0 setcachelimit } if
-
- (END CONFIG) VMDEBUG
-
- % Establish an appropriate halftone screen.
-
- /.transfermatrix matrix def
- 72 72 dtransform abs exch abs min % min(|dpi x|,|dpi y|)
- dup 150 lt systemdict /DITHERPPI known not and
- { % Low-res device, use ordered dither spot function
- % The following 'ordered dither' spot function was contributed by
- % Gregg Townsend. Thanks, Gregg!
- 16.001 div 0 % not 16: avoids rounding problems
- { 1 add 7.9999 mul cvi exch 1 add 7.9999 mul cvi 16 mul add <
- 0E 8E 2E AE 06 86 26 A6 0C 8C 2C AC 04 84 24 A4
- CE 4E EE 6E C6 46 E6 66 CC 4C EC 6C C4 44 E4 64
- 3E BE 1E 9E 36 B6 16 96 3C BC 1C 9C 34 B4 14 94
- FE 7E DE 5E F6 76 D6 56 FC 7C DC 5C F4 74 D4 54
- 01 81 21 A1 09 89 29 A9 03 83 23 A3 0B 8B 2B AB
- C1 41 E1 61 C9 49 E9 69 C3 43 E3 63 CB 4B EB 6B
- 31 B1 11 91 39 B9 19 99 33 B3 13 93 3B BB 1B 9B
- F1 71 D1 51 F9 79 D9 59 F3 73 D3 53 FB 7B DB 5B
- 0D 8D 2D AD 05 85 25 A5 0F 8F 2F AF 07 87 27 A7
- CD 4D ED 6D C5 45 E5 65 CF 4F EF 6F C7 47 E7 67
- 3D BD 1D 9D 35 B5 15 95 3F BF 1F 9F 37 B7 17 97
- FD 7D DD 5D F5 75 D5 55 FF 7F DF 5F F7 77 D7 57
- 02 82 22 A2 0A 8A 2A AA 00 80 20 A0 08 88 28 A8
- C2 42 E2 62 CA 4A EA 6A C0 40 E0 60 C8 48 E8 68
- 32 B2 12 92 3A BA 1A 9A 30 B0 10 90 38 B8 18 98
- F2 72 D2 52 FA 7A DA 5A F0 70 D0 50 F8 78 D8 58
- > exch get 256 div
- }
- bind setscreen
- { } % transfer
- true % strokeadjust
- }
- { % Hi-res device, use 45 degree dot spot function.
- % According to information published by Hewlett-Packard,
- % they use a 60 line screen on 300 DPI printers and
- % an 85 line screen on 600 DPI printers.
- % 46 was suggested as a good frequency value for printers
- % between 200 and 400 DPI, so we use it for lower resolutions.
- systemdict /DITHERPPI known
- { DITHERPPI }
- { dup cvi 100 idiv 6 min {null 46 46 60 60 60 85} exch get }
- ifelse
- 1 index 4.01 div min % at least a 4x4 cell
- 45
- % The following screen algorithm is used by permission of the author.
- { 1 add 180 mul cos 1 0.08 add mul exch 2 add 180 mul cos
- 1 0.08 sub mul add 2 div % (C) 1989 Berthold K.P. Horn
- }
- bind
- % Ghostscript currently doesn't use correct, per-plane halftones
- % unless setcolorscreen has been executed. Since these are
- % computationally much more expensive than binary halftones,
- % we check to make sure they are really warranted, i.e., we have
- % a high-resolution CMYK device (i.e., not a display) with
- % fewer than 5 bits per plane (i.e., not a true-color device).
- 4 -1 roll 150 ge
- { /setcolorscreen where
- { pop defaultdevice getdeviceprops .dicttomark
- dup dup dup /RedValues known exch /GreenValues known and
- exch /BlueValues known and
- { dup dup /RedValues get 32 lt
- exch /GreenValues get 32 lt and
- exch /BlueValues get 32 lt and
- { 3 copy 6 copy setcolorscreen }
- { setscreen }
- ifelse
- }
- { pop setscreen
- }
- ifelse
- }
- { setscreen
- }
- ifelse
- }
- { setscreen
- }
- ifelse
- % Set the transfer function to lighten up the grays.
- % We correct at the high end so that very light grays
- % don't disappear completely if they darken <1 screen pixel.
- % Parameter values closer to 1 are better for devices with
- % less dot spreading; lower values are better with more spreading.
- % The value 0.8 is a compromise that will probably please no one!
- { 0.8 exp dup dup 0.9375 gt exch 0.995 lt and % > 15/16
- { currentscreen pop pop
- 72 exch div dup //.transfermatrix defaultmatrix dtransform
- cvi exch cvi mul abs % # of pixels in halftone cell
- 1 sub % tweak to avoid boundary
- 1 exch div 1 exch sub min
- }
- if
- } % transfer
- false % strokeadjust
- }
- ifelse
- /setstrokeadjust where { pop setstrokeadjust } { pop } ifelse
- settransfer
- initgraphics
- % The interpreter relies on there being at least 2 entries
- % on the graphics stack. Establish the second one now.
- gsave
-
- % Define some control sequences as no-ops.
- % This is a hack to get around problems
- % in some common PostScript-generating applications.
- <04> cvn { } def % Apple job separator
- <0404> cvn { } def % two of the same
- <1b> cvn { } def % MS Windows LaserJet 4 prologue
- <041b> cvn { } def % MS Windows LaserJet 4 epilogue
-
- % If we want a "safer" system, disable some obvious ways to cause havoc.
- SAFER not { (%END SAFER) .skipeof } if
- /file
- { dup (r) eq
- { file }
- { /invalidfileaccess signalerror }
- ifelse
- } bind odef
- /renamefile { /invalidfileaccess signalerror } odef
- /deletefile { /invalidfileaccess signalerror } odef
- /putdeviceprops
- { counttomark
- dup 2 mod 0 eq { pop /rangecheck signalerror } if
- 3 2 3 2 roll
- { dup index /OutputFile eq
- { -2 roll
- dup () ne { /putdeviceprops load /invalidfileaccess signalerror } if
- 3 -1 roll
- }
- { pop
- }
- ifelse
- } for
- putdeviceprops
- } bind odef
-
- %END SAFER
-
- % Turn off array packing, since some PostScript code assumes that
- % procedures are writable.
- false setpacking
-
- % Close up systemdict.
- end
- WRITESYSTEMDICT not { systemdict readonly pop } if
-
- (END INIT) VMDEBUG
-
- % Establish local VM as the default.
- false .setglobal
- $error /.nosetlocal false put
-
- % Clean up VM, and enable GC.
- /vmreclaim where
- { pop 2 vmreclaim 0 vmreclaim
- } if
-
- (END GC) VMDEBUG
-
- % The interpreter will run the initial procedure (start).
-