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