home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / GhostScript / !GhostScr / 6_01 / lib / gs_setpd.ps < prev    next >
Text File  |  2000-03-09  |  24KB  |  749 lines
  1. %    Copyright (C) 1994, 1996, 1997, 1998, 1999 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % $Id: gs_setpd.ps,v 1.1 2000/03/09 08:40:40 lpd Exp $
  19. % The current implementation of setpagedevice has the following limitations:
  20. %    - It doesn't attempt to "interact with the user" for Policy = 2.
  21.  
  22. languagelevel 1 .setlanguagelevel
  23. level2dict begin
  24.  
  25. % ---------------- Redefinitions ---------------- %
  26.  
  27. % Redefine .beginpage and .endpage so that they call BeginPage and
  28. % EndPage respectively if appropriate.
  29.  
  30. % We have to guard against the BeginPage procedure not popping its operand.
  31. % This is really stupid, but the Genoa CET does it.
  32. /.beginpage {        % - .beginpage -
  33.   .currentshowpagecount {
  34.     .currentpagedevice pop
  35.     dup null ne { /BeginPage .knownget } { pop false } ifelse {
  36.         % Stack: ... pagecount proc
  37.        count 2 .execn
  38.         % Stack: ... ..???.. oldcount
  39.        count 1 add exch sub { pop } repeat
  40.     } {
  41.       pop
  42.     } ifelse
  43.   } if
  44. } bind odef
  45.  
  46. % Guard similarly against EndPage not popping its operand.
  47. /.endpage {        % <reason> .endpage <print_bool>
  48.   .currentshowpagecount {
  49.     1 index .currentpagedevice pop
  50.     dup null ne { /EndPage .knownget } { pop false } ifelse {
  51.         % Stack: ... reason pagecount reason proc
  52.       count 2 .execn
  53.         % Stack: ... ..???.. print oldcount
  54.       count 2 add exch sub { exch pop } repeat
  55.     } {
  56.       pop pop 2 ne
  57.     } ifelse
  58.   } {
  59.     2 ne
  60.   } ifelse
  61. } bind odef
  62.  
  63. % Define interpreter callouts for handling gstate-saving operators,
  64. % to make sure that they create a page device dictionary for use by
  65. % the corresponding gstate-restoring operator.
  66. % We'd really like to avoid the cost of doing this, but we don't see how.
  67. % The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
  68. % %copygstatepagedevice, and %currentgstatepagedevice are known to the
  69. % interpreter.
  70.  
  71. (%gsavepagedevice) cvn
  72.  { currentpagedevice pop gsave
  73.  } bind def
  74.  
  75. (%savepagedevice) cvn
  76.  { currentpagedevice pop save
  77.  } bind def
  78.  
  79. (%gstatepagedevice) cvn
  80.  { currentpagedevice pop gstate
  81.  } bind def
  82.  
  83. (%copygstatepagedevice) cvn
  84.  { currentpagedevice pop copy
  85.  } bind def
  86.  
  87. (%currentgstatepagedevice) cvn
  88.  { currentpagedevice pop currentgstate
  89.  } bind def
  90.  
  91. % Define interpreter callouts for handling gstate-restoring operators
  92. % when the current page device needs to be changed.
  93. % The names %grestorepagedevice, %grestoreallpagedevice,
  94. % %restorepagedevice, and %setgstatepagedevice are known to the interpreter.
  95.  
  96. /.installpagedevice
  97.  {    % Since setpagedevice doesn't create new device objects,
  98.     % we must (carefully) reinstall the old parameters in
  99.     % the same device.
  100.    .currentpagedevice pop null currentdevice null .trysetparams
  101.    dup type /booleantype eq
  102.     { pop pop }
  103.     {        % This should never happen!
  104.       DEBUG { (Error in .trysetparams!) = pstack flush } if
  105.       cleartomark pop pop pop
  106.       /.installpagedevice cvx /rangecheck signalerror
  107.     }
  108.    ifelse pop pop
  109.     % A careful reading of the Red Book reveals that an erasepage
  110.     % should occur, but *not* an initgraphics.
  111.    erasepage .beginpage
  112.  } bind def
  113.  
  114. /.uninstallpagedevice
  115.  { 2 .endpage { .currentnumcopies false .outputpage } if
  116.    nulldevice
  117.  } bind def
  118.  
  119. (%grestorepagedevice) cvn
  120.  { .uninstallpagedevice grestore .installpagedevice
  121.  } bind def
  122.  
  123. (%grestoreallpagedevice) cvn
  124.  { .uninstallpagedevice grestore .installpagedevice grestoreall
  125.  } bind def
  126.  
  127. (%restorepagedevice) cvn
  128.  { .uninstallpagedevice grestore .installpagedevice restore
  129.  } bind def
  130.  
  131. (%setgstatepagedevice) cvn
  132.  { .uninstallpagedevice setgstate .installpagedevice
  133.  } bind def
  134.  
  135. % Redefine .currentnumcopies so it consults the NumCopies device parameter.
  136. /.numcopiesdict mark
  137.   /NumCopies dup
  138. .dicttomark readonly def
  139.  
  140. /.currentnumcopies
  141.  { currentdevice //.numcopiesdict .getdeviceparams
  142.    dup type /integertype eq
  143.     { exch pop exch pop }
  144.     { cleartomark #copies }
  145.    ifelse
  146.  } bind odef
  147.  
  148. % Redefine .currentpagedevice and .setpagedevice so they convert between
  149. % null and a fixed empty directionary.
  150. /.nullpagedevice 0 dict readonly def
  151. /.currentpagedevice {
  152.   //.currentpagedevice exch dup null eq { pop //.nullpagedevice } if exch
  153. } bind odef
  154. /.setpagedevice {
  155.   dup //.nullpagedevice eq { pop null } if //.setpagedevice
  156. } bind odef
  157.  
  158. % ---------------- Auxiliary definitions ---------------- %
  159.  
  160. % Define the required attributes of all page devices, and their default values.
  161. % We don't include attributes such as .MediaSize, which all devices
  162. % are guaranteed to supply on their own.
  163. /.defaultpolicies mark
  164.   /PolicyNotFound 1
  165.   /PageSize 0
  166.   /PolicyReport {pop} bind
  167. .dicttomark readonly def
  168. % Note that the values of .requiredattrs are executed, not just fetched.
  169. /.requiredattrs mark
  170.   /PageDeviceName null
  171.   /PageOffset [0 0] readonly
  172. % We define InputAttributes and OutputAttributes with a single
  173. % dummy media type that handles pages of any size.
  174. % Devices that care will override this.
  175.   /InputAttributes {
  176.     mark 0
  177.     % Since sizes match within 5 user units, we need to set the smallest
  178.     % PageSize to 6 units so that [0 0] will fail.
  179.     mark /PageSize [6 dup 16#7ffff dup] .dicttomark
  180.     .dicttomark
  181.   }
  182.   (%MediaSource) 0
  183.   /OutputAttributes {
  184.     mark 0 mark .dicttomark readonly .dicttomark
  185.   }
  186.   (%MediaDestination) 0
  187.   /Install {{.callinstall}} bind
  188.   /BeginPage {{.callbeginpage}} bind
  189.   /EndPage {{.callendpage}} bind
  190.   /Policies .defaultpolicies
  191. .dicttomark readonly def
  192.  
  193. % Define currentpagedevice so it creates the dictionary on demand if needed,
  194. % adding all the required entries defined just above.
  195. % We have to deal specially with entries that the driver may change
  196. % on its own.
  197. /.dynamicppkeys mark
  198.   /.MediaSize dup        % because it changes when PageSize is set
  199.   /PageCount dup
  200. .dicttomark readonly def
  201. /.makecurrentpagedevice {    % - .makecurrentpagedevice <dict>
  202.   currentdevice null .getdeviceparams
  203.     % Make the dictionary large enough to add defaulted entries.
  204.   counttomark 2 idiv .requiredattrs length add dict
  205.   counttomark 2 idiv { dup 4 2 roll put } repeat exch pop
  206.     % Add any missing required attributes.
  207.     % Make a writable and (if possible) local copy of any default
  208.     % dictionaries, to work around a bug in the output of WordPerfect,
  209.     % which assumes that these dictionaries are writable and local.
  210.   .currentglobal exch dup gcheck .setglobal
  211.   .requiredattrs {
  212.     2 index 2 index known {
  213.       pop pop
  214.     } {
  215.       exec 2 index 3 1 roll put
  216.     } ifelse
  217.   } forall exch .setglobal
  218.   dup .setpagedevice
  219. } bind def
  220. /currentpagedevice {
  221.   .currentpagedevice {
  222.     dup length 0 eq {
  223.       pop .makecurrentpagedevice
  224.     } {
  225.         % If any of the dynamic keys have changed,
  226.         % we must update the page device dictionary.
  227.       currentdevice //.dynamicppkeys .getdeviceparams .dicttomark {
  228.         % Stack: current key value
  229.         2 index 2 index .knownget { 1 index ne } { true } ifelse
  230.          { 2 index wcheck not
  231.         {    % This is the first entry being updated.
  232.             % Copy the dictionary to make it writable.
  233.           3 -1 roll dup length dict .copydict
  234.           3 1 roll
  235.         }
  236.            if
  237.            2 index 3 1 roll put
  238.          }
  239.          { pop pop
  240.          }
  241.         ifelse
  242.       } forall
  243.         % If the dictionary was global and is now local, copy
  244.         % any global subsidiary dictionaries to local VM.  This
  245.         % too is to work around the Word Perfect bug (see above).
  246.       dup gcheck not {
  247.     dup {
  248.       dup type /dicttype eq { dup gcheck } { false } ifelse {
  249.         % Copy-on-write, see above.
  250.         2 index wcheck not {
  251.           3 -1 roll dup length dict .copydict
  252.           3 1 roll
  253.         } if
  254.         .copytree 2 index 3 1 roll put
  255.       } {
  256.         pop pop
  257.       } ifelse
  258.     } forall
  259.       } if
  260.         % We would like to do a .setpagedevice so we don't keep
  261.         % re-creating the dictionary.  Unfortunately, the effect
  262.         % of this is that if any dynamic key changes (PageCount
  263.         % in particular), we will do the equivalent of a
  264.         % setpagedevice at the next restore or grestore.
  265.         % Therefore, we make the dictionary read-only, but
  266.         % we don't store it away.  I.e., NOT:
  267.         % dup wcheck { .setpagedevice .currentpagedevice pop } if
  268.       readonly
  269.     } ifelse
  270.   } if
  271. } bind odef
  272.  
  273. % Copy a dictionary recursively.
  274. /.copytree {    % <dict> .copytree <dict'>
  275.   dup length dict exch {
  276.     dup type /dicttype eq { .copytree } if 2 index 3 1 roll put
  277.   } forall
  278. } bind def
  279.  
  280. % The implementation of setpagedevice is quite complex.  Currently,
  281. % everything but the media matching algorithm is implemented here.
  282.  
  283. % By default, we only present the requested changes to the device,
  284. % but there are some parameters that require special merging action.
  285. % Define those parameters here, with the procedures that do the merging.
  286. % The procedures are called as follows:
  287. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  288. /.mergespecial mark
  289.   /InputAttributes
  290.    { dup null eq
  291.       { pop null
  292.       }
  293.       { 3 copy pop .knownget
  294.      { dup null eq
  295.         { pop dup length dict }
  296.         { dup length 2 index length add dict .copydict }
  297.        ifelse
  298.      }
  299.      { dup length dict
  300.      }
  301.         ifelse .copydict readonly
  302.       }
  303.      ifelse
  304.    } bind
  305.   /OutputAttributes 1 index
  306.   /Policies
  307.     { 3 copy pop .knownget
  308.        { dup length 2 index length add dict .copydict }
  309.        { dup length dict }
  310.       ifelse copy readonly
  311.     } bind
  312. .dicttomark readonly def
  313.  
  314. % Define the keys used in input attribute matching.
  315. /.inputattrkeys [
  316.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  317.     % The following are documented in Adobe's supplement for v2017.
  318.   /LeadingEdge /MediaClass
  319. ] readonly def
  320. % Define other keys used in media selection.
  321. /.inputselectionkeys [
  322.   /MediaPosition /Orientation
  323. ] readonly def
  324.  
  325. % Define the keys used in output attribute matching.
  326. /.outputattrkeys [
  327.   /OutputType
  328. ] readonly def
  329.  
  330. % Define all the parameters that should always be copied to the merged
  331. % dictionary.
  332. /.copiedkeys [
  333.   /OutputDevice
  334.   .mergespecial { pop } forall
  335.   .inputattrkeys aload pop
  336.   .inputselectionkeys aload pop
  337.   .outputattrkeys aload pop
  338. ] readonly def
  339.  
  340. % Define the parameters that should not be presented to the device.
  341. % The procedures are called as follows:
  342. %    <merged> <key> <value> -proc-
  343. % The procedure leaves all its operands on the stack and returns
  344. % true iff the key/value pair should be presented to .putdeviceparams.
  345. /.presentspecial mark
  346.   .dynamicppkeys { pop false } forall
  347.             % We must ignore an explicit request for .MediaSize,
  348.             % because media matching always handles this.
  349.   /.MediaSize false
  350.   /Name false
  351.   /OutputDevice false
  352.   /PageDeviceName false
  353.   /PageOffset false
  354.   /PageSize false        % obsolete alias for .MediaSize
  355.   /InputAttributes false
  356.   .inputattrkeys
  357.     { dup /PageSize eq
  358.        { pop }
  359.        { { 2 index /InputAttributes .knownget { null eq } { true } ifelse } }
  360.       ifelse
  361.     }
  362.   forall
  363.   .inputselectionkeys { false } forall
  364.   /OutputAttributes false
  365.   .outputattrkeys
  366.     { { 2 index /OutputAttributes .knownget { null eq } { true } ifelse } }
  367.   forall
  368.   /Install false
  369.   /BeginPage false
  370.   /EndPage false
  371.   /Policies false
  372.     % Our extensions:
  373.   /HWColorMap
  374.     {            % HACK: don't transmit the color map, because
  375.             % window systems can change the color map on their own
  376.             % incrementally.  Someday we'll have a better
  377.             % solution for this....
  378.       false
  379.     }
  380.   /ViewerPreProcess false
  381. .dicttomark readonly def
  382.  
  383. % Define access to device defaults.
  384. /.defaultdeviceparams
  385.  { finddevice null .getdeviceparams
  386.  } bind def
  387.  
  388. % Select media (input or output).  The hard work is done in an operator:
  389. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
  390. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia false
  391. %    <pagedict> null <policydict> <keys> .matchmedia null true
  392. /.selectmedia        % <orig> <request> <merged> <failed>     <-- retained
  393.             %   <attrdict> <policydict> <attrkeys> <mediakey>
  394.             %   .selectmedia
  395.  { 5 index 5 -2 roll 4 index .matchmedia
  396.         % Stack: orig request merged failed attrkeys mediakey
  397.         %   (key true | false)
  398.     { 4 index 3 1 roll put pop
  399.     }
  400.     {    % Adobe's implementations have a "big hairy heuristic"
  401.     % to choose the set of keys to report as having failed the match.
  402.     % For the moment, we report any keys that are in the request
  403.     % and don't have the same value as in the original dictionary.
  404.       5 index 1 index .knownget
  405.        { 4 index 3 1 roll put }
  406.        { 3 index exch .undef }
  407.       ifelse
  408.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  409.      3 index 1 index .knownget
  410.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  411.       { true }
  412.      ifelse        % Stack: ... <failed> <attrkey> <report>
  413.       { 2 copy /rangecheck put }
  414.      if pop
  415.        }
  416.       forall
  417.     }
  418.    ifelse
  419.  } bind def
  420.  
  421. % Apply Policies to any unprocessed failed requests.
  422. % As we process each request entry, we replace the error name
  423. % in the <failed> dictionary with the policy value,
  424. % and we replace the key in the <merged> dictionary with its prior value
  425. % (or remove it if it had no prior value).
  426. /.policyprocs mark
  427. % These procedures are called with the following on the stack:
  428. %   <orig> <merged> <failed> <Policies> <key> <policy>
  429. % They are expected to consume the top 2 operands.
  430. % NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
  431. % the same as 0, i.e., we signal an error.
  432.   0 {        % Set errorinfo and signal a configurationerror.
  433.     pop dup 4 index exch get 2 array astore
  434.     $error /errorinfo 3 -1 roll put
  435.     cleartomark
  436.     /setpagedevice load /configurationerror signalerror
  437.   } bind
  438.   1 {        % Roll back the failed request to its previous status.
  439. DEBUG { (Rolling back.) = pstack flush } if
  440.     3 index 2 index 3 -1 roll put
  441.     4 index 1 index .knownget
  442.      { 4 index 3 1 roll put }
  443.      { 3 index exch .undef }
  444.     ifelse
  445.   } bind
  446.   7 {        % For PageSize only, just impose the request.
  447.     1 index /PageSize eq
  448.      { pop pop 1 index /PageSize 7 put }
  449.      { .policyprocs 0 get exec }
  450.     ifelse
  451.   } bind
  452. .dicttomark readonly def
  453. /.applypolicies        % <orig> <merged> <failed> .applypolicies
  454.             %   <orig> <merged'> <failed'>
  455.  { 1 index /Policies get 1 index
  456.     { type /integertype eq
  457.        { pop        % already processed
  458.        }
  459.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  460.             % Stack: <orig> <merged> <failed> <Policies> <key>
  461.             %   <policy>
  462.      .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
  463.        }
  464.       ifelse
  465.     }
  466.    forall pop
  467.  } bind def
  468.  
  469. % Prepare to present parameters to the device, by spreading them onto the
  470. % operand stack and removing any that shouldn't be presented.
  471. /.prepareparams        % <params> .prepareparams -mark- <key1> <value1> ...
  472.  { mark exch dup
  473.     {            % Stack: -mark- key1 value1 ... merged key value
  474.       .presentspecial 2 index .knownget
  475.        { exec { 3 -1 roll } { pop pop } ifelse }
  476.        { 3 -1 roll }
  477.       ifelse
  478.     }
  479.    forall pop
  480.  } bind def
  481.  
  482. % Put device parameters without resetting currentpagedevice.
  483. % (.putdeviceparams clears the current page device.)
  484. /.putdeviceparamsonly    % <device> <Policies|null> <require_all> -mark-
  485.             %   <key1> <value1> ... .putdeviceparamsonly
  486.             % On success: <device> <eraseflag>
  487.             % On failure: <device> <Policies|null> <req_all> -mark-
  488.             %   <key1> <error1> ...
  489.  { .currentpagedevice
  490.     { counttomark 4 add 1 roll .putdeviceparams
  491.       dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
  492.       .setpagedevice
  493.     }
  494.     { pop .putdeviceparams
  495.     }
  496.    ifelse
  497.  } bind def
  498.  
  499. % Try setting the device parameters from the merged request.
  500. /.trysetparams        % <merged> <(ignored)> <device> <Policies>
  501.             %   .trysetparams
  502.  { true 4 index .prepareparams
  503.             % Add the computed .MediaSize.
  504.             % Stack: merged (ignored) device Policies -true-
  505.             %   -mark- key1 value1 ...
  506.    counttomark 5 add index .computemediasize
  507.    exch pop exch pop /.MediaSize exch
  508. DEBUG { (Putting.) = pstack flush } if
  509.    .putdeviceparamsonly
  510. DEBUG { (Result of putting.) = pstack flush } if
  511.  } bind def
  512.  
  513. % Compute the media size and initial matrix from a merged request (after
  514. % media selection).
  515. /.computemediasize    % <request> .computemediasize
  516.             %   <request> <matrix> <[width height]>
  517.  { dup /PageSize get                    % requested page size
  518.    1 index /InputAttributes get
  519.      2 index (%MediaSource) get get /PageSize get    % media size
  520.                             % (may be a range)
  521.    2 index /Policies get
  522.      dup /PageSize .knownget
  523.       { exch pop } { /PolicyNotFound get } ifelse    % PageSize policy,
  524.                             % affects scaling
  525.    3 index /Orientation .knownget not { null } if
  526.    4 index /RollFedMedia .knownget not { false } if
  527.    matrix .matchpagesize not {
  528.         % This is a "can't happen" condition!
  529.      /setpagedevice load /rangecheck signalerror
  530.    } if
  531.    2 array astore
  532.  } bind def
  533.  
  534. % ---------------- setpagedevice itself ---------------- %
  535.  
  536. /setpagedevice
  537.  {        % We mustn't pop the argument until the very end,
  538.         % so that the pseudo-operator machinery can restore the stack
  539.         % if an error occurs.
  540.    mark 1 index currentpagedevice
  541.  
  542.         % Check whether we are changing OutputDevice;
  543.         % also handle the case where the current device
  544.         % is not a page device.
  545.         % Stack: mark <request> <current>
  546. DEBUG { (Checking.) = pstack flush } if
  547.  
  548.    dup /OutputDevice .knownget
  549.     {        % Current device is a page device.
  550.       2 index /OutputDevice .knownget
  551.        {    % A specific OutputDevice was requested.
  552.      2 copy eq
  553.       { pop pop null }
  554.       { exch pop }
  555.      ifelse
  556.        }
  557.        { pop null
  558.        }
  559.       ifelse
  560.     }
  561.     {        % Current device is not a page device.
  562.         % Use the default device.
  563.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  564.     }
  565.    ifelse
  566.    dup null eq
  567.     { pop
  568.     }
  569.     { exch pop .defaultdeviceparams
  570.         % In case of duplicate keys, .dicttomark takes the entry
  571.         % lower on the stack, so we can just append the defaults here.
  572.       .requiredattrs { exec } forall .dicttomark
  573.     }
  574.    ifelse
  575.  
  576.         % Check whether a viewer wants to intervene.
  577.         % We must check both the request (which takes precedence)
  578.         % and the current dictionary.
  579.         % Stack: mark <request> <orig>
  580.    exch dup /ViewerPreProcess .knownget
  581.     { exec }
  582.     { 1 index /ViewerPreProcess .knownget { exec } if }
  583.    ifelse exch
  584.  
  585.         % Construct a merged request from the actual request plus
  586.         % any keys that should always be propagated.
  587.         % Stack: mark <request> <orig>
  588. DEBUG { (Merging.) = pstack flush } if
  589.  
  590.    exch 1 index length 1 index length add dict
  591.    .copiedkeys
  592.     {        % Stack: <orig> <request> <merged> <key>
  593.       3 index 1 index .knownget { 3 copy put pop } if pop
  594.     }
  595.    forall
  596.         % Stack: <orig> <request> <merged>
  597.    dup 2 index
  598.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  599.       .mergespecial 2 index .knownget { exec } if
  600.       put dup
  601.     }
  602.    forall pop
  603.         % Hack: if FIXEDRESOLUTION is true, discard any attempt to
  604.         % change HWResolution.
  605.    FIXEDRESOLUTION { dup /HWResolution .undef } if
  606.         % Hack: if FIXEDMEDIA is true, discard any attempt to change
  607.         % PageSize or HWSize.
  608.    FIXEDMEDIA
  609.     { dup /PageSize 4 index /PageSize get put
  610.       dup /HWSize 4 index /HWSize get put
  611.     } if
  612.  
  613.         % Select input and output media.
  614.         % Stack: mark <orig> <request> <merged>
  615. DEBUG { (Selecting.) = pstack flush } if
  616.  
  617.    0 dict    % <failed>
  618.    1 index /InputAttributes .knownget
  619.     { 2 index /Policies get
  620.       .inputattrkeys (%MediaSource) cvn .selectmedia
  621.     } if
  622.    1 index /OutputAttributes .knownget
  623.     { 2 index /Policies get
  624.       .outputattrkeys (%MediaDestination) cvn .selectmedia
  625.      } if
  626.    3 -1 roll 4 1 roll        % temporarily swap orig & request
  627.    .applypolicies
  628.    3 -1 roll 4 1 roll        % swap back
  629.  
  630.         % Construct the new device, and attempt to set its attributes.
  631.         % Stack: mark <orig> <request> <merged> <failed>
  632. DEBUG { (Constructing.) = pstack flush } if
  633.  
  634.    currentdevice .devicename 2 index /OutputDevice get eq
  635.     { currentdevice }
  636.     { 1 index /OutputDevice get finddevice }
  637.    ifelse
  638.         %**************** We should copy the device here,
  639.         %**************** but since we can't close the old device,
  640.         %**************** we don't.  This is WRONG.
  641.     %****************copydevice
  642.    2 index /Policies get
  643.    .trysetparams
  644.    dup type /booleantype ne
  645.     {        % The request failed.
  646.         % Stack: ... <orig> <request> <merged> <failed> <device>
  647.         %   <Policies> true mark <name> <errorname> ...
  648. DEBUG { (Recovering.) = pstack flush } if
  649.       counttomark 4 add index
  650.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  651.       pop pop pop
  652.         % Stack: mark ... <orig> <request> <merged> <failed> <device>
  653.         %   <Policies>
  654.       6 2 roll 3 -1 roll 4 1 roll
  655.       .applypolicies
  656.       3 -1 roll 4 1 roll 6 -2 roll
  657.       .trysetparams        % shouldn't fail!
  658.       dup type /booleantype ne
  659.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  660.          /setpagedevice load exch signalerror
  661.        }
  662.       if
  663.     }
  664.    if
  665.  
  666.         % The attempt succeeded.  Install the new device.
  667.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  668. DEBUG { (Installing.) = pstack flush } if
  669.  
  670.    pop 2 .endpage
  671.     { 1 true .outputpage
  672.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  673.     }
  674.    if
  675.         % .setdevice clears the current page device!
  676.    .currentpagedevice pop exch
  677.    .setdevice pop
  678.    .setpagedevice
  679.  
  680.         % Merge the request into the current page device,
  681.         % unless we're changing the OutputDevice.
  682.         % Stack: mark ... <merged> <failed>
  683.    exch currentpagedevice dup length 2 index length add dict
  684.         % Stack: mark ... <failed> <merged> <current> <newdict>
  685.    2 index /OutputDevice .knownget {
  686.      2 index /OutputDevice .knownget not { null } if eq
  687.    } {
  688.      true
  689.    } ifelse {
  690.         % Same OutputDevice, merge the dictionaries.
  691.      .copydict
  692.    } {
  693.         % Different OutputDevice, discard the old dictionary.
  694.      exch pop
  695.    } ifelse .copydict
  696.         % Initialize the default matrix, taking media matching
  697.         % into account.
  698.    .computemediasize pop initmatrix concat
  699.    dup /PageOffset .knownget
  700.     {        % Translate by the given number of 1/72" units in device X/Y.
  701.       dup 0 get exch 1 get
  702.       2 index /HWResolution get dup 1 get exch 0 get
  703.       4 -1 roll mul 72 div   3 1 roll mul 72 div
  704.       idtransform translate
  705.     }
  706.    if
  707.         % We must install the new page device dictionary
  708.         % before calling the Install procedure.
  709.   dup .setpagedevice
  710.   .setdefaultscreen    % Set the default screen before calling Install.
  711.   dup /Install .knownget {
  712.     { .execinstall } stopped { .postinstall stop } { .postinstall } ifelse
  713.   } {
  714.     .postinstall
  715.   } ifelse
  716. } odef
  717.  
  718. % We break out the code after calling the Install procedure into a
  719. % separate procedure, since it is executed even if Install causes an error.
  720. % By making .execinstall a separate operator procedure, we get the stacks
  721. % restored if it fails.
  722.  
  723. /.execinstall {        % <proc> .execinstall -
  724.   exec
  725. } odef
  726. /.postinstall {        % mark ... <failed> <merged> .postinstall -
  727.    matrix currentmatrix .setdefaultmatrix
  728.         % Erase and initialize the page.
  729.    erasepage initgraphics
  730.    .beginpage
  731.  
  732.         % Clean up, calling PolicyReport if needed.
  733.         % Stack: mark ... <failed> <merged>
  734. DEBUG { (Finishing.) = pstack flush } if
  735.  
  736.    exch dup length 0 ne
  737.     { 1 index /Policies get /PolicyReport get
  738.       counttomark 1 add 2 roll cleartomark
  739.       exec
  740.     }
  741.     { cleartomark
  742.     }
  743.    ifelse pop
  744.  
  745. } odef
  746.  
  747. end                % level2dict
  748. .setlanguagelevel
  749.