diff options
author | Staszek Wawrykiewicz <staw@gust.org.pl> | 2006-12-18 03:20:19 +0000 |
---|---|---|
committer | Staszek Wawrykiewicz <staw@gust.org.pl> | 2006-12-18 03:20:19 +0000 |
commit | 34c11d2616bb32772199abf210ae88d99665a824 (patch) | |
tree | b95fbfb76fcefd0ab1ca96dc631e2657a894ad6d /Master/xemtex/gslib/gs_lev2.ps | |
parent | b0ccdf9e931213c59344f3c097608e04721149b1 (diff) |
xemtex deleted
git-svn-id: svn://tug.org/texlive/trunk@2777 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/xemtex/gslib/gs_lev2.ps')
-rw-r--r-- | Master/xemtex/gslib/gs_lev2.ps | 935 |
1 files changed, 0 insertions, 935 deletions
diff --git a/Master/xemtex/gslib/gs_lev2.ps b/Master/xemtex/gslib/gs_lev2.ps deleted file mode 100644 index 70b62018752..00000000000 --- a/Master/xemtex/gslib/gs_lev2.ps +++ /dev/null @@ -1,935 +0,0 @@ -% Copyright (C) 1990, 2000 Aladdin Enterprises. All rights reserved. -% -% This program is free software; you can redistribute it and/or modify it -% under the terms of the GNU General Public License as published by the -% Free Software Foundation; either version 2 of the License, or (at your -% option) any later version. -% -% This program is distributed in the hope that it will be useful, but -% WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -% Public License for more details. -% -% You should have received a copy of the GNU General Public License along -% with this program; if not, write to the Free Software Foundation, Inc., -% 59 Temple Place, Suite 330, Boston, MA, 02111-1307. - -% $Id: gs_lev2.ps,v 1.7.2.4.2.3 2003/04/12 14:02:38 giles Exp $ -% Initialization file for Level 2 functions. -% When this is run, systemdict is still writable, -% but (almost) everything defined here goes into level2dict. - -level2dict begin - -% ------ System and user parameters ------ % - -% User parameters must obey save/restore, and must also be maintained -% per-context. We implement the former, and some of the latter, here -% with PostScript code. NOTE: our implementation assumes that user -% parameters change only as a result of setuserparams -- that there are -% no user parameters that are ever changed dynamically by the interpreter -% (although the interpreter may adjust the value presented to setuserparams) -% -% There are two types of user parameters: those which are actually -% maintained in the interpreter, and those which exist only at the -% PostScript level. We maintain the current state of both types in -% a read-only local dictionary named userparams, defined in systemdict. -% In a multi-context system, each context has its own copy of this -% dictionary. In addition, there is a constant dictionary named -% psuserparams where each key is the name of a user parameter that exists -% only in PostScript and the value is a procedure to check that the value -% is legal: setuserparams uses this for checking the values. -% setuserparams updates userparams explicitly, in addition to setting -% any user parameters in the interpreter; thus we can use userparams -% to reset those parameters after a restore or a context switch. -% NOTE: the name userparams is known to the interpreter, and in fact -% the interpreter creates the userparams dictionary. - -% Check parameters that are managed at the PostScript level. -/.checkparamtype { % <newvalue> <type> .checkparamtype <bool> - exch type eq -} .bind def -/.checksetparams { % <newdict> <opname> <checkdict> - % .checksetparams <newdict> - 2 index { - % Stack: newdict opname checkdict key newvalue - 3 copy 3 1 roll .knownget { - exec not { - pop pop pop load /typecheck signalerror - } if - dup type /stringtype eq { - dup rcheck not { - pop pop pop load /invalidaccess signalerror - } if - } if - } { - pop - } ifelse pop pop - } forall pop pop -} .bind def % not odef, shouldn't reset stacks - -% currentuser/systemparams creates and returns a dictionary in the -% current VM. The easiest way to make this work is to copy any composite -% PostScript-level parameters to global VM. Currently we have strings -% as well as arrays. For arrays, we also need to copy any contents that -% are in VM. Also copying string parameters insures the contents won't -% be changed. Also be careful to preserve 'executable' state. -/.copyparam { % <value> .copyparam <value'> - dup type /arraytype eq { - .currentglobal true .setglobal exch - dup xcheck exch % original executable state - [ exch { - dup type dup /arraytype eq exch /stringtype eq or { - .copyparam % recurse to handle composite array elements - } if - } forall ] - exch { cvx } if % set executable state - exch .setglobal - } if - dup type /stringtype eq { - .currentglobal true .setglobal - 1 index length string exch .setglobal - copy readonly - } if -} .bind def - -% Some user parameters are managed entirely at the PostScript level. -% We take care of that here. -systemdict begin -/psuserparams 48 dict def -/getuserparam { % <name> getuserparam <value> - /userparams .systemvar 1 index get exch pop -} odef -% Fill in userparams (created by the interpreter) with current values. -mark .currentuserparams -counttomark 2 idiv { - userparams 3 1 roll put -} repeat pop -/.definepsuserparam { % <name> <value> .definepsuserparam - - psuserparams 3 copy pop - type cvlit /.checkparamtype cvx 2 packedarray cvx put - userparams 3 1 roll put -} .bind def -end -/currentuserparams { % - currentuserparams <dict> - /userparams .systemvar dup length dict .copydict -} odef -/setuserparams { % <dict> setuserparams - - % Check that we will be able to set the PostScript-level - % user parameters. - /setuserparams /psuserparams .systemvar .checksetparams - % Set the C-level user params. If this succeeds, we know that - % the password check succeeded. - dup .setuserparams - % Now set the PostScript-level params. - % The interpreter may have adjusted the values of some of the - % parameters, so we have to read them back. - dup { - /userparams .systemvar 2 index known { - psuserparams 2 index known not { - pop dup .getuserparam - } if - .copyparam - /userparams .systemvar 3 1 roll .forceput % userparams is read-only - } { - pop pop - } ifelse - } forall - % A context switch might have occurred during the above loop, - % causing the interpreter-level parameters to be reset. - % Set them again to the new values. From here on, we are safe, - % since a context switch will consult userparams. - .setuserparams -} .bind odef -% Initialize user parameters managed here. -/JobName () .definepsuserparam - -% Restore must restore the user parameters. -% (Since userparams is in local VM, save takes care of saving them.) -/restore { % <save> restore - - //restore /userparams .systemvar .setuserparams -} .bind odef - -% The pssystemparams dictionary holds some system parameters that -% are managed entirely at the PostScript level. -systemdict begin -currentdict /pssystemparams known not { - /pssystemparams 40 dict readonly def -} if -/getsystemparam { % <name> getsystemparam <value> - //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse -} odef -end -/currentsystemparams { % - currentsystemparams <dict> - mark .currentsystemparams //pssystemparams { } forall .dicttomark -} odef -/setsystemparams { % <dict> setsystemparams - - % Check that we will be able to set the PostScript-level - % system parameters. - /SAFETY .systemvar /safe get { - % SAFER mode disallows some changes - [ /GenericResourceDir /FontResourceDir /GenericResourcePathSep ] { - 2 copy .knownget { - exch //pssystemparams exch .knownget { - ne { /setsystemparams /invalidaccess signalerror } if - } { - pop - } ifelse - } { - pop - } ifelse - } forall - } if - /setsystemparams //pssystemparams mark exch { - type cvlit /.checkparamtype cvx 2 packedarray cvx - } forall .dicttomark .checksetparams - % Set the C-level system params. If this succeeds, we know that - % the password check succeeded. - dup .setsystemparams - % Now set the PostScript-level params. We must copy local strings - % into global VM. - dup - { //pssystemparams 2 index known - { % Stack: key newvalue - .copyparam - //pssystemparams 3 1 roll .forceput % pssystemparams is read-only - } - { pop pop - } - ifelse - } - forall pop -} .bind odef - -% Initialize the passwords. -% NOTE: the names StartJobPassword and SystemParamsPassword are known to -% the interpreter, and must be bound to noaccess strings. -% The length of these strings must be max_password (iutil2.h) + 1. -/StartJobPassword 65 string noaccess def -/SystemParamsPassword 65 string noaccess def - -% Redefine cache parameter setting to interact properly with userparams. -/setcachelimit { - mark /MaxFontItem 2 index .dicttomark setuserparams pop -} .bind odef -/setcacheparams { - % The MaxFontCache parameter is a system parameter, which we might - % not be able to set. Fortunately, this doesn't matter, because - % system parameters don't have to be synchronized between this code - % and the VM. - counttomark 1 add copy setcacheparams - currentcacheparams % mark size lower upper - 3 -1 roll pop - /MinFontCompress 3 1 roll - /MaxFontItem exch - .dicttomark setuserparams - cleartomark -} .bind odef - -% Add bogus user and system parameters to satisfy badly written PostScript -% programs that incorrectly assume the existence of all the parameters -% listed in Appendix C of the Red Book. Note that some of these may become -% real parameters later: code near the end of gs_init.ps takes care of -% removing any such parameters from ps{user,system}params. - -% psuserparams - /MaxFormItem 100000 .definepsuserparam - /MaxPatternItem 20000 .definepsuserparam - /MaxScreenItem 48000 .definepsuserparam - /MaxUPathItem 5000 .definepsuserparam - -% File Access Permission parameters - .currentglobal true .setglobal - /.checkFilePermitparams { - type /arraytype eq { - currentuserparams /LockFilePermissions get { - 5 { pop } repeat /setuserparams /invalidaccess signalerror - } - if - } { - 5 { pop } repeat /setuserparams /typecheck signalerror - } - ifelse - true - } .bind def -% Initialize the File Permission access control to wide open -% These will only be accessed via current/set userparams. -% Values are a string containing multiple nul terminated path strings - /PermitFileReading dup [ (*) ] .definepsuserparam - psuserparams exch /.checkFilePermitparams load put - /PermitFileWriting dup [ (*) ] .definepsuserparam - psuserparams exch /.checkFilePermitparams load put - /PermitFileControl dup [ (*) ] .definepsuserparam - psuserparams exch /.checkFilePermitparams load put - .setglobal - -pssystemparams begin - /CurDisplayList 0 .forcedef - /CurFormCache 0 .forcedef - /CurOutlineCache 0 .forcedef - /CurPatternCache 0 .forcedef - /CurUPathCache 0 .forcedef - /CurScreenStorage 0 .forcedef - /CurSourceList 0 .forcedef - /DoPrintErrors false .forcedef - /MaxDisplayList 140000 .forcedef - /MaxFormCache 100000 .forcedef - /MaxOutlineCache 65000 .forcedef - /MaxPatternCache 100000 .forcedef - /MaxUPathCache 300000 .forcedef - /MaxScreenStorage 84000 .forcedef - /MaxSourceList 25000 .forcedef - /RamSize 4194304 .forcedef -end - -% Define the procedures for handling comment scanning. The names -% %ProcessComment and %ProcessDSCComment are known to the interpreter. -% These procedures take the file and comment string and file as operands. -/.checkprocesscomment { - dup null eq { - pop true - } { - dup xcheck { - type dup /arraytype eq exch /packedarraytype eq or - } { - pop false - } ifelse - } ifelse -} .bind def -/ProcessComment null .definepsuserparam -psuserparams /ProcessComment {.checkprocesscomment} put -(%ProcessComment) cvn { - /ProcessComment getuserparam - dup null eq { pop pop pop } { exec } ifelse -} bind def -/ProcessDSCComment null .definepsuserparam -psuserparams /ProcessDSCComment {.checkprocesscomment} put -(%ProcessDSCComment) cvn { - /ProcessDSCComment getuserparam - dup null eq { pop pop pop } { exec } ifelse -} bind def - -% ------ Miscellaneous ------ % - -(<<) cvn % - << -mark- - /mark load def -(>>) cvn % -mark- <key1> <value1> ... >> <dict> - /.dicttomark load def -/languagelevel 2 def -% When running in Level 2 mode, this interpreter is supposed to be -% compatible with Adobe version 2017. -/version (2017) readonly def - -% If binary tokens are supported by this interpreter, -% set an appropriate default binary object format. -/setobjectformat where - { pop - /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse - /ByteOrder getsystemparam { 1 add } if - setobjectformat - } if - -% Aldus Freehand versions 2.x check for the presence of the -% setcolor operator, and if it is missing, substitute a procedure. -% Unfortunately, the procedure takes different parameters from -% the operator. As a result, files produced by this application -% cause an error if the setcolor operator is actually defined -% and 'bind' is ever used. Aldus fixed this bug in Freehand 3.0, -% but there are a lot of files created by the older versions -% still floating around. Therefore, at Adobe's suggestion, -% we implement the following dreadful hack in the 'where' operator: -% If the key is /setcolor, and -% there is a dictionary named FreeHandDict, and -% currentdict is that dictionary, -% then "where" consults only that dictionary and not any other -% dictionaries on the dictionary stack. -.wheredict /setcolor { - /FreeHandDict .where { - /FreeHandDict get currentdict eq { - pop currentdict /setcolor known { currentdict true } { false } ifelse - } { - .where - } ifelse - } { - .where - } ifelse -} bind put - -% ------ Virtual memory ------ % - -/currentglobal % - currentglobal <bool> - /currentshared load def -/gcheck % <obj> gcheck <bool> - /scheck load def -/setglobal % <bool> setglobal - - /setshared load def -% We can make the global dictionaries very small, because they auto-expand. -/globaldict currentdict /shareddict .knownget not { 4 dict } if def -/GlobalFontDirectory SharedFontDirectory def - -% VMReclaim and VMThreshold are user parameters. -/setvmthreshold { % <int> setvmthreshold - - mark /VMThreshold 2 index .dicttomark setuserparams pop -} odef -/vmreclaim { % <int> vmreclaim - - dup 0 gt { - .vmreclaim - } { - mark /VMReclaim 2 index .dicttomark setuserparams pop - } ifelse -} odef --1 setvmthreshold - -% ------ IODevices ------ % - -/.getdevparams where { - pop /currentdevparams { % <iodevice> currentdevparams <dict> - .getdevparams .dicttomark - } odef -} if -/.putdevparams where { - pop /setdevparams { % <iodevice> <dict> setdevparams - - mark 1 index { } forall counttomark 2 add index - .putdevparams pop pop - } odef -} if - -% ------ Job control ------ % - -serverdict begin - -% We could protect the job information better, but we aren't attempting -% (currently) to protect ourselves against maliciousness. - -/.jobsave null def % top-level save object -/.jobsavelevel 0 def % save depth of job (0 if .jobsave is null, - % 1 otherwise) -/.adminjob true def % status of current unencapsulated job - -end % serverdict - -% Because there may be objects on the e-stack created since the job save, -% we have to clear the e-stack before doing the end-of-job restore. -% We do this by executing a 2 .stop, which is caught by the 2 .stopped -% in .runexec; we leave on the o-stack a procedure to execute aftewards. -% -%**************** The definition of startjob is not complete yet, since -% it doesn't reset stdin/stdout. -/.startnewjob { % <exit_bool> <password_level> - % .startnewjob - - serverdict /.jobsave get dup null eq { pop } { restore } ifelse - exch { - % Unencapsulated job - serverdict /.jobsave null put - serverdict /.jobsavelevel 0 put - serverdict /.adminjob 3 -1 roll 1 gt put - % The Adobe documentation doesn't say what happens to the - % graphics state stack in this case, but an experiment - % produced results suggesting that a grestoreall occurs. - grestoreall - } { - % Encapsulated job - pop - serverdict /.jobsave save put - serverdict /.jobsavelevel 1 put - } ifelse - % Reset the interpreter state. - clear cleardictstack - initgraphics - false setglobal -} bind def -/.startjob { % <exit_bool> <password> <finish_proc> - % .startjob <ok_bool> - vmstatus pop pop serverdict /.jobsavelevel get eq - 2 index .checkpassword 0 gt and { - exch .checkpassword exch count 3 roll count 3 sub { pop } repeat - cleardictstack - % Reset the e-stack back to the 2 .stopped in .runexec, - % passing the finish_proc to be executed afterwards. - 2 .stop - } { % Password check failed - pop pop pop false - } ifelse -} odef -/startjob { % <exit_bool> <password> startjob <ok_bool> - % This is a hack. We really need some way to indicate explicitly - % to the interpreter that we are under control of a job server. - .userdict /quit /stop load put - { .startnewjob true } .startjob -} odef - -systemdict begin -/quit { % - quit - - //systemdict begin serverdict /.jobsave get null eq - { end //quit } - { /quit load /invalidaccess /signalerror load end exec } - ifelse -} bind odef -end - -% We would like to define exitserver as a procedure, using the code -% that the Red Book says is equivalent to it. However, since startjob -% resets the exec stack, we can't do this, because control would never -% proceed past the call on startjob if the exitserver is successful. -% Instead, we need to construct exitserver out of pieces of startjob. - -serverdict begin - -/exitserver { % <password> exitserver - - true exch { .startnewjob } .startjob not { - /exitserver /invalidaccess signalerror - } if -} bind def - -end % serverdict - -% ------ Compatibility ------ % - -% In Level 2 mode, the following replace the definitions that gs_statd.ps -% installs in statusdict and serverdict. -% Note that statusdict must be allocated in local VM. -% We don't bother with many of these yet. - -/.dict1 { exch mark 3 1 roll .dicttomark } bind def - -currentglobal false setglobal 25 dict exch setglobal begin -currentsystemparams - -% The following do not depend on the presence of setpagedevice. -/buildtime 1 index /BuildTime get def -/byteorder 1 index /ByteOrder get def -/checkpassword { .checkpassword 0 gt } bind def -dup /DoStartPage known - { /dostartpage { /DoStartPage getsystemparam } bind def - /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def - } if -dup /StartupMode known - { /dosysstart { /StartupMode getsystemparam 0 ne } bind def - /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def - } if -%****** Setting jobname is supposed to set userparams.JobName, too. -/jobname { /JobName getuserparam } bind def -/jobtimeout { /JobTimeout getuserparam } bind def -/ramsize { /RamSize getsystemparam } bind def -/realformat 1 index /RealFormat get def -dup /PrinterName known - { /setprintername { /PrinterName .dict1 setsystemparams } bind def - } if -/printername - { currentsystemparams /PrinterName .knownget not { () } if exch copy - } bind def -currentuserparams /WaitTimeout known - { /waittimeout { /WaitTimeout getuserparam } bind def - } if - -% The following do require setpagedevice. -/.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse -/defaulttimeouts - { currentsystemparams dup - /JobTimeout .knownget not { 0 } if - exch /WaitTimeout .knownget not { 0 } if - currentpagedevice /ManualFeedTimeout .knownget not { 0 } if - } bind def -/margins - { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse - } bind def -/pagemargin - { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse - } bind def -/pageparams - { currentpagedevice - dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch - dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll - /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll - } bind def -/setdefaulttimeouts - { exch mark /ManualFeedTimeout 3 -1 roll - /Policies mark /ManualFeedTimeout 1 .dicttomark - .dicttomark setpagedevice - /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams - } bind def -/.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def -/setduplexmode { /Duplex .dict1 setpagedevice } bind def -/setmargins - { exch 2 array astore /Margins .dict1 setpagedevice - } bind def -/setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def -/setpageparams - { mark /PageSize 6 -2 roll - 4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore - /Orientation 5 -1 roll ORIENT1 { 1 xor } if - /PageOffset counttomark 2 add -1 roll 0 2 array astore - .dicttomark setpagedevice - } bind def -/setresolution - { dup 2 array astore /HWResolution .dict1 setpagedevice - } bind def -%END PAGEDEVICE - -% The following are not implemented yet. -%manualfeed -%manualfeedtimeout -%pagecount -%pagestackorder -%setpagestackorder - -pop % currentsystemparams - -% Flag the current dictionary so it will be swapped when we -% change language levels. (See zmisc2.c for more information.) -/statusdict currentdict def - -currentdict end -/statusdict exch .forcedef % statusdict is local, systemdict is global - -% The following compatibility operators are in systemdict. They are -% defined here, rather than in gs_init.ps, because they require the -% resource machinery. - -/devforall { % <pattern> <proc> <scratch> devforall - - exch { - 1 index currentdevparams - /Type .knownget { /FileSystem eq } { false } ifelse - { exec } { pop pop } ifelse - } /exec load 3 packedarray cvx exch - (*) 3 1 roll ppstack flush /IODevice resourceforall -} odef -/devstatus { % <(%disk*%)> devstatus <searchable> <writable> - % <hasNames> <mounted> <removable> <searchOrder> - % <freePages> <size> true - % <string> devstatus false - dup length 5 ge { - dup 0 5 getinterval (%disk) eq { - dup /IODevice resourcestatus { - pop pop dup currentdevparams - dup /Searchable get - exch dup /Writable get - exch dup /HasNames get - exch dup /Mounted get - exch dup /Removable get - exch dup /SearchOrder get - exch dup /Free get - exch /LogicalSize get - 9 -1 roll pop true - } { - pop false - } ifelse - } { - pop false - } ifelse - } { - pop false - } ifelse -} odef - -% ------ Color spaces ------ % - -% Attempt to convert a tint transformation procedure to a type 4 Function. -% The value <m> is the number of function inputs -% The current color space defines the number of function output values. -% The current color space will be the alternate color space for the function. -% If the conversion fails then build a color cube function. - -/.converttinttransform { % [.. .. .. proc ] <m> - % .converttinttransform [.. .. .. proc'] - .currentglobal % Save current global memory state - 2 index gcheck .setglobal % Set gobal mode to match the array's mode - 4 dict % Build a dictionary for our type 4 function - dup /FunctionType 4 put % Set FunctionType - dup /Function 5 index 3 get put % Set function expression - % Stack: orig m global func - dup /Domain - [ 5 index {0 1} repeat ] put % set Domain values - dup /Range - [ mark currentcolor counttomark - dup 2 add 1 roll cleartomark % # of components in alternate space - {0 1} repeat ] put % Set Range values - { .buildfunction } .internalstopped % Try to build a type 4 function - dup - { % type 4 function failed - Collect data for a color cube - pop % Remove duplicate copy of stopped status - pop % Remove invalid type 4 function - 1 index % Get number of inputs - mark currentcolor counttomark % Count number of output colors - dup 2 add 1 roll cleartomark % # of components in alternate space - 4 index 3 get % Get tint transform function - { .buildcolorcube } .internalstopped - } if - { % Color cube build failed - pop pop pop exch pop exch pop % Remove unused parameters - .setglobal % Restore global state - } { % Function build succeeded - install function - % Stack: orig m global func - 3 -1 roll pop % Stack: orig global func - 2 index 4 array copy dup 3 4 -1 roll put - exch .setglobal exch pop - } ifelse -} bind def - -% Define the setcolorspace procedures: -% <colorspace> proc <colorspace'|null> -% We have to define the dictionary first, so it can be bound into the -% implementation procedure, but we can't populate it until the procedure -% has been defined, so that the procedure can get bound into recursive calls. -/colorspacedict 20 dict def - -/.devcs [ - /DeviceGray /DeviceRGB /DeviceCMYK /DevicePixel -] readonly def -/currentcolorspace { % - currentcolorspace <array> - .currentcolorspace dup type /integertype eq { - //.devcs exch 1 getinterval - } if -} odef -currentdict /.devcs .undef - -/setcolorspace { % <name|array> setcolorspace - - dup dup dup type /nametype ne { 0 get } if - //colorspacedict exch get exec - dup null eq { pop } { .setcolorspace } ifelse pop -} odef - -colorspacedict - dup /DeviceGray { pop 0 setgray null } bind put - dup /DeviceRGB { pop 0 0 0 setrgbcolor null } bind put - /setcmykcolor where - { pop dup /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind put - } if - /.setcieaspace where - { pop dup /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind put - } if - /.setcieabcspace where - { pop dup /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind put - } if - /.setciedefspace where - { pop dup /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind put - } if - /.setciedefgspace where - { pop dup /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind put - } if - /.setseparationspace where - { pop dup /Separation { dup 2 get setcolorspace dup 1 .converttinttransform .setseparationspace } bind put - } if - /.setindexedspace where - { pop dup /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind put - } if - /.nullpatternspace [/Pattern] readonly def - /.setpatternspace where - { pop dup /Pattern - { dup type /nametype eq { pop //.nullpatternspace } if - dup length 1 gt { dup 1 get setcolorspace } if - dup .setpatternspace - } bind put - } if - % If DeviceN space is included, gs_ll3.ps registers it. - /.setdevicepixelspace where - { pop dup /DevicePixel { dup .setdevicepixelspace } bind put - } if - currentdict /.nullpatternspace .undef -pop - -% ------ CIE color rendering ------ % - -% Define findcolorrendering and a default ColorRendering ProcSet. - -/findcolorrendering { % <intentname> findcolorrendering - % <crdname> <found> - /ColorRendering /ProcSet findresource - 1 index .namestring (.) concatstrings - 1 index /GetPageDeviceName get exec .namestring (.) concatstrings - 2 index /GetHalftoneName get exec .namestring - concatstrings concatstrings - dup /ColorRendering resourcestatus { - pop pop exch pop exch pop true - } { - pop /GetSubstituteCRD get exec false - } ifelse -} odef - -5 dict dup begin - -/GetPageDeviceName { % - GetPageDeviceName <name> - currentpagedevice dup /PageDeviceName .knownget { - exch pop dup null eq { pop /none } if - } { - pop /none - } ifelse -} bind def - -/GetHalftoneName { % - GetHalftoneName <name> - currenthalftone /HalftoneName .knownget not { /none } if -} bind def - -/GetSubstituteCRD { % <intentname> GetSubstituteCRD <crdname> - pop /DefaultColorRendering -} bind def - -end -% The resource machinery hasn't been activated, so just save the ProcSet -% and let .fixresources finish the installation process. -/ColorRendering exch def - -% Define setcolorrendering. - -/.colorrenderingtypes 5 dict def - -/setcolorrendering { % <crd> setcolorrendering - - dup /ColorRenderingType get //.colorrenderingtypes exch get exec -} odef - -/.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse - -.colorrenderingtypes 1 { - dup .buildcolorrendering1 .setcolorrendering1 -} .bind put - -% Note: the value 101 in the next line must be the same as the value of -% GX_DEVICE_CRD1_TYPE in gscrdp.h. -.colorrenderingtypes 101 { - dup .builddevicecolorrendering1 .setdevicecolorrendering1 -} .bind put - -% Initialize the default CIE rendering dictionary. -% The most common CIE files seem to assume the "calibrated RGB color space" -% described on p. 189 of the PostScript Language Reference Manual, -% 2nd Edition; we simply invert this transformation back to RGB. -mark - /ColorRenderingType 1 -% We must make RangePQR and RangeLMN large enough so that values computed by -% the assumed encoding MatrixLMN don't get clamped. - /RangePQR [0 0.9505 0 1 0 1.0890] readonly -% This TransformPQR implements a relative colorimetric intent by scaling -% the XYZ values relative to the white and black points. - /TransformPQR - [ { 5 1 roll % p Ws Bs Wd Bd - 4 {3 get 5 1 roll} repeat % ws bs wd bd p - 3 index sub % ws bs wd bd p-bs - 1 index % ws bs wd bd p-bs bd - 6 2 roll % p-bs bd ws bs wd bd - sub % p-bs bd ws bs wd-bd - 5 1 roll % wd-bd p-bs bd ws bs - sub % wd-bd p-bs bd ws-bs - 4 2 roll % bd ws-bs wd-bd p-bs - mul % bd ws-bs (wd-bd)*(p-bs) - exch div add % bd + (wd-bd)*(p-bs)/(ws-bs) - } bind - { 5 1 roll - 4 {4 get 5 1 roll} repeat - 3 index sub 1 index 6 2 roll sub 5 1 roll - sub 4 2 roll mul exch div add - } bind - { 5 1 roll - 4 {5 get 5 1 roll} repeat - 3 index sub 1 index 6 2 roll sub 5 1 roll - sub 4 2 roll mul exch div add - } bind - ] readonly - /RangeLMN [0 0.9505 0 1 0 1.0890] readonly - /MatrixABC - [ 3.24063 -0.96893 0.05571 - -1.53721 1.87576 -0.20402 - -0.49863 0.04152 1.05700 - ] readonly - /EncodeABC [ {0 .max 0.45 exp} bind dup dup] readonly - /WhitePoint [0.9505 1 1.0890] readonly - % Some Genoa tests seem to require the presence of BlackPoint. - /BlackPoint [0 0 0] readonly -.dicttomark setcolorrendering - -%END CRD - -% Initialize a CIEBased color space for sRGB. -/CIEsRGB [ /CIEBasedABC - mark - /DecodeLMN [ { - dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse - } bind dup dup ] readonly - /MatrixLMN [ - 0.412457 0.212673 0.019334 - 0.357576 0.715152 0.119192 - 0.180437 0.072175 0.950301 - ] readonly - /WhitePoint [0.9505 1.0 1.0890] readonly - .dicttomark readonly -] readonly def - -% ------ Painting ------ % - -% A straightforward definition of execform that doesn't actually -% do any caching. -/.execform1 { - % This is a separate operator so that the stacks will be restored - % properly if an error occurs. - dup /Matrix get concat - dup /BBox get aload pop - exch 3 index sub exch 2 index sub rectclip - dup /PaintProc get - 1 index /Implementation known not { - 1 index dup /Implementation null .forceput readonly pop - } if - exec -} .bind odef % must bind .forceput - -/.formtypes 5 dict - dup 1 /.execform1 load put -def - -/execform { % <form> execform - - gsave { - dup /FormType get //.formtypes exch get exec - } stopped grestore { stop } if -} odef - -/.patterntypes 5 dict - dup 1 /.buildpattern1 load put -def - -/makepattern { % <proto_dict> <matrix> makepattern <pattern> - //.patterntypes 2 index /PatternType get get - .currentglobal false .setglobal exch - % Stack: proto matrix global buildproc - 3 index dup length 1 add dict .copydict - 3 index 3 -1 roll exec 3 -1 roll .setglobal - 1 index /Implementation 3 -1 roll put - readonly exch pop exch pop -} odef - -/setpattern { % [<comp1> ...] <pattern> setpattern - - currentcolorspace 0 get /Pattern ne { - [ /Pattern currentcolorspace ] setcolorspace - } if setcolor -} odef - -% Extend image and imagemask to accept dictionaries. -% We must create .imagetypes and .imagemasktypes outside level2dict, -% and leave some extra space because we're still in Level 1 mode. -systemdict begin -/.imagetypes 5 dict - dup 1 /.image1 load put -def -/.imagemasktypes 5 dict - dup 1 /.imagemask1 load put -def -end - -/.image /image load def -/image { - dup type /dicttype eq { - dup /ImageType get //.imagetypes exch get exec - } { - //.image - } ifelse -} odef -currentdict /.image undef - -/.imagemask /imagemask load def -/imagemask { - dup type /dicttype eq { - dup /ImageType get //.imagemasktypes exch get exec - } { - //.imagemask - } ifelse -} odef -currentdict /.imagemask undef - -end % level2dict |