hardcopy.ps (3940B)
1 % 2 % Redefiniton of the PostScript file output operators so results go to paper. 3 % Complicated and slow, but the implementation doesn't place many demands on 4 % included PostScript. About all that's required is gentle treatment of the 5 % graphics state between write calls. 6 % 7 8 /#copies 1 store 9 /aspectratio 1 def 10 /font /Courier def 11 /formsperpage 1 def 12 /landscape false def 13 /magnification 1 def 14 /orientation 0 def 15 /pointsize 10 def 16 /rotation 1 def 17 /xoffset .1 def 18 /yoffset .1 def 19 20 /roundpage true def 21 /useclippath true def 22 /pagebbox [0 0 612 792] def 23 24 /inch {72 mul} def 25 /min {2 copy gt {exch} if pop} def 26 27 /HardcopySetup { 28 landscape {/orientation 90 orientation add def} if 29 font findfont 1 1.1 div scalefont setfont 30 31 pagedimensions 32 xcenter ycenter translate 33 orientation rotation mul rotate 34 width 2 div neg height 2 div translate 35 xoffset inch yoffset inch neg translate 36 pointsize 1.1 mul dup scale 37 magnification dup aspectratio mul scale 38 height width div 1 min dup scale 39 0 -1 translate 40 0 0 moveto 41 } def 42 43 /pagedimensions { 44 useclippath { 45 /pagebbox [clippath pathbbox newpath] def 46 roundpage currentdict /roundpagebbox known and {roundpagebbox} if 47 } if 48 pagebbox aload pop 49 4 -1 roll exch 4 1 roll 4 copy 50 landscape {4 2 roll} if 51 sub /width exch def 52 sub /height exch def 53 add 2 div /xcenter exch def 54 add 2 div /ycenter exch def 55 } def 56 57 % 58 % Unbind the operators in an executable array or packedarray. Leaves the 59 % unbound array or the original object on the stack. 60 % 61 62 /Unbind { 63 0 index xcheck 64 1 index type /arraytype eq 65 2 index type /packedarraytype eq or and { 66 dup length array copy cvx 67 dup 0 exch { 68 dup type /operatortype eq { 69 ( ) cvs cvn cvx 70 } if 71 72 dup type /dicttype eq { 73 dup maxlength dict exch { 74 Unbind 75 3 copy put pop pop 76 } forall 77 } if 78 79 0 index xcheck 80 1 index type /arraytype eq 81 2 index type /packedarraytype eq or and { 82 Unbind 83 } if 84 85 3 copy put pop 86 1 add 87 } forall 88 pop 89 } if 90 } def 91 92 % 93 % New write operator - don't bind the definition! Expands tabs and backspaces, 94 % wraps long lines, and starts a new page whenever necessary. The code that 95 % handles newlines assumes lines are separated by one vertical unit. 96 % 97 98 /write { 99 true exch 100 101 %%case '\b': 102 dup 8#10 eq { 103 ( ) stringwidth pop neg 0 rmoveto 104 currentpoint pop 0 lt { 105 currentpoint exch pop 0 exch moveto 106 } if 107 exch pop false exch 108 } if 109 110 %%case '\t': 111 dup 8#11 eq { 112 currentpoint pop ( ) stringwidth pop div round cvi 113 8 mod 8 exch sub { 114 2 index 8#40 write 115 } repeat 116 exch pop false exch 117 } if 118 119 %%case '\n': 120 dup 8#12 eq { 121 currentpoint 0 exch 1 sub moveto pop 122 123 gsave clippath pathbbox pop pop exch pop grestore 124 currentpoint exch pop 1 sub ge { 125 2 index 8#14 write 126 } if 127 exch pop false exch 128 } if 129 130 %%case '\f': 131 dup 8#14 eq { 132 gsave showpage grestore 133 0 0 moveto 134 exch pop false exch 135 } if 136 137 %%case '\r': 138 dup 8#15 eq { 139 currentpoint 0 exch moveto pop 140 exch pop false exch 141 } if 142 143 %%case EOF: 144 dup -1 eq { 145 currentpoint 0 ne exch 0 ne or { 146 2 index 8#14 write 147 } if 148 exch pop false exch 149 } if 150 151 %%default: 152 exch { 153 dup 154 gsave clippath pathbbox pop 3 1 roll pop pop grestore 155 ( ) stringwidth pop currentpoint pop add le { 156 2 index 8#12 write 157 } if 158 ( ) dup 0 4 -1 roll put show 159 } if 160 161 pop % the character 162 pop % and file object 163 } def 164 165 % 166 % All the other file output operators call our redefined write operator. 167 % 168 169 /print { 170 (%stdout) (w) file exch {1 index exch write} forall 171 pop 172 } def 173 174 /writestring { 175 {1 index exch write} forall 176 pop 177 } def 178 179 /writehexstring { 180 (0123456789ABCDEF) 3 1 roll { 181 dup 182 3 index exch -4 bitshift 16#F and get 2 index exch write 183 2 index exch 16#F and get 1 index exch write 184 } forall 185 pop pop 186 } def 187 188 % 189 % Unbind and redefine the remaining file output procedures. 190 % 191 192 /= dup load Unbind def 193 /== dup load Unbind def 194 /stack dup load Unbind def 195 /pstack dup load Unbind def 196