summaryrefslogtreecommitdiff
path: root/Master/xemtex/gslib/gs_setpd.ps
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2005-12-28 00:07:27 +0000
committerKarl Berry <karl@freefriends.org>2005-12-28 00:07:27 +0000
commit30dd9f517c9c093ff3319061647a4555264f7914 (patch)
tree0d7a349bf99be5a42cc9c5a80a30f3b7136c4ccd /Master/xemtex/gslib/gs_setpd.ps
parent08ab8dce83f53b0f915cb66a37bbc8478b22c307 (diff)
trunk
git-svn-id: svn://tug.org/texlive/trunk@9 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/xemtex/gslib/gs_setpd.ps')
-rw-r--r--Master/xemtex/gslib/gs_setpd.ps777
1 files changed, 777 insertions, 0 deletions
diff --git a/Master/xemtex/gslib/gs_setpd.ps b/Master/xemtex/gslib/gs_setpd.ps
new file mode 100644
index 00000000000..edfa072c85d
--- /dev/null
+++ b/Master/xemtex/gslib/gs_setpd.ps
@@ -0,0 +1,777 @@
+% Copyright (C) 1994, 2000 Aladdin Enterprises. All rights reserved.
+%
+% This program is free software; you can redistribute it and/or modify it
+% under the terms of the GNU General Public License as published by the
+% Free Software Foundation; either version 2 of the License, or (at your
+% option) any later version.
+%
+% This program is distributed in the hope that it will be useful, but
+% WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+% Public License for more details.
+%
+% You should have received a copy of the GNU General Public License along
+% with this program; if not, write to the Free Software Foundation, Inc.,
+% 59 Temple Place, Suite 330, Boston, MA, 02111-1307.
+
+% $Id: gs_setpd.ps,v 1.8.2.2.2.2 2003/04/12 14:02:38 giles Exp $
+% 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!
+ DEBUG { (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
+ /PolicyNotFound 1
+ /PageSize 0
+ /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 define InputAttributes and OutputAttributes with a single
+% dummy media type that handles pages of any size.
+% Devices that care will override this.
+ /InputAttributes {
+ mark 0
+ % Since sizes match within 5 user units, we need to set the smallest
+ % PageSize to 6 units so that [0 0] will fail.
+ mark /PageSize [6 dup 16#7ffff dup] .dicttomark
+ .dicttomark
+ }
+ (%MediaSource) 0
+ /OutputAttributes {
+ mark 0 mark .dicttomark readonly .dicttomark
+ }
+ (%MediaDestination) 0
+ /Install {{.callinstall}} bind
+ /BeginPage {{.callbeginpage}} bind
+ /EndPage {{.callendpage}} bind
+ /Policies .defaultpolicies
+.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
+ /PageCount 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 {
+ pop pop
+ } {
+ 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 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
+
+% Define the keys used in input attribute matching.
+/.inputattrkeys [
+ /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
+ % 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
+] readonly def
+
+% 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 false } 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 /PageSize eq
+ { 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
+.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.
+ 0 { % Set errorinfo and signal a configurationerror.
+ pop dup 4 index exch get 2 array astore
+ $error /errorinfo 3 -1 roll put
+ cleartomark
+ /setpagedevice load /configurationerror signalerror
+ } bind
+ 1 { % Roll back the failed request to its previous status.
+DEBUG { (Rolling back.) = pstack flush } if
+ 3 index 2 index 3 -1 roll put
+ 4 index 1 index .knownget
+ { 4 index 3 1 roll put }
+ { 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
+DEBUG { (Putting.) = pstack flush } if
+ .putdeviceparamsonly
+DEBUG { (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 load /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>
+DEBUG { (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>
+DEBUG { (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>
+DEBUG { (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>
+DEBUG { (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> ...
+DEBUG { (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 load exch signalerror
+ }
+ if
+ }
+ if
+
+ % The attempt succeeded. Install the new device.
+ % Stack: mark ... <merged> <failed> <device> <eraseflag>
+DEBUG { (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
+
+ % 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
+ .setdefaultscreen % Set the default screen before calling Install.
+ dup /Install .knownget {
+ { .execinstall } stopped { .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
+% restored if it fails.
+
+/.execinstall { % <proc> .execinstall -
+ % 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. We hack this by adding a couple
+ % of extra tokens to ensure that the operator procedure is still
+ % on the stack during the exec.
+ exec
+ 0 pop % See above.
+} odef
+/.postinstall { % mark ... <failed> <merged> .postinstall -
+ matrix currentmatrix .setdefaultmatrix
+ % Erase and initialize the page.
+ erasepage initgraphics
+ .beginpage
+
+ % Clean up, calling PolicyReport if needed.
+ % Stack: mark ... <failed> <merged>
+DEBUG { (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