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