harvey/sys/lib/ghostscript/gs_dps2.ps

%    Copyright (C) 1990, 1996, 1997, 1998, 2000 Aladdin Enterprises.  All rights reserved.
% 
% This file is part of AFPL Ghostscript.
% 
% AFPL 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 Free Public License (the
% "License") for full details.
% 
% Every copy of AFPL 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 AFPL 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.

% $Id: gs_dps2.ps,v 1.3 2000/11/07 18:51:24 lpd Exp $
% Initialization file for basic Display PostScript functions
% that are also included in Level 2.

level2dict begin

% ------ Halftones ------ %

/.makestackdict
	{ { counttomark -1 roll } forall .dicttomark
	} bind def
/currenthalftone		% - currenthalftone <dict>
	{ mark .currenthalftone
	   { { exch pop }		% halftone
	     { /HalftoneType 1		% screen
		{ /Frequency /Angle /SpotFunction }
	       .makestackdict
	     }
	     { /HalftoneType 2		% colorscreen
		{ /RedFrequency /RedAngle /RedSpotFunction
		  /GreenFrequency /GreenAngle /GreenSpotFunction
		  /BlueFrequency /BlueAngle /BlueSpotFunction
		  /GrayFrequency /GrayAngle /GraySpotFunction
		}
	       .makestackdict
	     }
	   }
	  exch get exec
	} odef
% Define sethalftone so it converts types 1-4 to type 5.
/.makehalftoneRGBV {	% <dict> <type> <keys> <keysRGBV>
  4 -1 roll exch { 1 index exch get exch } forall 15 1 roll
  14 -2 roll mark 15 1 roll { /Gray /Blue /Green /Red } {
		% stack: v0 v1 v2 type keys comp
    mark
    2 index 0 get 8 -1 roll
    4 index 1 get 9 -1 roll
    6 index 2 get 10 -1 roll
		% stack: type keys comp mark k0 v0 k1 v1 k2 v2
    /HalftoneType 10 index .dicttomark
    counttomark 2 roll
  } forall pop pop
  /Default 1 index .dicttomark exch pop { .sethalftone5 }
} bind def

% The value of each entry in .halftonetypes is a procedure:
%	<setdict> <htdict> <<proc>> <setdict'> <htdict'> <sethalftoneproc>
% This allows us to use these procedures both for actually implementing
% sethalftone and for converting subsidiary dictionaries of HalftoneType 5
% halftones.
systemdict begin
15 dict /.halftonetypes 1 index def begin
  1 {
    mark exch /Default exch .dicttomark { .sethalftone5 }
  } bind def
  2 {
    1 { /Frequency /Angle /SpotFunction } {
      /RedFrequency /RedAngle /RedSpotFunction
      /GreenFrequency /GreenAngle /GreenSpotFunction
      /BlueFrequency /BlueAngle /BlueSpotFunction
      /GrayFrequency /GrayAngle /GraySpotFunction
    } .makehalftoneRGBV
  } bind def
  3 {
    mark exch /Default exch .dicttomark { .sethalftone5 }
  } bind def
  4 {
    3 { /Width /Height /Thresholds } {
      /RedWidth /RedHeight /RedThresholds
      /GreenWidth /GreenHeight /GreenThresholds
      /BlueWidth /BlueHeight /BlueThresholds
      /GrayWidth /GrayHeight /GrayThresholds
    } .makehalftoneRGBV
  } bind def
  5 {
    pop dup length dict copy
    mark 1 index {
		% Even HalftoneType 5 dictionaries have entries other than
		% subsidiary halftone dictionaries.
      dup type /dicttype ne {
	0
      } {
	dup /HalftoneType .knownget not { 0 } if
      } ifelse dup 5 gt {
		% Stack: dict mark ... keyN dictN httypeN
		% Assume that all HalftoneTypes > 5 convert to 5.
	1 index 3 1 roll
	//.halftonetypes exch get exec pop /Default get
		% Stack: dict mark ... keyN setdict'N htdict'N
	counttomark 1 add index 3 index 4 -1 roll put
      } {
	pop
      } ifelse
    } forall .dicttomark { .sethalftone5 }
  } bind def
end
end
/sethalftone {		% <dict> sethalftone -
	% We must create the new dictionary in the same VM as the
	% operand; otherwise, invalidaccess errors may occur.
  .currentglobal 1 index dup gcheck .setglobal
  dup //.halftonetypes 1 index /HalftoneType get get exec exec
  .setglobal pop
} odef
% Redefine setscreen and setcolorscreen to recognize halftone dictionaries,
% and to insert the Frequency and Angle into Type 1 halftones, per
% Adobe TN 5085.
/.fixsethalftonescreen		% <freq> <angle> <dict> .fix...screen
				%   <freq> <angle> <dict> <dict'>
 { dup dup /HalftoneType get 1 eq
    { dup wcheck not { dup length .copydict } if
      dup /Frequency 5 index put
      dup /Angle 4 index put
    }
   if
 } bind def
/setscreen		% <ignore*2> <dict> setscreen -
	{ dup type /dicttype eq
	   { .fixsethalftonescreen sethalftone pop pop pop }
	   { //setscreen }
	  ifelse
	} odef
/setcolorscreen		% <ignore*11> <dict> setcolorscreen -
	{ dup type /dicttype eq
	   { .fixsethalftonescreen sethalftone 12 { pop } repeat }
	   { //setcolorscreen }
	  ifelse
	} odef
% Redefine currentscreen and currentcolorscreen to extract the Frequency
% and Angle from Type 1 halftones, per Adobe TN 5085.
/.fixcurrenthalftonescreen	% <dict> .fix... <freq> <angle> <proc>
 { dup /HalftoneType get 1 eq
    { dup /Frequency get 1 index /Angle get }
    { 60 0 }
   ifelse 3 2 roll
 } bind def
/currentscreen		% - currentscreen 60 0 <dict>
	{ .currenthalftone
	   { { .fixcurrenthalftonescreen }	% halftone
	     { }				% screen
	     { 12 3 roll 9 { pop } repeat	% colorscreen
	       dup type /dicttype eq { .fixcurrenthalftonescreen } if
	     }
	   }
	  exch get exec
	} odef
/currentcolorscreen	% - currentcolorscreen (60 0 <dict>)*4
	{ .currenthalftone
	   { { .fixcurrenthalftonescreen 3 copy 6 copy }	% halftone
	     { 3 copy 6 copy }			% screen
	     { }				% colorscreen
	   }
	  exch get exec
	} odef

% ------ User objects ------ %

/.UserObjects {
  .userdict /UserObjects
} odef
% In order to get proper error recovery behavior, we need to be careful
% not to pop any operands from the stack until we're done.
% The code below faithfully duplicates the apparent array-growing
% behavior of Adobe interpreters.
/defineuserobject {		% <index> <value> defineuserobject -
  .UserObjects .knownget {
    length dup 3 index le {
		% Stack: index value len
      2 index eq { 1 index 2 mul } { 1 index 1 add } ifelse
      .localvmarray .UserObjects get
      1 index copy pop
      .UserObjects 3 -1 roll put
    } {
      pop
    } ifelse
  } {
    .UserObjects 3 index 1 add 10 .max .localvmarray put
  } ifelse
  .UserObjects get 2 index 2 index put pop pop
} odef
/execuserobject {		% <index> execuserobject -
  .UserObjects get 1 index get exch pop exec
} odef
/undefineuserobject {		% <index> undefineuserobject -
  .UserObjects get 1 index null put pop
} odef

% ------ Cache control ------ %

% Dummy definitions for cache control operators

/ucachestatus {			% - ucachestatus -mark- ? ? ? ? <size>
	mark 0 0 0 0 .userdict /.ucachesize .knownget not { 0 } if
} odef
/setucacheparams {		% -mark- ... <size> setucacheparams -
		% Provoke an appropriate error if needed.
	counttomark 1 lt { () 0 get } if
	0 or .userdict /.ucachesize 2 index 0 .max put cleartomark
} odef

end				% level2dict