% 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 { % .checkparamtype exch type eq } .bind def /.checksetparams { % % .checksetparams 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 { % .copyparam 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 { % getuserparam /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 { % .definepsuserparam - psuserparams 3 copy pop type cvlit /.checkparamtype cvx 2 packedarray cvx put userparams 3 1 roll put } .bind def end /currentuserparams { % - currentuserparams /userparams .systemvar dup length dict .copydict } odef /setuserparams { % 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 { % 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 { % getsystemparam //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse } odef end /currentsystemparams { % - currentsystemparams mark .currentsystemparams //pssystemparams { } forall .dicttomark } odef /setsystemparams { % 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- ... >> /.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 /currentshared load def /gcheck % gcheck /scheck load def /setglobal % 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 { % setvmthreshold - mark /VMThreshold 2 index .dicttomark setuserparams pop } odef /vmreclaim { % vmreclaim - dup 0 gt { .vmreclaim } { mark /VMReclaim 2 index .dicttomark setuserparams pop } ifelse } odef -1 setvmthreshold % ------ IODevices ------ % /.getdevparams where { pop /currentdevparams { % currentdevparams .getdevparams .dicttomark } odef } if /.putdevparams where { pop /setdevparams { % 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 { % % .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 { % % .startjob 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 { % startjob % 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 { % 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 { % 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 % % true % 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 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 ] % .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: % proc % 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 .currentcolorspace dup type /integertype eq { //.devcs exch 1 getinterval } if } odef currentdict /.devcs .undef /setcolorspace { % 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 { % findcolorrendering % /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 currentpagedevice dup /PageDeviceName .knownget { exch pop dup null eq { pop /none } if } { pop /none } ifelse } bind def /GetHalftoneName { % - GetHalftoneName currenthalftone /HalftoneName .knownget not { /none } if } bind def /GetSubstituteCRD { % GetSubstituteCRD 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 { % 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 { %
execform - gsave { dup /FormType get //.formtypes exch get exec } stopped grestore { stop } if } odef /.patterntypes 5 dict dup 1 /.buildpattern1 load put def /makepattern { % makepattern //.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 { % [ ...] 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