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