home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / GhostScript / !GhostScr / 6_01 / lib / gs_lev2.ps < prev    next >
Text File  |  2000-03-29  |  25KB  |  744 lines
  1. %    Copyright (C) 1990, 1996, 1997, 1998, 1999 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % $Id: gs_lev2.ps,v 1.1 2000/03/09 08:40:40 lpd Exp $
  19. % Initialization file for Level 2 functions.
  20. % When this is run, systemdict is still writable,
  21. % but (almost) everything defined here goes into level2dict.
  22.  
  23. level2dict begin
  24.  
  25. % ------ System and user parameters ------ %
  26.  
  27. % User parameters must obey save/restore, and must also be maintained
  28. % per-context.  We implement the former, and some of the latter, here
  29. % with PostScript code.  NOTE: our implementation assumes that user
  30. % parameters change only as a result of setuserparams -- that there are
  31. % no user parameters that are ever changed dynamically by the interpreter
  32. % (although the interpreter may adjust the value presented to setuserparams)
  33. %
  34. % There are two types of user parameters: those which are actually
  35. % maintained in the interpreter, and those which exist only at the
  36. % PostScript level.  We maintain the current state of both types in
  37. % a read-only local dictionary named userparams, defined in systemdict.
  38. % In a multi-context system, each context has its own copy of this
  39. % dictionary.  In addition, there is a constant dictionary named
  40. % psuserparams whose keys are the names of user parameters that exist
  41. % only in PostScript and whose values are (currently) arbitrary values
  42. % of the correct datatype: setuserparams uses this for type checking.
  43. % setuserparams updates userparams explicitly, in addition to setting
  44. % any user parameters in the interpreter; thus we can use userparams
  45. % to reset those parameters after a restore or a context switch.
  46. % NOTE: the name userparams is known to the interpreter, and in fact
  47. % the interpreter creates the userparams dictionary.
  48.  
  49. % Check parameters that are managed at the PostScript level.
  50. % Currently we allow resetting them iff the new value is of the same type.
  51. /.checksetparams {        % <newdict> <opname> <checkdict>
  52.                 %   .checksetparams <newdict>
  53.   2 index {
  54.         % Stack: newdict opname checkdict key newvalue
  55.     3 copy pop .knownget
  56.        { type 1 index type ne
  57.       { pop pop pop load /typecheck signalerror }
  58.      if
  59.      dup type /stringtype eq
  60.       { dup rcheck not
  61.          { pop pop pop load /invalidaccess signalerror }
  62.         if
  63.       }
  64.      if
  65.        }
  66.     if pop pop
  67.   } forall pop pop
  68. } .bind def    % not odef, shouldn't reset stacks
  69.  
  70. % currentuser/systemparams creates and returns a dictionary in the
  71. % current VM.  The easiest way to make this work is to copy any composite
  72. % PostScript-level parameters to global VM.  Currently, the only such
  73. % parameters are strings.  In fact, we always copy string parameters,
  74. % so that we can be sure the contents won't be changed.
  75. /.copyparam {            % <value> .copyparam <value'>
  76.   dup type /stringtype eq {
  77.     .currentglobal true .setglobal
  78.     1 index length string exch .setglobal
  79.     copy readonly
  80.   } if
  81. } .bind def
  82.  
  83. % Some user parameters are managed entirely at the PostScript level.
  84. % We take care of that here.
  85. systemdict begin
  86. /psuserparams 40 dict def
  87. /getuserparam {            % <name> getuserparam <value>
  88.   /userparams .systemvar 1 index get exch pop
  89. } odef
  90. % Fill in userparams (created by the interpreter) with current values.
  91. mark .currentuserparams
  92. counttomark 2 idiv {
  93.   userparams 3 1 roll put
  94. } repeat pop
  95. /.definepsuserparam {        % <name> <value> .definepsuserparam -
  96.   psuserparams 3 copy pop put
  97.   userparams 3 1 roll put
  98. } .bind def
  99. end
  100. /currentuserparams {        % - currentuserparams <dict>
  101.   /userparams .systemvar dup length dict .copydict
  102. } odef
  103. /setuserparams {        % <dict> setuserparams -
  104.     % Check that we will be able to set the PostScript-level
  105.     % user parameters.
  106.   /setuserparams /psuserparams .systemvar .checksetparams
  107.     % Set the C-level user params.  If this succeeds, we know that
  108.     % the password check succeeded.
  109.   dup .setuserparams
  110.     % Now set the PostScript-level params.
  111.     % The interpreter may have adjusted the values of some of the
  112.     % parameters, so we have to read them back.
  113.   dup {
  114.     /userparams .systemvar 2 index known {
  115.       psuserparams 2 index known not {
  116.     pop dup .getuserparam
  117.       } if
  118.       .copyparam
  119.       /userparams .systemvar 3 1 roll .forceput  % userparams is read-only
  120.     } {
  121.       pop pop
  122.     } ifelse
  123.   } forall
  124.     % A context switch might have occurred during the above loop,
  125.     % causing the interpreter-level parameters to be reset.
  126.     % Set them again to the new values.  From here on, we are safe,
  127.     % since a context switch will consult userparams.
  128.   .setuserparams
  129. } .bind odef
  130. % Initialize user parameters managed here.
  131. /JobName () .definepsuserparam
  132.  
  133. % Restore must restore the user parameters.
  134. % (Since userparams is in local VM, save takes care of saving them.)
  135. /restore {        % <save> restore -
  136.   //restore /userparams .systemvar .setuserparams
  137. } .bind odef
  138.  
  139. % The pssystemparams dictionary holds some system parameters that
  140. % are managed entirely at the PostScript level.
  141. systemdict begin
  142. currentdict /pssystemparams known not {
  143.   /pssystemparams 40 dict readonly def
  144. } if
  145. /getsystemparam {        % <name> getsystemparam <value>
  146.   //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
  147. } odef
  148. end
  149. /currentsystemparams {        % - currentsystemparams <dict>
  150.   mark .currentsystemparams //pssystemparams { } forall .dicttomark
  151. } odef
  152. /setsystemparams {        % <dict> setsystemparams -
  153.     % Check that we will be able to set the PostScript-level
  154.     % system parameters.
  155.    /setsystemparams //pssystemparams .checksetparams
  156.     % Set the C-level system params.  If this succeeds, we know that
  157.     % the password check succeeded.
  158.    dup .setsystemparams
  159.     % Now set the PostScript-level params.  We must copy local strings
  160.     % into global VM.
  161.    dup
  162.     { //pssystemparams 2 index known
  163.        {        % Stack: key newvalue
  164.      .copyparam
  165.      //pssystemparams 3 1 roll .forceput    % pssystemparams is read-only
  166.        }
  167.        { pop pop
  168.        }
  169.       ifelse
  170.     }
  171.    forall pop
  172. } .bind odef
  173.  
  174. % Initialize the passwords.
  175. % NOTE: the names StartJobPassword and SystemParamsPassword are known to
  176. % the interpreter, and must be bound to noaccess strings.
  177. % The length of these strings must be max_password (iutil2.h) + 1.
  178. /StartJobPassword 65 string noaccess def
  179. /SystemParamsPassword 65 string noaccess def
  180.  
  181. % Redefine cache parameter setting to interact properly with userparams.
  182. /setcachelimit {
  183.   mark /MaxFontItem 2 index .dicttomark setuserparams pop
  184. } .bind odef
  185. /setcacheparams {
  186.     % The MaxFontCache parameter is a system parameter, which we might
  187.     % not be able to set.  Fortunately, this doesn't matter, because
  188.     % system parameters don't have to be synchronized between this code
  189.     % and the VM.
  190.   counttomark 1 add copy setcacheparams
  191.   currentcacheparams    % mark size lower upper
  192.     3 -1 roll pop
  193.     /MinFontCompress 3 1 roll
  194.     /MaxFontItem exch
  195.   .dicttomark setuserparams
  196.   cleartomark
  197. } .bind odef
  198.  
  199. % Add bogus user and system parameters to satisfy badly written PostScript
  200. % programs that incorrectly assume the existence of all the parameters
  201. % listed in Appendix C of the Red Book.  Note that some of these may become
  202. % real parameters later: code near the end of gs_init.ps takes care of
  203. % removing any such parameters from ps{user,system}params.
  204.  
  205. psuserparams begin
  206.   /MaxFormItem 100000 def
  207.   /MaxPatternItem 20000 def
  208.   /MaxScreenItem 48000 def
  209.   /MaxUPathItem 5000 def
  210. end
  211.  
  212. pssystemparams begin
  213.   /CurDisplayList 0 .forcedef
  214.   /CurFormCache 0 .forcedef
  215.   /CurOutlineCache 0 .forcedef
  216.   /CurPatternCache 0 .forcedef
  217.   /CurUPathCache 0 .forcedef
  218.   /CurScreenStorage 0 .forcedef
  219.   /CurSourceList 0 .forcedef
  220.   /DoPrintErrors false .forcedef
  221.   /MaxDisplayList 140000 .forcedef
  222.   /MaxFormCache 100000 .forcedef
  223.   /MaxOutlineCache 65000 .forcedef
  224.   /MaxPatternCache 100000 .forcedef
  225.   /MaxUPathCache 300000 .forcedef
  226.   /MaxScreenStorage 84000 .forcedef
  227.   /MaxSourceList 25000 .forcedef
  228.   /RamSize 4194304 .forcedef
  229. end
  230.  
  231. % ------ Miscellaneous ------ %
  232.  
  233. (<<) cvn            % - << -mark-
  234.   /mark load def
  235. (>>) cvn            % -mark- <key1> <value1> ... >> <dict>
  236.   /.dicttomark load def
  237. /languagelevel 2 def
  238. % When running in Level 2 mode, this interpreter is supposed to be
  239. % compatible with Adobe version 2017.
  240. /version (2017) readonly def
  241.  
  242. % If binary tokens are supported by this interpreter,
  243. % set an appropriate default binary object format.
  244. /setobjectformat where
  245.  { pop
  246.    /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
  247.    /ByteOrder getsystemparam { 1 add } if
  248.    setobjectformat
  249.  } if
  250.  
  251. % Aldus Freehand versions 2.x check for the presence of the
  252. % setcolor operator, and if it is missing, substitute a procedure.
  253. % Unfortunately, the procedure takes different parameters from
  254. % the operator.  As a result, files produced by this application
  255. % cause an error if the setcolor operator is actually defined
  256. % and 'bind' is ever used.  Aldus fixed this bug in Freehand 3.0,
  257. % but there are a lot of files created by the older versions
  258. % still floating around.  Therefore, at Adobe's suggestion,
  259. % we implement the following dreadful hack in the 'where' operator:
  260. %      If the key is /setcolor, and
  261. %        there is a dictionary named FreeHandDict, and
  262. %        currentdict is that dictionary,
  263. %      then "where" consults only that dictionary and not any other
  264. %        dictionaries on the dictionary stack.
  265. .wheredict /setcolor {
  266.   /FreeHandDict .where {
  267.     /FreeHandDict get currentdict eq {
  268.       pop currentdict /setcolor known { currentdict true } { false } ifelse
  269.     } {
  270.       .where
  271.     } ifelse
  272.   } {
  273.     .where
  274.   } ifelse
  275. } bind put
  276.  
  277. % ------ Virtual memory ------ %
  278.  
  279. /currentglobal            % - currentglobal <bool>
  280.   /currentshared load def
  281. /gcheck                % <obj> gcheck <bool>
  282.   /scheck load def
  283. /setglobal            % <bool> setglobal -
  284.   /setshared load def
  285. % We can make the global dictionaries very small, because they auto-expand.
  286. /globaldict currentdict /shareddict .knownget not { 4 dict } if def
  287. /GlobalFontDirectory SharedFontDirectory def
  288.  
  289. % VMReclaim and VMThreshold are user parameters.
  290. /setvmthreshold {        % <int> setvmthreshold -
  291.   mark /VMThreshold 2 index .dicttomark setuserparams pop
  292. } odef
  293. /vmreclaim {            % <int> vmreclaim -
  294.   dup 0 gt {
  295.     .vmreclaim
  296.   } {
  297.     mark /VMReclaim 2 index .dicttomark setuserparams pop
  298.   } ifelse
  299. } odef
  300. -1 setvmthreshold
  301.  
  302. % ------ IODevices ------ %
  303.  
  304. /.getdevparams where {
  305.   pop /currentdevparams {    % <iodevice> currentdevparams <dict>
  306.     .getdevparams .dicttomark
  307.   } odef
  308. } if
  309. /.putdevparams where {
  310.   pop /setdevparams {        % <iodevice> <dict> setdevparams -
  311.     mark 1 index { } forall counttomark 2 add index
  312.     .putdevparams pop pop
  313.   } odef
  314. } if
  315.  
  316. % ------ Job control ------ %
  317.  
  318. serverdict begin
  319.  
  320. % We could protect the job information better, but we aren't attempting
  321. % (currently) to protect ourselves against maliciousness.
  322.  
  323. /.jobsave null def        % top-level save object
  324. /.jobsavelevel 0 def        % save depth of job (0 if .jobsave is null,
  325.                 % 1 otherwise)
  326. /.adminjob true def        % status of current unencapsulated job
  327.  
  328. end        % serverdict
  329.  
  330. % Because there may be objects on the e-stack created since the job save,
  331. % we have to clear the e-stack before doing the end-of-job restore.
  332. % We do this by executing a 2 .stop, which is caught by the 2 .stopped
  333. % in .runexec; we leave on the o-stack a procedure to execute aftewards.
  334. %
  335. %**************** The definition of startjob is not complete yet, since
  336. % it doesn't reset stdin/stdout.
  337. /.startnewjob {            % <exit_bool> <password_level>
  338.                 %   .startnewjob -
  339.     serverdict /.jobsave get dup null eq { pop } { restore } ifelse
  340.     exch {
  341.             % Unencapsulated job
  342.       serverdict /.jobsave null put
  343.       serverdict /.jobsavelevel 0 put
  344.       serverdict /.adminjob 3 -1 roll 1 gt put
  345.         % The Adobe documentation doesn't say what happens to the
  346.         % graphics state stack in this case, but an experiment
  347.         % produced results suggesting that a grestoreall occurs.
  348.       grestoreall
  349.     } {
  350.             % Encapsulated job
  351.       pop
  352.       serverdict /.jobsave save put
  353.       serverdict /.jobsavelevel 1 put
  354.     } ifelse
  355.         % Reset the interpreter state.
  356.   clear cleardictstack
  357.   initgraphics
  358.   false setglobal
  359. } bind def
  360. /.startjob {            % <exit_bool> <password> <finish_proc>
  361.                 %   .startjob <ok_bool>
  362.   vmstatus pop pop serverdict /.jobsavelevel get eq
  363.   2 index .checkpassword 0 gt and {
  364.     exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
  365.     cleardictstack
  366.         % Reset the e-stack back to the 2 .stopped in .runexec,
  367.         % passing the finish_proc to be executed afterwards.
  368.     2 .stop
  369.   } {        % Password check failed
  370.     pop pop pop false
  371.   } ifelse
  372. } odef
  373. /startjob {            % <exit_bool> <password> startjob <ok_bool>
  374.     % This is a hack.  We really need some way to indicate explicitly
  375.     % to the interpreter that we are under control of a job server.
  376.   .userdict /quit /stop load put
  377.   { .startnewjob true } .startjob
  378. } odef
  379.  
  380. systemdict begin
  381. /quit {                % - quit -
  382.   //systemdict begin serverdict /.jobsave get null eq
  383.    { end //quit }
  384.    { /quit load /invalidaccess /signalerror load end exec }
  385.   ifelse
  386. } bind odef
  387. end
  388.  
  389. % We would like to define exitserver as a procedure, using the code
  390. % that the Red Book says is equivalent to it.  However, since startjob
  391. % resets the exec stack, we can't do this, because control would never
  392. % proceed past the call on startjob if the exitserver is successful.
  393. % Instead, we need to construct exitserver out of pieces of startjob.
  394.  
  395. serverdict begin
  396.  
  397. /exitserver {            % <password> exitserver -
  398.   true exch { .startnewjob } .startjob not {
  399.     /exitserver /invalidaccess signalerror
  400.   } if
  401. } bind def
  402.  
  403. end        % serverdict
  404.  
  405. % ------ Compatibility ------ %
  406.  
  407. % In Level 2 mode, the following replace the definitions that gs_statd.ps
  408. % installs in statusdict and serverdict.
  409. % Note that statusdict must be allocated in local VM.
  410. % We don't bother with many of these yet.
  411.  
  412. /.dict1 { exch mark 3 1 roll .dicttomark } bind def
  413.  
  414. currentglobal false setglobal 25 dict exch setglobal begin
  415. currentsystemparams
  416.  
  417. % The following do not depend on the presence of setpagedevice.
  418. /buildtime 1 index /BuildTime get def
  419. /byteorder 1 index /ByteOrder get def
  420. /checkpassword { .checkpassword 0 gt } bind def
  421. dup /DoStartPage known
  422.  { /dostartpage { /DoStartPage getsystemparam } bind def
  423.    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
  424.  } if
  425. dup /StartupMode known
  426.  { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
  427.    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
  428.  } if
  429. %****** Setting jobname is supposed to set userparams.JobName, too.
  430. /jobname { /JobName getuserparam } bind def
  431. /jobtimeout { /JobTimeout getuserparam } bind def
  432. /ramsize { /RamSize getsystemparam } bind def
  433. /realformat 1 index /RealFormat get def
  434. dup /PrinterName known
  435.  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
  436.  } if
  437. /printername
  438.  { currentsystemparams /PrinterName .knownget not { () } if exch copy
  439.  } bind def
  440. currentuserparams /WaitTimeout known
  441.  { /waittimeout { /WaitTimeout getuserparam } bind def
  442.  } if
  443.  
  444. % The following do require setpagedevice.
  445. /.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse
  446. /defaulttimeouts
  447.  { currentsystemparams dup
  448.    /JobTimeout .knownget not { 0 } if
  449.    exch /WaitTimeout .knownget not { 0 } if
  450.    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
  451.  } bind def
  452. /margins
  453.  { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
  454.  } bind def
  455. /pagemargin
  456.  { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
  457.  } bind def
  458. /pageparams
  459.  { currentpagedevice
  460.    dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
  461.    dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
  462.    /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
  463.  } bind def
  464. /setdefaulttimeouts
  465.  { exch mark /ManualFeedTimeout 3 -1 roll
  466.    /Policies mark /ManualFeedTimeout 1 .dicttomark
  467.    .dicttomark setpagedevice
  468.    /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
  469.  } bind def
  470. /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
  471. /setduplexmode { /Duplex .dict1 setpagedevice } bind def
  472. /setmargins
  473.  { exch 2 array astore /Margins .dict1 setpagedevice
  474.  } bind def
  475. /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
  476. /setpageparams
  477.  { mark /PageSize 6 -2 roll
  478.    4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
  479.    /Orientation 5 -1 roll ORIENT1 { 1 xor } if
  480.    /PageOffset counttomark 2 add -1 roll 0 2 array astore
  481.    .dicttomark setpagedevice
  482.  } bind def
  483. /setresolution
  484.  { dup 2 array astore /HWResolution .dict1 setpagedevice
  485.  } bind def
  486. %END PAGEDEVICE
  487.  
  488. % The following are not implemented yet.
  489. %manualfeed
  490. %manualfeedtimeout
  491. %pagecount
  492. %pagestackorder
  493. %setpagestackorder
  494.  
  495. pop        % currentsystemparams
  496.  
  497. % Flag the current dictionary so it will be swapped when we
  498. % change language levels.  (See zmisc2.c for more information.)
  499. /statusdict currentdict def
  500.  
  501. currentdict end
  502. /statusdict exch .forcedef    % statusdict is local, systemdict is global
  503.  
  504. % ------ Color spaces ------ %
  505.  
  506. % Define the setcolorspace procedures:
  507. %    <colorspace> proc <colorspace'|null>
  508. /colorspacedict mark
  509.   /DeviceGray { pop 0 setgray null } bind
  510.   /DeviceRGB { pop 0 0 0 setrgbcolor null } bind
  511.   /setcmykcolor where
  512.    { pop /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind
  513.    } if
  514.   /.setcieaspace where
  515.    { pop /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind
  516.    } if
  517.   /.setcieabcspace where
  518.    { pop /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind
  519.    } if
  520.   /.setciedefspace where
  521.    { pop /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind
  522.    } if
  523.   /.setciedefgspace where
  524.    { pop /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind
  525.    } if
  526.   /.setseparationspace where
  527.    { pop /Separation { dup 2 get setcolorspace dup .setseparationspace } bind
  528.    } if
  529.   /.setindexedspace where
  530.    { pop /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind
  531.    } if
  532.   /.nullpatternspace [/Pattern] readonly def
  533.   /.setpatternspace where
  534.    { pop /Pattern
  535.       { dup type /nametype eq { pop //.nullpatternspace } if
  536.     dup length 1 gt { dup 1 get setcolorspace } if
  537.         dup .setpatternspace
  538.       } bind
  539.    } if
  540.     % If DeviceN space is included, gs_ll3.ps registers it.
  541.   /.setdevicepixelspace where
  542.    { pop /DevicePixel { dup .setdevicepixelspace } bind
  543.    } if
  544.   currentdict /.nullpatternspace .undef
  545. .dicttomark def
  546.  
  547. /.devcs [
  548.   /DeviceGray /DeviceRGB /DeviceCMYK /DevicePixel
  549. ] readonly def
  550. /currentcolorspace {        % - currentcolorspace <array>
  551.   .currentcolorspace dup type /integertype eq {
  552.     //.devcs exch 1 getinterval
  553.   } if
  554. } odef
  555. currentdict /.devcs .undef
  556.  
  557. /setcolorspace {        % <name|array> setcolorspace -
  558.   dup dup dup type /nametype ne { 0 get } if
  559.   //colorspacedict exch get exec
  560.   dup null eq { pop } { .setcolorspace } ifelse pop
  561. } odef
  562.  
  563. % ------ CIE color rendering ------ %
  564.  
  565. % Define findcolorrendering and a default ColorRendering ProcSet.
  566.  
  567. /findcolorrendering {        % <intentname> findcolorrendering
  568.                 %   <crdname> <found>
  569.   /ColorRendering /ProcSet findresource
  570.   1 index .namestring (.) concatstrings
  571.   1 index /GetPageDeviceName get exec .namestring (.) concatstrings
  572.   2 index /GetHalftoneName get exec .namestring
  573.   concatstrings concatstrings
  574.   dup /ColorRendering resourcestatus {
  575.     pop pop exch pop exch pop true
  576.   } {
  577.     pop /GetSubstituteCRD get exec false
  578.   } ifelse
  579. } odef
  580.  
  581. 5 dict dup begin
  582.  
  583. /GetPageDeviceName {        % - GetPageDeviceName <name>
  584.   currentpagedevice dup /PageDeviceName .knownget {
  585.     exch pop dup null eq { pop /none } if
  586.   } {
  587.     pop /none
  588.   } ifelse
  589. } bind def
  590.  
  591. /GetHalftoneName {        % - GetHalftoneName <name>
  592.   currenthalftone /HalftoneName .knownget not { /none } if
  593. } bind def
  594.  
  595. /GetSubstituteCRD {        % <intentname> GetSubstituteCRD <crdname>
  596.   pop /DefaultColorRendering
  597. } bind def
  598.  
  599. end
  600. % The resource machinery hasn't been activated, so just save the ProcSet
  601. % and let .fixresources finish the installation process.
  602. /ColorRendering exch def
  603.  
  604. % Define setcolorrendering.
  605.  
  606. /.colorrenderingtypes 5 dict def
  607.  
  608. /setcolorrendering {        % <crd> setcolorrendering -
  609.   dup /ColorRenderingType get //.colorrenderingtypes exch get exec
  610. } odef
  611.  
  612. /.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse
  613.  
  614. .colorrenderingtypes 1 {
  615.   dup .buildcolorrendering1 .setcolorrendering1
  616. } .bind put
  617.  
  618. % Note: the value 101 in the next line must be the same as the value of
  619. % GX_DEVICE_CRD1_TYPE in gscrdp.h.
  620. .colorrenderingtypes 101 {
  621.   dup .builddevicecolorrendering1 .setdevicecolorrendering1
  622. } .bind put
  623.  
  624. % Initialize the default CIE rendering dictionary.
  625. % The most common CIE files seem to assume the "calibrated RGB color space"
  626. % described on p. 189 of the PostScript Language Reference Manual,
  627. % 2nd Edition; we simply invert this transformation back to RGB.
  628. mark
  629.    /ColorRenderingType 1
  630. % We must make RangePQR and RangeLMN large enough so that values computed by
  631. % the assumed encoding MatrixLMN don't get clamped.
  632.    /RangePQR [0 0.9505 0 1 0 1.0890] readonly
  633.    /TransformPQR
  634.      [ {exch pop exch pop exch pop exch pop} bind dup dup ] readonly
  635.    /RangeLMN [0 0.9505 0 1 0 1.0890] readonly
  636.    /MatrixABC
  637.     [ 3.24063 -0.96893  0.05571
  638.      -1.53721  1.87576 -0.20402
  639.      -0.49863  0.04152  1.05700
  640.     ] readonly
  641.    /EncodeABC [ {0 .max 0.45 exp} bind dup dup] readonly
  642.    /WhitePoint [0.9505 1 1.0890] readonly
  643.     % Some Genoa tests seem to require the presence of BlackPoint.
  644.    /BlackPoint [0 0 0] readonly
  645. .dicttomark setcolorrendering
  646.  
  647. %END CRD
  648.  
  649. % Initialize a CIEBased color space for sRGB.
  650. /CIEsRGB [ /CIEBasedABC
  651.   mark
  652.     /DecodeLMN [ {
  653.       dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
  654.     } bind dup dup ] readonly
  655.     /MatrixLMN [
  656.       0.412457 0.212673 0.019334
  657.       0.357576 0.715152 0.119192
  658.       0.180437 0.072175 0.950301
  659.     ] readonly
  660.     /WhitePoint [0.9505 1.0 1.0890] readonly
  661.   .dicttomark readonly
  662. ] readonly def
  663.  
  664. % ------ Painting ------ %
  665.  
  666. % A straightforward definition of execform that doesn't actually
  667. % do any caching.
  668. /.execform1 {
  669.     % This is a separate operator so that the stacks will be restored
  670.     % properly if an error occurs.
  671.   dup /Matrix get concat
  672.   dup /BBox get aload pop
  673.   exch 3 index sub exch 2 index sub rectclip
  674.   dup /PaintProc get
  675.   1 index /Implementation known not {
  676.     1 index dup /Implementation null .forceput readonly pop
  677.   } if
  678.   exec
  679. } .bind odef    % must bind .forceput
  680.  
  681. /.formtypes 5 dict
  682.   dup 1 /.execform1 load put
  683. def
  684.  
  685. /execform {            % <form> execform -
  686.   gsave {
  687.     dup /FormType get //.formtypes exch get exec
  688.   } stopped grestore { stop } if
  689. } odef
  690.  
  691. /.patterntypes 5 dict
  692.   dup 1 /.buildpattern1 load put
  693. def
  694.  
  695. /makepattern {            % <proto_dict> <matrix> makepattern <pattern>
  696.   //.patterntypes 2 index /PatternType get get
  697.   .currentglobal false .setglobal exch
  698.         % Stack: proto matrix global buildproc
  699.   3 index dup length 1 add dict .copydict
  700.   3 index 3 -1 roll exec 3 -1 roll .setglobal
  701.   1 index /Implementation 3 -1 roll put
  702.   readonly exch pop exch pop
  703. } odef
  704.  
  705. /setpattern {            % [<comp1> ...] <pattern> setpattern -
  706.   currentcolorspace 0 get /Pattern ne {
  707.     [ /Pattern currentcolorspace ] setcolorspace
  708.   } if setcolor
  709. } odef
  710.  
  711. % Extend image and imagemask to accept dictionaries.
  712. % We must create .imagetypes and .imagemasktypes outside level2dict,
  713. % and leave some extra space because we're still in Level 1 mode.
  714. systemdict begin
  715. /.imagetypes 5 dict
  716.   dup 1 /.image1 load put
  717. def
  718. /.imagemasktypes 5 dict
  719.   dup 1 /.imagemask1 load put
  720. def
  721. end
  722.  
  723. /.image /image load def
  724. /image {
  725.   dup type /dicttype eq {
  726.     dup /ImageType get //.imagetypes exch get exec
  727.   } {
  728.     //.image
  729.   } ifelse
  730. } odef
  731. currentdict /.image undef
  732.  
  733. /.imagemask /imagemask load def
  734. /imagemask {
  735.   dup type /dicttype eq {
  736.     dup /ImageType get //.imagemasktypes exch get exec
  737.   } {
  738.     //.imagemask
  739.   } ifelse
  740. } odef
  741. currentdict /.imagemask undef
  742.  
  743. end                % level2dict
  744.