gs_init.ps

遗传算法工具箱 希望高手指点 GATOOLS

% Define procedures for getting and setting the current device resolution.

/gsgetdeviceprop	% <device> <propname> gsgetdeviceprop <value>
 { 2 copy mark exch null .dicttomark .getdeviceparams
   dup mark eq		% if true, not found
    { pop dup /undefined signalerror }
    { 5 1 roll pop pop pop pop }
   ifelse
 } bind def
/gscurrentresolution	% - gscurrentresolution <[xres yres]>
 { currentdevice /HWResolution gsgetdeviceprop
 } bind def
/gssetresolution	% <[xres yres]> 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 (unless NOPROMPT is true)
		% and wait for the user to type something.
		% If the user just types a newline, flush it.
	     NOPROMPT { pop } { print flush } ifelse
	     .echo.mode false echo
	     (%stdin) (r) file dup read
	      { dup (\n) 0 get eq { pop pop } { unread } ifelse }
	      { pop }
	     ifelse echo
	   }
	   { pop
	   }
	  ifelse
	} bind def

% Define the procedure used by .runfile, .runstdin and .runstring
% for executing user input.
% This is called with a procedure or executable file on the operand stack.
/execute
	{ stopped
	  $error /newerror get and
	   { handleerror flush
	   } 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 } execute } def
% Define the procedure that the C code uses for running piped input.
/.runstdin { (%stdin) (r) file cvx execute0 } bind def
% Define the procedure that the C code uses for running commands
% given on the command line with -c.
/.runstring { cvx execute } 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'.
   2 copy SHORTERRORS
    { (%%[ Error: ) print =only flush
      (; OffendingCommand: ) print =only ( ]%%\n) print
    }
    { (Unrecoverable error: ) print =only flush
      ( in ) print = flush
      count 2 gt
       { (Operand stack:\n  ) print
	 2 1 count 3 sub { (  ) print index =only flush } for
	 (\n) print flush
       } if
    }
   ifelse
   -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 } .internalstopped { pop null } if
     }
     {		% If this was a scanner error, the file is no longer current,
		% but the command holds the file, which may still be open.
       $error /command get dup type /filetype eq
        { { fileposition } .internalstopped { pop null } if }
        { pop null }
       ifelse
     }
    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 begin
       /command load errorname SHORTERRORS
	{ (%%[ Error: ) print =only flush
	  (; OffendingCommand: ) print =only
	  currentdict /errorinfo .knownget
	   { (;\nErrorInfo:) print
	     dup type /arraytype eq
	      { { ( ) print =only } forall }
	      { ( ) print =only }
	     ifelse
	   } if
          ( ]%%\n) print flush
	}
	{ (Error: ) print ==only flush
	  ( in ) print ==only flush
	  currentdict /errorinfo .knownget
	   { (\nAdditional information: ) print ==only flush
	   } if
	  .printerror_long
	}
       ifelse
       .clearerror
     end
     flush
    } bind def     
  /.printerror_long			% long error printout,
					% $error is on the dict stack
   {	% Push the (anonymous) stack printing procedure.
	%  <heading> <==flag> <override-name> <stackname> proc
       {
	 currentdict exch .knownget	% stackname defined in $error?
	 {
	   4 1 roll			% stack: <stack> <head> <==flag> <over>
	   errordict exch .knownget	% overridename defined?
	   { 
	     exch pop exch pop exec	% call override with <stack>
	   }
	   { 
	     exch print exch		% print heading. stack <==flag> <stack>
	     1 index not { (\n) print } if
	     { 1 index { (\n    ) } { (   ) } ifelse print
	       dup type /dicttype eq
	       {
		 (--dict:) print
		 dup rcheck
		  { dup length =only (/) print maxlength =only }
		  { pop }
		 ifelse
		 (--) print
	       }
	       {
		 dup type /stringtype eq 2 index or
		 { ===only } { =only } ifelse
	       } ifelse
	     } forall
	     pop
	   }
	   ifelse			% overridden
	 }
	 { pop pop pop
	 }
	 ifelse				% stack known
       }

       (\nOperand stack:) OSTACKPRINT /.printostack /ostack 4 index exec
       (\nExecution stack:) ESTACKPRINT /.printestack /estack 4 index exec
       (\nBacktrace:) true /.printbacktrace /backtrace 4 index exec
       (\nDictionary stack:) false /.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

   } 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
.setglobal		% contents of errordict are global
errordict begin
  ErrorNames
   { mark 1 index systemdict /.errorhandler get /exec load .packtomark cvx def
   } forall
% The handlers for interrupt and timeout are special; there is no
% 'current object', so they push their own name.
   { /interrupt /timeout }
   { mark 1 index dup systemdict /.errorhandler get /exec load .packtomark cvx def
   } forall
/handleerror
 { //systemdict /.printerror get exec
 } bind def
end

% 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 {1 index exch true .writecvp} bind 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
end

/write==only exch def
/write== {1 index exch write==only (\n) writestring} bind def
/==only { (%stdout) (w) file exch write==only } bind def
/== {==only (\n) print} bind def

% Define [write]===[only], an extension that prints dictionaries
% in readable form and doesn't truncate strings.
/.dict /write==only load 0 get dup length dict .copydict dup
begin def
  /dicttype
	{ dup rcheck
	   { (<< ) .p1
	      { 2 index 3 -1 roll .print pop ( ) .p1
		1 index exch .print pop ( ) .p
	      }
	     forall (>>) .p
	   }
	   { (-dict-) .nop
	   }
	  ifelse
	} bind def
  /stringtype
	{ dup rcheck
	   { (\() .p1 .pstring (\)) .p }
	   { (-string-) .nop }
	  ifelse
	} bind def

{//.dict begin .print pop end}
  bind
end

/write===only exch def
/write=== {1 index exch write===only (\n) writestring} bind def
/===only { (%stdout) (w) file exch write===only } bind def
/=== { ===only (\n) print } bind def

(END PROCS) VMDEBUG

% Define the font directory.
/FontDirectory false .setglobal 100 dict true .setglobal def

% Define the encoding dictionary.
/EncodingDirectory 10 dict def	% enough for Level 2 + PDF standard encodings

% Define .findencoding.  (This is redefined in Level 2.)
/.findencoding
 { //EncodingDirectory exch get exec
 } bind def
/.defineencoding
 { //EncodingDirectory 3 1 roll put
 } bind def
% If we've got the composite font extensions, define findencoding.
/rootfont where { pop /findencoding { .findencoding } odef } if

% 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)
  EncodingDirectory /SymbolEncoding
   { (gs_sym_e.ps) //systemdict begin runlibfile SymbolEncoding end }
  bind put

  /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def
%% Replace 3 (gs_dbt_e.ps)
  EncodingDirectory /DingbatsEncoding
   { (gs_dbt_e.ps) //systemdict begin runlibfile DingbatsEncoding end }
  bind put

(END FONTDIR/ENCS) VMDEBUG

% Construct a dictionary of all available devices.
% These are (read-only) device prototypes that can't be