123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776 |
- % Copyright (C) 1994, 2000 Aladdin Enterprises. All rights reserved.
- %
- % This file is part of AFPL Ghostscript.
- %
- % AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND. No author or
- % distributor accepts any responsibility for the consequences of using it, or
- % for whether it serves any particular purpose or works at all, unless he or
- % she says so in writing. Refer to the Aladdin Free Public License (the
- % "License") for full details.
- %
- % Every copy of AFPL Ghostscript must include a copy of the License, normally
- % in a plain ASCII text file named PUBLIC. The License grants you the right
- % to copy, modify and redistribute AFPL Ghostscript, but only under certain
- % conditions described in the License. Among other things, the License
- % requires that the copyright notice and this notice be preserved on all
- % copies.
- % $Id: gs_setpd.ps,v 1.8.2.1 2002/01/25 06:33:09 rayjj 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 dup length dict .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
|