summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/lib/gs_lev2.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/lib/gs_lev2.ps')
-rw-r--r--Master/tlpkg/tlgs/lib/gs_lev2.ps1013
1 files changed, 0 insertions, 1013 deletions
diff --git a/Master/tlpkg/tlgs/lib/gs_lev2.ps b/Master/tlpkg/tlgs/lib/gs_lev2.ps
deleted file mode 100644
index 468ad54d455..00000000000
--- a/Master/tlpkg/tlgs/lib/gs_lev2.ps
+++ /dev/null
@@ -1,1013 +0,0 @@
-% Copyright (C) 1990, 2000 Aladdin Enterprises. All rights reserved.
-%
-% This software is provided AS-IS with no warranty, either express or
-% implied.
-%
-% This software is distributed under license and may not be copied,
-% modified or distributed except as expressly authorized under the terms
-% of the license contained in the file LICENSE in this distribution.
-%
-% For more information about licensing, please refer to
-% http://www.ghostscript.com/licensing/. For information on
-% commercial licensing, go to http://www.artifex.com/licensing/ or
-% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
-% San Rafael, CA 94903, U.S.A., +1(415)492-9861.
-
-% $Id: gs_lev2.ps 8174 2007-08-04 14:30:04Z alexcher $
-% Initialization file for Level 2 functions.
-% When this is run, systemdict is still writable,
-% but (almost) everything defined here goes into level2dict.
-
-level2dict begin
-
-% ------ System and user parameters ------ %
-
-% User parameters must obey save/restore, and must also be maintained
-% per-context. We implement the former, and some of the latter, here
-% with PostScript code. NOTE: our implementation assumes that user
-% parameters change only as a result of setuserparams -- that there are
-% no user parameters that are ever changed dynamically by the interpreter
-% (although the interpreter may adjust the value presented to setuserparams)
-%
-% There are two types of user parameters: those which are actually
-% maintained in the interpreter, and those which exist only at the
-% PostScript level. We maintain the current state of both types in
-% a read-only local dictionary named userparams, defined in systemdict.
-% In a multi-context system, each context has its own copy of this
-% dictionary. In addition, there is a constant dictionary named
-% psuserparams where each key is the name of a user parameter that exists
-% only in PostScript and the value is a procedure to check that the value
-% is legal: setuserparams uses this for checking the values.
-% setuserparams updates userparams explicitly, in addition to setting
-% any user parameters in the interpreter; thus we can use userparams
-% to reset those parameters after a restore or a context switch.
-% NOTE: the name userparams is known to the interpreter, and in fact
-% the interpreter creates the userparams dictionary.
-
-% Check parameters that are managed at the PostScript level.
-/.checkparamtype { % <newvalue> <type> .checkparamtype <bool>
- exch type eq
-} .bind def
-/.checksetparams { % <newdict> <opname> <checkdict>
- % .checksetparams <newdict>
- 2 .argindex {
- % Stack: newdict opname checkdict key newvalue
- 3 copy 3 1 roll .knownget {
- exec not {
- pop pop pop load /typecheck signalerror
- } if
- dup type /stringtype eq {
- dup rcheck not {
- pop pop pop load /invalidaccess signalerror
- } if
- } if
- } {
- pop
- } ifelse pop pop
- } forall pop pop
-} .bind def % not odef, shouldn't reset stacks
-
-% currentuser/systemparams creates and returns a dictionary in the
-% current VM. The easiest way to make this work is to copy any composite
-% PostScript-level parameters to global VM. Currently we have strings
-% as well as arrays. For arrays, we also need to copy any contents that
-% are in VM. Also copying string parameters insures the contents won't
-% be changed. Also be careful to preserve 'executable' state.
-/.copyparam { % <value> .copyparam <value'>
- dup type /arraytype eq {
- .currentglobal true .setglobal exch
- dup wcheck exch dup xcheck exch % original attributes
- dup length array exch dup { % stack: destination_array original_array original_array
- dup type /arraytype eq {
- dup 2 index ne { % avoid recursion
- .copyparam % recurse to handle composite array elements
- } {
- % this array self referenced, do it again (yuk!)
- pop 1 index % get copy of destination array
- } ifelse
- } {
- dup type /stringtype eq {
- .copyparam
- } if
- }
- ifelse 3 1 roll % keep arrays on top
- } forall pop astore
- exch { cvx } if % set executable state
- exch not { readonly } if % set readonly attribute as original
- exch .setglobal
- } if
- dup type /stringtype eq {
- dup wcheck exch % save attr for setting readonly
- .currentglobal true .setglobal
- 1 index length string exch .setglobal
- copy exch not { readonly } if
- } if
-} .bind def
-
-% Some user parameters are managed entirely at the PostScript level.
-% We take care of that here.
-systemdict begin
-/psuserparams 48 dict def
-/getuserparam { % <name> getuserparam <value>
- /userparams .systemvar 1 .argindex get exch pop
-} odef
-% Fill in userparams (created by the interpreter) with current values.
-mark .currentuserparams
-counttomark 2 idiv {
- userparams 3 1 roll put
-} repeat pop
-/.definepsuserparam { % <name> <value> .definepsuserparam -
- psuserparams 3 copy pop
- type cvlit /.checkparamtype cvx 2 packedarray cvx put
- userparams 3 1 roll put
-} .bind def
-end
-/currentuserparams { % - currentuserparams <dict>
- /userparams .systemvar dup length dict .copydict
-} odef
-% We break out setuserparams into a separate procedure so that setvmxxx
-% can use it without affecting the command in case of an error.
-/.setuserparams2 {
- % 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
- % special protection for the security related parameters
- [ /PermitFileReading /PermitFileWriting /PermitFileControl ]
- { 2 index eq { % force all strings to readonly but make sure the
- % array is in the correct VM space (local/global).
- currentglobal exch dup gcheck setglobal
- dup length array exch { readonly exch } forall astore
- exch setglobal
- } if
- } forall
- % protect top level of parameters that we copied
- dup type dup /arraytype eq exch /stringtype eq or { readonly } if
- /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 def
-/setuserparams { % <dict> setuserparams -
- .setuserparams2
-} .bind odef
-% Initialize user parameters managed here.
-/JobName () .definepsuserparam
-
-% Restore must restore the user parameters.
-% (Since userparams is in local VM, save takes care of saving them.)
-/restore { % <save> restore -
- //restore /userparams .systemvar .setuserparams
-} .bind odef
-
-% The pssystemparams dictionary holds some system parameters that
-% are managed entirely at the PostScript level.
-systemdict begin
-currentdict /pssystemparams known not {
- /pssystemparams 40 dict readonly def
-} if
-/getsystemparam { % <name> getsystemparam <value>
- //pssystemparams 1 .argindex .knownget { exch pop } { .getsystemparam } ifelse
-} odef
-end
-/currentsystemparams { % - currentsystemparams <dict>
- mark .currentsystemparams //pssystemparams { } forall .dicttomark
-} odef
-/setsystemparams { % <dict> setsystemparams -
- % Check that we will be able to set the PostScript-level
- % system parameters.
- dup pop % check # of args
- /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
- % protect top level parameters that we copied
- dup type dup /arraytype eq exch /stringtype eq or { readonly } if
- //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 .argindex .dicttomark setuserparams pop }
- stopped
- { /setcachelimit .systemvar $error /errorname get signalerror
- } if
-} .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 } stopped {
- /setcacheparams .systemvar $error /errorname get signalerror
- } if
-} .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 0 .definepsuserparam
-
-% File Access Permission parameters
- .currentglobal true .setglobal
- /.checkFilePermitparams {
- type /arraytype eq {
- currentuserparams /LockFilePermissions get {
- 5 { pop } repeat /setuserparams /invalidaccess signalerror
- }{
- % in addition to validating the value, ensure the value is read/only
- dup { readonly exch } forall
- .currentglobal exch dup gcheck .setglobal length array exch .setglobal
- astore readonly
- }
- ifelse
- } {
- 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
- /CurInputDevice () .forcedef
- /CurOutlineCache 0 .forcedef
- /CurOutputDevice () .forcedef
- /CurPatternCache 0 .forcedef
- /CurUPathCache 0 .forcedef
- /CurScreenStorage 0 .forcedef
- /CurSourceList 0 .forcedef
- /DoPrintErrors false .forcedef
- /JobTimeout 0 .forcedef
- /LicenseID (LN-001) .forcedef % bogus
- /MaxDisplayList 140000 .forcedef
- /MaxFormCache 100000 .forcedef
- /MaxImageBuffer 524288 .forcedef
- /MaxOutlineCache 65000 .forcedef
- /MaxPatternCache 100000 .forcedef
- /MaxUPathCache 300000 .forcedef
- /MaxScreenStorage 84000 .forcedef
- /MaxSourceList 25000 .forcedef
- /PrinterName product .forcedef
- /RamSize 4194304 .forcedef
- /WaitTimeout 40 .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
-/.loadingfont false def
-(%ProcessDSCComment) cvn {
- /ProcessDSCComment getuserparam
- dup null eq .loadingfont or { pop pop pop } { exec } ifelse
-} bind def
-
-% ------ Miscellaneous ------ %
-
-(<<) cvn % - << -mark-
- /mark load def
-% (>> is defined primitively.)
-/languagelevel 2 def
-% When running in Level 2 mode, this interpreter is supposed to be
-% compatible with Adobe version 2017.
-/version (2017) readonly def
-
-% If binary tokens are supported by this interpreter,
-% set an appropriate default binary object format.
-/setobjectformat where
- { pop
- /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
- /ByteOrder getsystemparam { 1 add } if
- setobjectformat
- } if
-
-% Aldus Freehand versions 2.x check for the presence of the
-% setcolor operator, and if it is missing, substitute a procedure.
-% Unfortunately, the procedure takes different parameters from
-% the operator. As a result, files produced by this application
-% cause an error if the setcolor operator is actually defined
-% and 'bind' is ever used. Aldus fixed this bug in Freehand 3.0,
-% but there are a lot of files created by the older versions
-% still floating around. Therefore, at Adobe's suggestion,
-% we implement the following dreadful hack in the 'where' operator:
-% If the key is /setcolor, and
-% there is a dictionary named FreeHandDict, and
-% currentdict is that dictionary,
-% then "where" consults only that dictionary and not any other
-% dictionaries on the dictionary stack.
-.wheredict /setcolor {
- /FreeHandDict .where {
- /FreeHandDict get currentdict eq {
- pop currentdict /setcolor known { currentdict true } { false } ifelse
- } {
- .where
- } ifelse
- } {
- .where
- } ifelse
-} bind put
-
-% ------ Virtual memory ------ %
-
-/currentglobal % - currentglobal <bool>
- /currentshared load def
-/gcheck % <obj> gcheck <bool>
- /scheck load def
-/setglobal % <bool> setglobal -
- /setshared load def
-% We can make the global dictionaries very small, because they auto-expand.
-/globaldict currentdict /shareddict .knownget not { 4 dict } if def
-/GlobalFontDirectory SharedFontDirectory def
-
-% VMReclaim and VMThreshold are user parameters.
-/setvmthreshold { % <int> setvmthreshold -
- mark /VMThreshold 2 .argindex .dicttomark .setuserparams2 pop
-} odef
-/vmreclaim { % <int> vmreclaim -
- dup 0 gt {
- .vmreclaim
- } {
- mark /VMReclaim 2 index .dicttomark .setuserparams2 pop
- } ifelse
-} odef
--1 setvmthreshold
-
-% ------ IODevices ------ %
-
-/.getdevparams where {
- pop /currentdevparams { % <iodevice> currentdevparams <dict>
- .getdevparams .dicttomark
- } odef
-} if
-/.putdevparams where {
- pop /setdevparams { % <iodevice> <dict> setdevparams -
- dup type /dicttype ne { /setdevparams .systemvar /typecheck signalerror } if
- mark 1 index { } forall counttomark 2 add index
- .putdevparams pop pop
- } odef
-} if
-
-% ------ Job control ------ %
-
-serverdict begin
-
-% We could protect the job information better, but we aren't attempting
-% (currently) to protect ourselves against maliciousness.
-
-/.jobsave //null def % top-level save object
-/.jobsavelevel 0 def % save depth of job (0 if .jobsave is null,
- % 1 otherwise)
-/.adminjob //true def % status of current unencapsulated job
-
-end % serverdict
-
-% Because there may be objects on the e-stack created since the job save,
-% we have to clear the e-stack before doing the end-of-job restore.
-% We do this by executing a 2 .stop, which is caught by the 2 .stopped
-% in .runexec; we leave on the o-stack a procedure to execute aftewards.
-%
-%**************** The definition of startjob is not complete yet, since
-% it doesn't reset stdin/stdout.
-/.startnewjob { % <exit_bool> <password_level>
- % .startnewjob -
- serverdict /.jobsave get dup //null eq { pop } { restore } ifelse
- exch {
- % Unencapsulated job
- serverdict /.jobsave //null put
- serverdict /.jobsavelevel 0 put
- serverdict /.adminjob 3 -1 roll 1 gt put
- } {
- % Encapsulated job
- pop
- serverdict /.jobsave save put
- serverdict /.jobsavelevel 1 put
- .userdict /quit { stop } .bind put % CET 28-10 requires a procedure
- } ifelse
- % Reset the interpreter state.
- clear cleardictstack
- initgraphics
- //false setglobal
- 2 vmreclaim % Make sure GC'ed memory is reclaimed and freed.
-} bind def
-/.startjob { % <exit_bool> <password> <finish_proc>
- % .startjob <ok_bool>
- vmstatus pop pop serverdict /.jobsavelevel get eq
- 2 .argindex .checkpassword 0 gt and {
- exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
- cleardictstack
- % Reset the e-stack back to the 2 .stopped in .runexec,
- % passing the finish_proc to be executed afterwards.
- 2 .stop
- } { % Password check failed
- pop pop pop //false
- } ifelse
-} odef
-/startjob { % <exit_bool> <password> startjob <ok_bool>
- % This is a hack. We really need some way to indicate explicitly
- % to the interpreter that we are under control of a job server.
- 1 .argindex type /booleantype ne {
- /startjob .systemvar /typecheck signalerror
- } if
- { .startnewjob //true } .startjob
-} odef
-
-% The procedure to undo the job encapsulation
-/.endjob {
- clear cleardictstack
- serverdict /.jobsave get dup //null eq { pop } { restore } ifelse
- serverdict /.jobsave //null put
- 2 vmreclaim % recover local and global VM
-} odef
-
-systemdict begin
-/quit { % - quit -
- //systemdict begin serverdict /.jobsave get null eq
- { end //quit }
- { /quit .systemvar /invalidaccess /signalerror load end exec }
- ifelse
-} bind odef
-end
-
-% We would like to define exitserver as a procedure, using the code
-% that the Red Book says is equivalent to it. However, since startjob
-% resets the exec stack, we can't do this, because control would never
-% proceed past the call on startjob if the exitserver is successful.
-% Instead, we need to construct exitserver out of pieces of startjob.
-
-serverdict begin
-
-/exitserver { % <password> exitserver -
- //true exch { .startnewjob } .startjob not {
- /exitserver /invalidaccess signalerror
- } if
-} bind def
-
-end % serverdict
-
-% ------ Compatibility ------ %
-
-% In Level 2 mode, the following replace the definitions that gs_statd.ps
-% installs in statusdict and serverdict.
-% Note that statusdict must be allocated in local VM.
-% We don't bother with many of these yet.
-
-/.dict1 { exch mark 3 1 roll .dicttomark } bind def
-
-currentglobal false setglobal 25 dict exch setglobal begin
-currentsystemparams
-
-% The following do not depend on the presence of setpagedevice.
-/buildtime 1 index /BuildTime get def
-% Also define /buildtime in systemdict because Adobe does so and some fonts use it as ID
-systemdict /buildtime dup load put
-/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 { % <proc> <scratch> devforall -
- exch {
- 1 index currentdevparams
- /Type .knownget { /FileSystem eq } { false } ifelse
- { exec } { pop pop } ifelse
- } /exec load 3 packedarray cvx exch
- (*) 3 1 roll /IODevice resourceforall
-} odef
-/devstatus { % <(%disk*%)> devstatus <searchable> <writable>
- % <hasNames> <mounted> <removable> <searchOrder>
- % <freePages> <size> true
- % <string> devstatus false
- dup length 5 ge {
- dup 0 5 getinterval (%disk) eq {
- dup /IODevice resourcestatus {
- pop pop dup currentdevparams
- dup /Searchable get
- exch dup /Writeable 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 ------ %
-
-% Move setcolorspace, setcolor, and colorspacedict to level2dict
-level2dict /setcolorspace .cspace_util 1 index get put
-level2dict /setcolor .cspace_util 1 index get put
-level2dict /colorspacedict .cspace_util 1 index get put
-
-% Add the level 2 color spaces
-% DevicePixel is actually a LanguageLevel 3 feature; it is here for
-% historical reasons.
-%% Replace 1 (gs_devpxl.ps)
-(gs_devpxl.ps) runlibfile
-
-%% Replace 1 (gs_ciecs2.ps)
-(gs_ciecs2.ps) runlibfile
-
-%% Replace 1 (gs_indxd.ps)
-(gs_indxd.ps) runlibfile
-
-%% Replace 1 (gs_sepr.ps)
-(gs_sepr.ps) runlibfile
-
-%% Replace 1 (gs_patrn.ps)
-(gs_patrn.ps) runlibfile
-
-
-
-% ------ CIE color rendering ------ %
-
-% Define findcolorrendering and a default ColorRendering ProcSet.
-
-/findcolorrendering { % <intentname> findcolorrendering
- % <crdname> <found>
- % Adobe interpreters report /findcolorrendering (literal name), not the
- % operator itself, if an error occurs in findcolorrendering.
- /findcolorrendering {
- /ColorRendering /ProcSet findresource
- 1 .argindex dup type /nametype eq { .namestring } if (.) concatstrings
- 1 index /GetPageDeviceName get exec dup type /nametype eq { .namestring } if (.) concatstrings
- 2 index /GetHalftoneName get exec dup type /nametype eq { .namestring } if
- concatstrings concatstrings cvn % stack: intentname procset crdname
- dup /ColorRendering resourcestatus {
- pop pop exch pop exch pop true
- } {
- pop /GetSubstituteCRD get exec false
- } ifelse
- } .errorexec
-} odef
-
-5 dict dup begin
-
-/GetPageDeviceName { % - GetPageDeviceName <name>
- currentpagedevice dup /PageDeviceName .knownget {
- exch pop dup null eq { pop /none } if
- } {
- pop /none
- } ifelse
-} bind def
-
-/GetHalftoneName { % - GetHalftoneName <name>
- currenthalftone /HalftoneName .knownget not { /none } if
-} bind def
-
-/GetSubstituteCRD { % <intentname> GetSubstituteCRD <crdname>
- pop /DefaultColorRendering
-} bind def
-
-end
-% The resource machinery hasn't been activated, so just save the ProcSet
-% and let .fixresources finish the installation process.
-/ColorRendering exch def
-
-% Define setcolorrendering.
-
-/.colorrenderingtypes 5 dict def
-
-/setcolorrendering { % <crd> setcolorrendering -
- dup /ColorRenderingType get
- dup type /integertype ne {
- /setcolorrendering .systemvar /typecheck signalerror
- } if
- //.colorrenderingtypes exch .knownget {
- exec
- } {
- /setcolorrendering .systemvar /rangecheck signalerror
- } ifelse
-} odef
-
-/.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse
-
-.colorrenderingtypes 1 {
- % Adobe ProcSet "Adobe_AGM_Core 2.0 0" places an /Intent key into CRD's
- dup /Intent .knownget {
- //.renderingintentdict exch .knownget { .setrenderingintent } if
- } if
- 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
-
-% sRGB output CRD, D65 white point
-mark
-/ColorRenderingType 1
-/RangePQR [ -0.5 2 -0.5 2 -0.5 2 ] readonly
-
-% Bradford Cone Space
-/MatrixPQR [ 0.8951 -0.7502 0.0389
- 0.2664 1.7135 -0.0685
- -0.1614 0.0367 1.0296] readonly
-
-/MatrixLMN [ 3.240449 -0.969265 0.055643
- -1.537136 1.876011 -0.204026
- -0.498531 0.041556 1.057229 ] readonly
-
-% Inverse sRGB gamma transform
-/EncodeABC [ { dup 0.00304 le
- { 12.92321 mul }
- { 1 2.4 div exp 1.055 mul 0.055 sub }
- ifelse
- } bind dup dup
- ] readonly
-
-/WhitePoint [ 0.9505 1 1.0890 ] readonly % D65
-/BlackPoint [ 0 0 0 ] readonly
-
-% VonKries-like transform in Bradford Cone Space
- /TransformPQR
- % The implementations have been moved to C for performance.
- [ { .TransformPQR_scale_WB0 } bind
- { .TransformPQR_scale_WB1 } bind
- { .TransformPQR_scale_WB2 } bind
- ] readonly
-.dicttomark setcolorrendering
-
-%END CRD
-
-% Initialize a CIEBased color space for sRGB.
-/CIEsRGB [ /CIEBasedABC
- mark
- /DecodeLMN [ {
- dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
- } bind dup dup ] readonly
- /MatrixLMN [
- 0.412457 0.212673 0.019334
- 0.357576 0.715152 0.119192
- 0.180437 0.072175 0.950301
- ] readonly
- /WhitePoint [0.9505 1.0 1.0890] readonly
- .dicttomark readonly
-] readonly def
-
-% ------ Painting ------ %
-
-% A straightforward definition of execform that doesn't actually
-% do any caching.
-/.execform1 {
- % This is a separate operator so that the stacks will be restored
- % properly if an error occurs.
- dup /Matrix get concat
- dup /BBox get aload pop
- exch 3 index sub exch 2 index sub rectclip
- dup /PaintProc get
- 1 index /Implementation known not {
- 1 index dup /Implementation null .forceput readonly pop
- } if
- exec
-} .bind odef % must bind .forceput
-
-/.formtypes 5 dict
- dup 1 /.execform1 load put
-def
-
-/execform { % <form> execform -
- gsave {
- dup /FormType get //.formtypes exch get exec
- } stopped grestore { stop } if
-} odef
-
-/.patterntypes 5 dict
- dup 1 /.buildpattern1 load put
-def
-
-/makepattern { % <proto_dict> <matrix> makepattern <pattern>
- dup type /dicttype eq {
- % "<dict> makepattern" reports /typecheck on Adobe
- /makepattern .systemvar /typecheck signalerror
- } if
- //.patterntypes 2 .argindex /PatternType get .knownget not {
- /makepattern .systemvar /rangecheck signalerror
- } if
- .currentglobal false .setglobal exch
- % Stack: proto matrix global buildproc
- 3 index dup length 1 add dict .copydict
- % Stack: proto matrix global buildproc newdict
- 3 index 3 -1 roll exec
- % Stack: proto matrix global newdict instance
- % Create an 'Implementation' entry for the pattern dict. The PRLM 3rd says
- % this about the contents of Implementation: "The type and value of this
- % entry are implementation-dependent." The CET (page 2 of 18-02f) expects
- % that this entry be an array and that the second element of the array be a
- % gstate. We put our pattern instance struct into the first element of the
- % array.
- 1 index /Implementation 3 -1 roll gstate 2 array astore
- put % put Implementation into the pattern dict.
- % Stack: proto matrix global newdict
- readonly exch .setglobal exch pop exch pop
-} odef
-
-/setpattern { % [<comp1> ...] <pattern> setpattern -
- { currentcolorspace 0 get /Pattern ne {
- [ /Pattern currentcolorspace ] setcolorspace
- } if setcolor
- } stopped {
- /setpattern .systemvar $error /errorname get signalerror
- } if
-} odef
-
-% The following functions emulate the actions of findcmykcustomcolor and
-% setcustomcolor. These functions are described in Adobe's TN 5044. That
-% same document also says "The following “operators” are not defined in the
-% PostScript Language Reference Manual, but should be used as pseudo-operators
-% in your PostScript language output. Separation applications from Adobe
-% Systems and other vendors will redefine these convention operators to
-% separate your documents. Your application should conditionally define
-% procedures with these special names, as shown later in this document."
-%
-% We are providing these functions because we have found files created by
-% "QuarkXPress: pictwpstops filter 1.0" which produce bad shading dictionaries
-% if these operators are not defined.
-
-% Conditionally disable the TN 5044 psuedo-ops if NO_TN5044 specified
-/NO_TN5044 where { pop (%END TN 5044 psuedo-ops) .skipeof } if
-
-% TN 5044 does not define the contents of the array. We are simply putting
-% the values given into an array. This is consistent with what we see when
-% testing with Adobe Distiller 6.0.
-% <cyan> <magenta> <yellow> <black> <key> findcmykcustomcolor <array>
-/findcmykcustomcolor { 5 array astore } bind def
-
-% Build a tint transform function for use by setcustomcolor. This function
-% is for a Separation color space which has a DeviceCMYK base color space
-% (i.e. 1 input and 4 outputs). The input to buildcustomtinttransform is the
-% array created by findcmykcustomcolor. The resulting function is:
-% { dup cyan mul exch dup magenta mul exch dup yellow mul exch black mul }
-% Where cyan, magenta, yellow, and black are values from the array.
-/buildcustomtinttransform % <array> buildcustomtinttransform <function>
-{ [ /dup load 2 index 0 get /mul load
- /exch load /dup load 6 index 1 get /mul load
- /exch load /dup load 10 index 2 get /mul load
- /exch load 13 index 3 get /mul load
- ] cvx bind
- exch pop % Remove the input array
-} bind def
-
-% Set a custom color based upon a tint and array which describes the custom
-% color. See findcmykcustomcolor. First we create and then set a Separation
-% colorspace. Then we set the specified color.
-% Note that older Adobe ProcSets apparently allow for 'null' as the tint
-% for some reason, so an alternate operational mode is tolerated:
-% null setcustomcolor -
-/setcustomcolor % <array> <tint> setcustomcolor -
-{ dup //null ne {
- % Start building Separation colorspace
- [ /Separation 3 index 4 get % Get separation name from array's key
- /DeviceCMYK
- 5 index //buildcustomtinttransform exec] % build the tint transform function
- setcolorspace % Set the Separation color space as current
- setcolor % Set the tint as the current color
- pop % Remove the input array
- }
- { pop } % 'null' as the tint is ignored
- ifelse
-} bind def
-
-% This proc is supposed to implement a version of overprinting. TN 5044 says
-% that this proc is not used by any shipping host-based application. We have
-% only found it being used in a proc set in files by Canvas from Deneba Systems.
-% Even their proc set does not actually do any overprinting. However their
-% files crash if this is not defined. Thus we have a copy of this proc but
-% we are simply checking for inputs being -1 and if so then we set the value
-% to 0.
-/setcmykoverprint {
- 4 { dup -1 eq { pop 0 } if 4 1 roll } repeat setcmykcolor
-} bind def
-
-/separation_all [/Separation /All /DeviceCMYK { dup dup dup } bind ] readonly def
-
-% Collect the arguments into the image dictionary
-% <width> <height> <bits/sample> <matrix> <proc> args2dict <dict>
-/args2dict {
- 10 dict begin
- {1 0} 1
- { /ImageType /Decode /DataSource /ImageMatrix /BitsPerComponent /Height /Width
- } { exch def } forall
- currentdict end
-} bind def
-
-% Prints (1-gray) on all separations.
-% <gray> setseparationgray -
-/setseparationgray {
- //separation_all setcolorspace
- 1 exch sub setcolor
-} bind def
-
-% Renders an image whose sample values specify the amount of the custom color.
-% <width> <height> <bits/sample> <matrix> <proc> <array> customcolorimage -
-/customcolorimage {
- gsave
- [ /Separation 2 index 4 get /DeviceCMYK 5 -1 roll //buildcustomtinttransform exec] setcolorspace
- //args2dict exec image
- grestore
-} bind def
-
-% Renders an image on all process and custom color plates.
-% <width> <height> <bits/sample> <matrix> <proc>
-/separationimage {
- gsave
- //separation_all setcolorspace
- //args2dict exec image
- grestore
-} bind def
-
-{ /buildcustomtinttransform /separation_all /args2dict }
-{ currentdict exch undef } forall
-
-%END TN 5044 psuedo-ops
-
-end % level2dict