summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/lib/gs_setpd.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/lib/gs_setpd.ps')
-rw-r--r--Master/tlpkg/tlgs/lib/gs_setpd.ps924
1 files changed, 0 insertions, 924 deletions
diff --git a/Master/tlpkg/tlgs/lib/gs_setpd.ps b/Master/tlpkg/tlgs/lib/gs_setpd.ps
deleted file mode 100644
index 489275d852e..00000000000
--- a/Master/tlpkg/tlgs/lib/gs_setpd.ps
+++ /dev/null
@@ -1,924 +0,0 @@
-% Copyright (C) 1994, 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_setpd.ps 8026 2007-06-06 22:03:27Z till $
-% The current implementation of setpagedevice has the following limitations:
-% - It doesn't attempt to "interact with the user" for Policy = 2.
-
-languagelevel 1 .setlanguagelevel
-level2dict begin
-
-% ---------------- Redefinitions ---------------- %
-
-% Redefine .beginpage and .endpage so that they call BeginPage and
-% EndPage respectively if appropriate.
-
-% We have to guard against the BeginPage procedure not popping its operand.
-% This is really stupid, but the Genoa CET does it.
-/.beginpage { % - .beginpage -
- .currentshowpagecount {
- .currentpagedevice pop
- dup //null ne { /BeginPage .knownget } { pop //false } ifelse {
- % Stack: ... pagecount proc
- count 2 .execn
- % Stack: ... ..???.. oldcount
- count 1 add exch sub { pop } repeat
- } {
- pop
- } ifelse
- } if
-} bind odef
-
-% Guard similarly against EndPage not popping its operand.
-/.endpage { % <reason> .endpage <print_bool>
- .currentshowpagecount {
- 1 index .currentpagedevice pop
- dup //null ne { /EndPage .knownget } { pop //false } ifelse {
- % Stack: ... reason pagecount reason proc
- count 2 .execn
- % Stack: ... ..???.. print oldcount
- count 2 add exch sub { exch pop } repeat
- } {
- pop pop 2 ne
- } ifelse
- } {
- 2 ne
- } ifelse
-} bind odef
-
-% Define interpreter callouts for handling gstate-saving operators,
-% to make sure that they create a page device dictionary for use by
-% the corresponding gstate-restoring operator.
-% We'd really like to avoid the cost of doing this, but we don't see how.
-% The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
-% %copygstatepagedevice, and %currentgstatepagedevice are known to the
-% interpreter.
-
-(%gsavepagedevice) cvn
- { currentpagedevice pop gsave
- } bind def
-
-(%savepagedevice) cvn
- { currentpagedevice pop save
- } bind def
-
-(%gstatepagedevice) cvn
- { currentpagedevice pop gstate
- } bind def
-
-(%copygstatepagedevice) cvn
- { currentpagedevice pop copy
- } bind def
-
-(%currentgstatepagedevice) cvn
- { currentpagedevice pop currentgstate
- } bind def
-
-% Define interpreter callouts for handling gstate-restoring operators
-% when the current page device needs to be changed.
-% The names %grestorepagedevice, %grestoreallpagedevice,
-% %restorepagedevice, %restore1pagedevice, and %setgstatepagedevice
-% are known to the interpreter.
-
-/.installpagedevice
- { % Since setpagedevice doesn't create new device objects,
- % we must (carefully) reinstall the old parameters in
- % the same device.
- .currentpagedevice pop //null currentdevice //null .trysetparams
- dup type /booleantype eq
- { pop pop }
- { % This should never happen!
- SETPDDEBUG { (Error in .trysetparams!) = pstack flush } if
- cleartomark pop pop pop
- /.installpagedevice cvx /rangecheck signalerror
- }
- ifelse pop pop
- % A careful reading of the Red Book reveals that an erasepage
- % should occur, but *not* an initgraphics.
- erasepage .beginpage
- } bind def
-
-/.uninstallpagedevice
- { 2 .endpage { .currentnumcopies //false .outputpage } if
- nulldevice
- } bind def
-
-(%grestorepagedevice) cvn
- { .uninstallpagedevice grestore .installpagedevice
- } bind def
-
-(%grestoreallpagedevice) cvn
- { .uninstallpagedevice grestore .installpagedevice grestoreall
- } bind def
-
-(%restore1pagedevice) cvn
- { .uninstallpagedevice grestore .installpagedevice restore
- } bind def
-
-(%restorepagedevice) cvn
- { .uninstallpagedevice restore .installpagedevice
- } bind def
-
-(%setgstatepagedevice) cvn
- { .uninstallpagedevice setgstate .installpagedevice
- } bind def
-
-% Redefine .currentnumcopies so it consults the NumCopies device parameter.
-/.numcopiesdict mark
- /NumCopies dup
-.dicttomark readonly def
-
-/.currentnumcopies
- { currentdevice //.numcopiesdict .getdeviceparams
- dup type /integertype eq
- { exch pop exch pop }
- { cleartomark #copies }
- ifelse
- } bind odef
-
-% Redefine .currentpagedevice and .setpagedevice so they convert between
-% null and a fixed empty directionary.
-/.nullpagedevice 0 dict readonly def
-/.currentpagedevice {
- //.currentpagedevice exch dup //null eq { pop //.nullpagedevice } if exch
-} bind odef
-/.setpagedevice {
- dup //.nullpagedevice eq { pop //null } if //.setpagedevice
-} bind odef
-
-% ---------------- Auxiliary definitions ---------------- %
-
-% Define the required attributes of all page devices, and their default values.
-% We don't include attributes such as .MediaSize, which all devices
-% are guaranteed to supply on their own.
-/.defaultpolicies mark
- % M. Sweet, Easy Software Products
- %
- % Due to the fact that it is not possible to properly implement
- % the selection policies from a Ghostscript driver, we have changed
- % the default policy to "7" (impose) to avoid numerous problems with
- % printing within CUPS...
- %
- NOMEDIAATTRS {
- /PolicyNotFound 7
- /PageSize 7
- } {
- /PolicyNotFound 1
- /PageSize 0
- } ifelse
- /PolicyReport {
- dup /.LockSafetyParams known {
- % Only possible error is invalidaccess
- /setpagedevice .systemvar /invalidaccess signalerror
- }
- if
- pop
- } bind
-.dicttomark readonly def
-% Note that the values of .requiredattrs are executed, not just fetched.
-/.requiredattrs mark
- /PageDeviceName //null
- /PageOffset [0 0] readonly
-% We populate InputAttributes with all of the known page sizes
-% followed by a dummy media type that handles pages of any size.
-% This will create some duplicates, but that only slightly slows
-% down the media selection (loop is in zmedia2.c).
-%
-% Some PostScript creators assume that slot 0 is the default media
-% size and some can't handle a non-standard 4-element array which
-% is a 'range' type page size (always put last).
-%
-% Real Devices that can only handle specific page sizes will override this.
- /InputAttributes {
- mark
- % First put the device's default page size in slot 0
- % This satifies those that have devices built with a4 as the default
- 0 mark /PageSize currentdevice /PageSize gsgetdeviceprop .dicttomark
- statusdict /.pagetypenames get {
- counttomark 1 sub 2 idiv exch mark exch /PageSize exch
- % stack: mark --dict-- --dict-- ... key mark /PageSize pagetypename
- % see note above about pagetype executable array contents.
- load dup 0 get exch 1 get 2 array astore .dicttomark
- } forall
- % If NORANGEPAGESIZE is defined, (-dNORANGEPAGESIZE), then don't add
- % the 'match any' PageSize entry
- systemdict /NORANGEPAGESIZE known not {
- % Add one last entry which is the 4 element range array (non-standard)
- counttomark 2 idiv
- % PageSize with either dimension 0 will be detected in
- % match_page_size, so we can allow it here
- mark /PageSize [0 dup 16#7ffff dup] .dicttomark
- } if
- .dicttomark
- }
- (%MediaSource) 0
- /OutputAttributes {
- mark 0 mark .dicttomark readonly .dicttomark
- }
- (%MediaDestination) 0
- /Install {{.callinstall}} bind
- /BeginPage {{.callbeginpage}} bind
- /EndPage {{.callendpage}} bind
- /Policies .defaultpolicies
- /ImagingBBox //null % default value
- /UseCIEColor /.getuseciecolor load
-.dicttomark readonly def
-
-% Define currentpagedevice so it creates the dictionary on demand if needed,
-% adding all the required entries defined just above.
-% We have to deal specially with entries that the driver may change
-% on its own.
-/.dynamicppkeys mark
- /.MediaSize dup % because it changes when PageSize is set
-% /LeadingEdge dup
- /PageCount dup
- /Colors dup
- /BitsPerPixel dup
- /ColorValues dup
-.dicttomark readonly def
-/.makecurrentpagedevice { % - .makecurrentpagedevice <dict>
- currentdevice //null .getdeviceparams
- % Make the dictionary large enough to add defaulted entries.
- counttomark 2 idiv .requiredattrs length add dict
- counttomark 2 idiv { dup 4 2 roll put } repeat exch pop
- % Add any missing required attributes.
- % Make a writable and (if possible) local copy of any default
- % dictionaries, to work around a bug in the output of WordPerfect,
- % which assumes that these dictionaries are writable and local.
- .currentglobal exch dup gcheck .setglobal
- .requiredattrs {
- 2 index 2 index known {
- 1 index /Policies eq {
- % Merge policies from the device driver with defaults
- 2 index % <<>> /key value <<>>
- 3 2 roll get % <<>> value <<policies>>
- exch {
- 2 index 2 index known {
- pop pop
- } {
- 2 index 3 1 roll put
- } ifelse
- } forall
- pop
- } {
- pop pop
- } ifelse
- } {
- exec 2 index 3 1 roll put
- } ifelse
- } forall exch .setglobal
- dup .setpagedevice
-} bind def
-/currentpagedevice {
- .currentpagedevice {
- dup length 0 eq {
- pop .makecurrentpagedevice
- } {
- % If any of the dynamic keys have changed,
- % we must update the page device dictionary.
- currentdevice //.dynamicppkeys .getdeviceparams .dicttomark {
- % Stack: current key value
- 2 index 2 index .knownget { 1 index ne } { //true } ifelse
- { 2 index wcheck not
- { % This is the first entry being updated.
- % Copy the dictionary to make it writable.
- 3 -1 roll
- currentglobal 1 index dup gcheck currentglobal and setglobal
- length dict
- exch setglobal
- .copydict
- 3 1 roll
- }
- if
- 2 index 3 1 roll put
- }
- { pop pop
- }
- ifelse
- } forall
- % If the device is the distiller device, update distillerparams that
- % may have been changed by setdistillerparams
- currentdevice .devicename /pdfwrite eq {
- currentdistillerparams {
- % Stack: current key value
- 2 index 2 index .knownget { 1 index ne } { //true } ifelse
- { 2 index 3 1 roll put } { pop pop } ifelse
- } forall
- } if
- % If the dictionary was global and is now local, copy
- % any global subsidiary dictionaries to local VM. This
- % too is to work around the Word Perfect bug (see above).
- dup gcheck not {
- dup {
- dup type /dicttype eq { dup gcheck } { //false } ifelse {
- % Copy-on-write, see above.
- 2 index wcheck not {
- 3 -1 roll dup length dict .copydict
- 3 1 roll
- } if
- .copytree 2 index 3 1 roll put
- } {
- pop pop
- } ifelse
- } forall
- } if
- % We would like to do a .setpagedevice so we don't keep
- % re-creating the dictionary. Unfortunately, the effect
- % of this is that if any dynamic key changes (PageCount
- % in particular), we will do the equivalent of a
- % setpagedevice at the next restore or grestore.
- % Therefore, we make the dictionary read-only, but
- % we don't store it away. I.e., NOT:
- % dup wcheck { .setpagedevice .currentpagedevice pop } if
- readonly
- } ifelse
- } if
-} bind odef
-
-% Copy a dictionary recursively.
-/.copytree { % <dict> .copytree <dict'>
- dup length dict exch {
- dup type /dicttype eq { .copytree } if 2 index 3 1 roll put
- } forall
-} bind def
-
-% The implementation of setpagedevice is quite complex. Currently,
-% everything but the media matching algorithm is implemented here.
-
-% By default, we only present the requested changes to the device,
-% but there are some parameters that require special merging action.
-% Define those parameters here, with the procedures that do the merging.
-% The procedures are called as follows:
-% <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
-/.mergespecial mark
- /InputAttributes
- { dup //null eq
- { pop //null
- }
- { 3 copy pop .knownget
- { dup //null eq
- { pop dup length dict }
- { dup length 2 index length add dict .copydict }
- ifelse
- }
- { dup length dict
- }
- ifelse .copydict readonly
- }
- ifelse
- } bind
- /OutputAttributes 1 index
- /Policies
- { 3 copy pop .knownget
- { dup length 2 index length add dict .copydict }
- { dup length dict }
- ifelse copy readonly
- } bind
-.dicttomark readonly def
-
-% M. Sweet, Easy Software Products:
-%
-% Define NOMEDIAATTRS to turn off the default (but unimplementable) media
-% selection policies for setpagedevice. This is used by CUPS to support
-% the standard Adobe media attributes.
-NOMEDIAATTRS {
- % Define only PageSize for input attribute matching.
- /.inputattrkeys [
- /PageSize
- ] readonly def
- % Define no other keys used in media selection.
- /.inputselectionkeys [
- /noInputSelectionsKeys
- ] readonly def
-
- % Define no keys used in output attribute matching.
- /.outputattrkeys [
- /noOutputAttrKeys
- ] readonly def
-} {
- % Define the keys used in input attribute matching.
- /.inputattrkeys [
- /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet /ManualFeed
- % The following are documented in Adobe's supplement for v2017.
- /LeadingEdge /MediaClass
- ] readonly def
- % Define other keys used in media selection.
- /.inputselectionkeys [
- /MediaPosition /Orientation
- ] readonly def
-
- % Define the keys used in output attribute matching.
- /.outputattrkeys [
- /OutputType /Duplex /Tumble /ManualFeed
- ] readonly def
-} ifelse
-
-% Define all the parameters that should always be copied to the merged
-% dictionary.
-/.copiedkeys [
- /OutputDevice
- .mergespecial { pop } forall
- .inputattrkeys aload pop
- .inputselectionkeys aload pop
- .outputattrkeys aload pop
-] readonly def
-
-% Define the parameters that should not be presented to the device.
-% The procedures are called as follows:
-% <merged> <key> <value> -proc-
-% The procedure leaves all its operands on the stack and returns
-% true iff the key/value pair should be presented to .putdeviceparams.
-/.presentspecial mark
- .dynamicppkeys
- { pop dup /LeadingEdge ne { //false } { pop } ifelse }
- forall
- % We must ignore an explicit request for .MediaSize,
- % because media matching always handles this.
- /.MediaSize //false
- /Name //false
- /OutputDevice //false
- /PageDeviceName //false
- /PageOffset //false
- /PageSize //false % obsolete alias for .MediaSize
- /InputAttributes //false
- .inputattrkeys
- { dup dup /PageSize eq exch /LeadingEdge eq or
- { pop }
- { { 2 index /InputAttributes .knownget { //null eq } { //true } ifelse } }
- ifelse
- }
- forall
- .inputselectionkeys { //false } forall
- /OutputAttributes //false
- .outputattrkeys
- { { 2 index /OutputAttributes .knownget { //null eq } { //true } ifelse } }
- forall
- /Install //false
- /BeginPage //false
- /EndPage //false
- /Policies //false
- % Our extensions:
- /HWColorMap
- { % HACK: don't transmit the color map, because
- % window systems can change the color map on their own
- % incrementally. Someday we'll have a better
- % solution for this....
- //false
- }
- /ViewerPreProcess //false
- /ImagingBBox //false % This prevents the ImagingBBox value in the setpagedevice
- % from affecting the device's ImagingBBox parameter, but
- % does retain a 'shadow' copy at the PostScript level.
- % This is done for Adobe compatibility since Adobe does
- % render marks outside the ImagingBBox (and QuarkXpress
- % relies on it).
-.dicttomark readonly def
-
-% Define access to device defaults.
-/.defaultdeviceparams
- { finddevice //null .getdeviceparams
- } bind def
-
-% Select media (input or output). The hard work is done in an operator:
-% <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
-% <pagedict> <attrdict> <policydict> <keys> .matchmedia false
-% <pagedict> null <policydict> <keys> .matchmedia null true
-/.selectmedia % <orig> <request> <merged> <failed> <-- retained
- % <attrdict> <policydict> <attrkeys> <mediakey>
- % .selectmedia
- { 5 index 5 -2 roll 4 index .matchmedia
- % Stack: orig request merged failed attrkeys mediakey
- % (key true | false)
- { 4 index 3 1 roll put pop
- }
- { % Adobe's implementations have a "big hairy heuristic"
- % to choose the set of keys to report as having failed the match.
- % For the moment, we report any keys that are in the request
- % and don't have the same value as in the original dictionary.
- 5 index 1 index .knownget
- { 4 index 3 1 roll put }
- { 3 index exch .undef }
- ifelse
- { % Stack: <orig> <request> <merged> <failed> <attrkey>
- 3 index 1 index .knownget
- { 5 index 2 index .knownget { ne } { pop //true } ifelse }
- { //true }
- ifelse % Stack: ... <failed> <attrkey> <report>
- { 2 copy /rangecheck put }
- if pop
- }
- forall
- }
- ifelse
- } bind def
-
-% Apply Policies to any unprocessed failed requests.
-% As we process each request entry, we replace the error name
-% in the <failed> dictionary with the policy value,
-% and we replace the key in the <merged> dictionary with its prior value
-% (or remove it if it had no prior value).
-/.policyprocs mark
-% These procedures are called with the following on the stack:
-% <orig> <merged> <failed> <Policies> <key> <policy>
-% They are expected to consume the top 2 operands.
-% NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
-% the same as 0, i.e., we signal an error.
-%
-% M. Sweet, Easy Software Products:
-%
-% Define NOMEDIAATTRS to turn off the default (but unimplementable) media
-% selection policies for setpagedevice. This is used by CUPS to support
-% the standard Adobe media attributes.
- 0 { % Set errorinfo and signal a configurationerror.
- NOMEDIAATTRS {
- % NOMEDIAATTRS means that the default policy is 7...
- pop 2 index exch 7 put
- } {
- pop dup 4 index exch get 2 array astore
- $error /errorinfo 3 -1 roll put
- cleartomark
- /setpagedevice .systemvar /configurationerror signalerror
- } ifelse
- } bind
- 1 { % Roll back the failed request to its previous status.
-SETPDDEBUG { (Rolling back.) = pstack flush } if
- 3 index 2 index 3 -1 roll .forceput
- 4 index 1 index .knownget
- { 4 index 3 1 roll .forceput }
- { 3 index exch .undef }
- ifelse
- } .bind
- 7 { % For PageSize only, just impose the request.
- 1 index /PageSize eq
- { pop pop 1 index /PageSize 7 put }
- { .policyprocs 0 get exec }
- ifelse
- } bind
-.dicttomark readonly def
-/.applypolicies % <orig> <merged> <failed> .applypolicies
- % <orig> <merged'> <failed'>
- { 1 index /Policies get 1 index
- { type /integertype eq
- { pop % already processed
- }
- { 2 copy .knownget not { 1 index /PolicyNotFound get } if
- % Stack: <orig> <merged> <failed> <Policies> <key>
- % <policy>
- .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
- }
- ifelse
- }
- forall pop
- } bind def
-
-% Prepare to present parameters to the device, by spreading them onto the
-% operand stack and removing any that shouldn't be presented.
-/.prepareparams % <params> .prepareparams -mark- <key1> <value1> ...
- { mark exch dup
- { % Stack: -mark- key1 value1 ... merged key value
- .presentspecial 2 index .knownget
- { exec { 3 -1 roll } { pop pop } ifelse }
- { 3 -1 roll }
- ifelse
- }
- forall pop
- } bind def
-
-% Put device parameters without resetting currentpagedevice.
-% (.putdeviceparams clears the current page device.)
-/.putdeviceparamsonly % <device> <Policies|null> <require_all> -mark-
- % <key1> <value1> ... .putdeviceparamsonly
- % On success: <device> <eraseflag>
- % On failure: <device> <Policies|null> <req_all> -mark-
- % <key1> <error1> ...
- { .currentpagedevice
- { counttomark 4 add 1 roll .putdeviceparams
- dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
- .setpagedevice
- }
- { pop .putdeviceparams
- }
- ifelse
- } bind def
-
-% Try setting the device parameters from the merged request.
-/.trysetparams % <merged> <(ignored)> <device> <Policies>
- % .trysetparams
- { //true 4 index .prepareparams
- % Add the computed .MediaSize.
- % Stack: merged (ignored) device Policies -true-
- % -mark- key1 value1 ...
- counttomark 5 add index .computemediasize
- exch pop exch pop /.MediaSize exch
-SETPDDEBUG { (Putting.) = pstack flush } if
- .putdeviceparamsonly
-SETPDDEBUG { (Result of putting.) = pstack flush } if
- } bind def
-
-% Compute the media size and initial matrix from a merged request (after
-% media selection).
-/.computemediasize % <request> .computemediasize
- % <request> <matrix> <[width height]>
- { dup /PageSize get % requested page size
- 1 index /InputAttributes get
- 2 index (%MediaSource) get get /PageSize get % media size
- % (may be a range)
- 2 index /Policies get
- dup /PageSize .knownget
- { exch pop } { /PolicyNotFound get } ifelse % PageSize policy,
- % affects scaling
- 3 index /Orientation .knownget not { //null } if
- 4 index /RollFedMedia .knownget not { //false } if
- matrix .matchpagesize not {
- % This is a "can't happen" condition!
- /setpagedevice .systemvar /rangecheck signalerror
- } if
- 2 array astore
- } bind def
-
-% ---------------- setpagedevice itself ---------------- %
-
-/setpagedevice
- { % We mustn't pop the argument until the very end,
- % so that the pseudo-operator machinery can restore the stack
- % if an error occurs.
- mark 1 index currentpagedevice
-
- % Check whether we are changing OutputDevice;
- % also handle the case where the current device
- % is not a page device.
- % Stack: mark <request> <current>
-SETPDDEBUG { (Checking.) = pstack flush } if
-
- dup /OutputDevice .knownget
- { % Current device is a page device.
- 2 index /OutputDevice .knownget
- { % A specific OutputDevice was requested.
- 2 copy eq
- { pop pop //null }
- { exch pop }
- ifelse
- }
- { pop //null
- }
- ifelse
- }
- { % Current device is not a page device.
- % Use the default device.
- 1 index /OutputDevice .knownget not { .defaultdevicename } if
- }
- ifelse
- dup //null eq
- { pop
- }
- { exch pop .defaultdeviceparams
- % In case of duplicate keys, .dicttomark takes the entry
- % lower on the stack, so we can just append the defaults here.
- .requiredattrs { exec } forall .dicttomark
- }
- ifelse
-
- % Check whether a viewer wants to intervene.
- % We must check both the request (which takes precedence)
- % and the current dictionary.
- % Stack: mark <request> <orig>
- exch dup /ViewerPreProcess .knownget
- { exec }
- { 1 index /ViewerPreProcess .knownget { exec } if }
- ifelse exch
-
- % Construct a merged request from the actual request plus
- % any keys that should always be propagated.
- % Stack: mark <request> <orig>
-SETPDDEBUG { (Merging.) = pstack flush } if
-
- exch 1 index length 1 index length add dict
- .copiedkeys
- { % Stack: <orig> <request> <merged> <key>
- 3 index 1 index .knownget { 3 copy put pop } if pop
- }
- forall
- % Stack: <orig> <request> <merged>
- dup 2 index
- { % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
- .mergespecial 2 index .knownget { exec } if
- put dup
- }
- forall pop
- % Hack: if FIXEDRESOLUTION is true, discard any attempt to
- % change HWResolution.
- FIXEDRESOLUTION { dup /HWResolution .undef } if
- % Hack: if FIXEDMEDIA is true, discard any attempt to change
- % PageSize or HWSize.
- FIXEDMEDIA
- { dup /PageSize 4 index /PageSize get put
- dup /HWSize 4 index /HWSize get put
- } if
- % Hack: to work around some files that take a PageSize
- % from InputAttributes and impose it, discard any attempt
- % to set PageSize to a 4-element value.
- % Stack: mark <orig> <request> <merged>
- dup /PageSize .knownget {
- length 2 ne {
- dup /PageSize 4 index /PageSize get put
- } if
- } if
-
- % Select input and output media.
- % Stack: mark <orig> <request> <merged>
-SETPDDEBUG { (Selecting.) = pstack flush } if
-
- 0 dict % <failed>
- 1 index /InputAttributes .knownget
- { 2 index /Policies get
- .inputattrkeys (%MediaSource) cvn .selectmedia
- } if
- 1 index /OutputAttributes .knownget
- { 2 index /Policies get
- .outputattrkeys (%MediaDestination) cvn .selectmedia
- } if
- 3 -1 roll 4 1 roll % temporarily swap orig & request
- .applypolicies
- 3 -1 roll 4 1 roll % swap back
-
- % Construct the new device, and attempt to set its attributes.
- % Stack: mark <orig> <request> <merged> <failed>
-SETPDDEBUG { (Constructing.) = pstack flush } if
-
- currentdevice .devicename 2 index /OutputDevice get eq
- { currentdevice }
- { 1 index /OutputDevice get finddevice }
- ifelse
- %**************** We should copy the device here,
- %**************** but since we can't close the old device,
- %**************** we don't. This is WRONG.
- %****************copydevice
- 2 index /Policies get
- .trysetparams
- dup type /booleantype ne
- { % The request failed.
- % Stack: ... <orig> <request> <merged> <failed> <device>
- % <Policies> true mark <name> <errorname> ...
-SETPDDEBUG { (Recovering.) = pstack flush } if
- counttomark 4 add index
- counttomark 2 idiv { dup 4 -2 roll put } repeat
- pop pop pop
- % Stack: mark ... <orig> <request> <merged> <failed> <device>
- % <Policies>
- 6 2 roll 3 -1 roll 4 1 roll
- .applypolicies
- 3 -1 roll 4 1 roll 6 -2 roll
- .trysetparams % shouldn't fail!
- dup type /booleantype ne
- { 2 { counttomark 1 add 1 roll cleartomark } repeat
- /setpagedevice .systemvar exch signalerror
- }
- if
- }
- if
-
- % The attempt succeeded. Install the new device.
- % Stack: mark ... <merged> <failed> <device> <eraseflag>
-SETPDDEBUG { (Installing.) = pstack flush } if
-
- pop 2 .endpage
- { 1 //true .outputpage
- (>>setpagedevice, press <return> to continue<<\n) .confirm
- }
- if
- % .setdevice clears the current page device!
- .currentpagedevice pop exch
- .setdevice pop
- .setpagedevice
-
- % Implement UseCIEColor directly if this is a LL3 system.
- % The color substitution feature is now implemented in
- % the interpreter, and this is used as an optimization.
- %
- % NB: This shoud be the only use of the .setuseciecolor
- % operator anywhere.
- %
- % If UseCIEColor is transitioned to false, set some
- % color space other than /DeviceGray, to insure that
- % initgraphics will actually perform a setcolorspace
- % operation (there is an optimization in setcolorspace
- % that does nothing if the operand and current color
- % spaces are the same, and UseCIEColor is false).
-
- /.setuseciecolor where
- {
- pop 1 index /UseCIEColor .knownget
- {
- dup .setuseciecolor not
- { /DeviceRGB setcolorspace }
- if
- }
- if
- }
- if
-
- % Merge the request into the current page device,
- % unless we're changing the OutputDevice.
- % Stack: mark ... <merged> <failed>
- exch currentpagedevice dup length 2 index length add dict
- % Stack: mark ... <failed> <merged> <current> <newdict>
- 2 index /OutputDevice .knownget {
- 2 index /OutputDevice .knownget not { //null } if eq
- } {
- //true
- } ifelse {
- % Same OutputDevice, merge the dictionaries.
- .copydict
- } {
- % Different OutputDevice, discard the old dictionary.
- exch pop
- } ifelse .copydict
- % Initialize the default matrix, taking media matching
- % into account.
- .computemediasize pop initmatrix concat
- dup /PageOffset .knownget
- { % Translate by the given number of 1/72" units in device X/Y.
- dup 0 get exch 1 get
- 2 index /HWResolution get dup 1 get exch 0 get
- 4 -1 roll mul 72 div 3 1 roll mul 72 div
- idtransform translate
- }
- if
- % We must install the new page device dictionary
- % before calling the Install procedure.
- dup .setpagedevice
- .setdefaulthalftone % Set the default screen before calling Install.
- dup /Install .knownget {
- { .execinstall } stopped {
- pop % Install procedure failed. One element will have been left on the stack.
- % stack: mark <orig> <request> <failed> <merged>
- 1 index /Install $error /errorname get put % Put it in the "failed" dict
- % .applypolicies needs stack: <orig> <merged> <failed>
- exch 4 2 roll exch 4 2 roll .applypolicies exch 4 2 roll exch 4 2 roll
- % Now execute the old Install -- failures after this are not handled
- dup /Install .knownget { { .execinstall } stopped { pop } if } if
- .postinstall stop
- } {
- .postinstall
- } ifelse
- } {
- .postinstall
- } ifelse
-} odef
-
-% We break out the code after calling the Install procedure into a
-% separate procedure, since it is executed even if Install causes an error.
-% By making .execinstall a separate operator procedure, we get the stacks
-% mostly restored if it fails, except for one element (the operand).
-% Thus if it fails, there will be one element left on the op stack.
-
-/.execinstall { % <proc> .execinstall -
- dup % element left on the stack if the exec fails.
-
- % Because the interpreter optimizes tail calls, we can't just let
- % the body of this procedure be 'exec', because that would lose
- % the stack protection that is the whole reason for having the
- % procedure in the first place. The 'pop' for the dummy element
- % on the op stack suffices.
- exec
- pop % See above.
-} odef
-
-/.postinstall { % mark ... <failed> <merged> .postinstall -
- matrix currentmatrix .setdefaultmatrix
- % Erase and initialize the page.
- initgraphics
- currentoverprint //false setoverprint 1 setcolor
- .fillpage
- 0 setcolor setoverprint
- .beginpage
-
- % Clean up, calling PolicyReport if needed.
- % Stack: mark ... <failed> <merged>
-SETPDDEBUG { (Finishing.) = pstack flush } if
-
- exch dup length 0 ne
- { 1 index /Policies get /PolicyReport get
- counttomark 1 add 2 roll cleartomark
- exec
- }
- { cleartomark
- }
- ifelse pop
-
-} odef
-
-end % level2dict
-.setlanguagelevel