tgrabit.ps - plan9port - [fork] Plan 9 from user space
(HTM) git clone git://src.adamsgaard.dk/plan9port
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
tgrabit.ps (12401B)
---
1 %
2 % Dump a PostScript object, occasionally in a form that can be sent back
3 % through the interpreter. Similiar to Adobe's == procedure, but output
4 % is usually easier to read. No binding so operators like rcheck and exec
5 % can be conviently redefined.
6 %
7
8 /GrabitDict 100 dict dup begin
9
10 /recursive true def
11 /scratchstring 200 string def
12 /slowdown 100 def
13
14 /column 0 def
15 /lastcolumn 80 def
16 /level 0 def
17 /multiline 100 array def
18 /nextname 0 def
19 /arraylength 0 def
20 /lengthonly false def
21
22 /GrabitSetup {
23 counttomark {OmitNames exch true put} repeat pop
24 0 0 moveto % for hardcopy output
25 } def
26
27 /OmitNames 30 dict def % ignore these names
28 /OtherDicts 200 dict def % unrecognized dictionaries
29
30 %
31 % All strings returned to the host go through Print. First pass through an
32 % array has lengthonly set to true.
33 %
34
35 /Print {
36 dup type /stringtype ne {scratchstring cvs} if
37 lengthonly {
38 length arraylength add /arraylength exch def
39 }{
40 dup length column add /column exch def
41 print flush
42 slowdown {1 pop} repeat
43 } ifelse
44 } def
45
46 /Indent {level {( ) Print} repeat} def
47 /Newline {(\n) Print lengthonly not {/column 0 def} if} def
48
49 /NextLevel {/level level 1 add def multiline level 0 put} def
50 /LastLevel {/level level 1 sub def} def
51
52 %
53 % Make a unique name for each unrecognized dictionary and remember the name
54 % and dictionary in OtherDicts.
55 %
56
57 /Register {
58 dup type /dicttype eq {
59 /nextname nextname 1 add def
60 dup (UnknownDict ) dup
61 (UnknownDict) length nextname ( ) cvs putinterval
62 0 (UnknownDict) length nextname ( ) cvs length add getinterval cvn
63 exch OtherDicts 3 1 roll put
64 } if
65 } def
66
67 %
68 % Replace array or dictionary values by known names. Lookups are in the
69 % standard PostScript dictionaries and in OtherDicts. If found replace
70 % the value by the name and make it executable so nametype omits the
71 % leading /.
72 %
73
74 /Replace {
75 false
76 1 index type /dicttype eq {pop true} if
77 1 index type /arraytype eq 2 index xcheck not and {pop true} if
78 {
79 false
80 [userdict systemdict statusdict serverdict OtherDicts] {
81 {
82 3 index eq
83 {exch pop exch pop cvx true exit}
84 {pop}
85 ifelse
86 } forall
87 dup {exit} if
88 } forall
89 pop
90 } if
91 } def
92
93 %
94 % Simple type handlers. In some cases (e.g. savetype) what's returned can't
95 % be sent back through the interpreter.
96 %
97
98 /booleantype {{(true )}{(false )} ifelse Print} def
99 /marktype {pop (mark ) Print} def
100 /nulltype {pop (null ) Print} def
101 /integertype {Print ( ) Print} def
102 /realtype {Print ( ) Print} def
103 /filetype {pop (-file- ) Print} def
104 /fonttype {pop (-fontID- ) Print} def
105 /savetype {pop (-saveobj- ) Print} def
106
107 %
108 % Special formatting for operators is enabled if the flag in multiline
109 % (for the current level) is set to 1. In that case each operator, after
110 % being printed, is looked up in OperatorDict. If found the value is used
111 % as an index into the OperatorProcs array and the object at that index
112 % is retrieved and executed. Currently only used to choose the operators
113 % that end a line.
114 %
115
116 /operatortype {
117 dup Print ( ) Print
118 multiline level get 1 eq {
119 scratchstring cvs cvn dup OperatorDict exch known {
120 OperatorDict exch get
121 OperatorProcs exch get exec
122 }{
123 pop
124 column lastcolumn gt {Newline Indent} if
125 } ifelse
126 }{pop} ifelse
127 } def
128
129 %
130 % Executable names are passed to operatortype. Non-executable names get a
131 % leading /.
132 %
133
134 /nametype {
135 dup xcheck {
136 operatortype
137 }{
138 (/) Print Print ( ) Print
139 } ifelse
140 } def
141
142 %
143 % Arrays are processed in two passes. The first computes the length of the
144 % string returned to the host without any special formatting. If it extends
145 % past the last column special formatting is enabled by setting a flag in
146 % array multiline. Arrays are processed in a for loop so the last element
147 % easily recognized. At that point special fortmatting is disabled.
148 %
149
150 /packedarraytype {arraytype} def
151
152 /arraytype {
153 NextLevel
154 lengthonly not {
155 /lengthonly true def
156 /arraylength 0 def
157 dup dup type exec
158 arraylength 20 gt arraylength column add lastcolumn gt and {
159 multiline level 1 put
160 } if
161 /lengthonly false def
162 } if
163
164 dup rcheck not {
165 (-array- ) Print pop
166 }{
167 dup xcheck {({)}{([)} ifelse Print
168 multiline level get 0 ne {Newline Indent}{( ) Print} ifelse
169 0 1 2 index length 1 sub {
170 2 copy exch length 1 sub eq multiline level get 1 eq and {
171 multiline level 2 put
172 } if
173 2 copy get exch pop
174 dup type /dicttype eq {
175 Replace
176 dup type /dicttype eq {
177 dup Register Replace
178 recursive {
179 2 copy cvlit
180 /def load 3 1 roll
181 count 3 roll
182 } if
183 exch pop
184 } if
185 } if
186 dup type exec
187 dup xcheck not multiline level get 1 eq and {
188 0 index type /arraytype eq
189 1 index type /packedarray eq or
190 1 index type /stringtype eq or {Newline Indent} if
191 } if
192 } for
193 multiline level get 0 ne {Newline LastLevel Indent NextLevel} if
194 xcheck {(} )}{(] )} ifelse Print
195 } ifelse
196 LastLevel
197 } def
198
199 %
200 % Dictionary handler. Try to replace the value by a name before processing
201 % the dictionary.
202 %
203
204 /dicttype {
205 dup
206 rcheck not {
207 (-dictionary- ) Print pop
208 }{
209 dup maxlength Print ( dict dup begin) Print Newline
210 NextLevel
211 {
212 1 index OmitNames exch known {
213 pop pop
214 }{
215 Indent
216 Replace % arrays and dicts by known names
217 Register % new dictionaries in OtherDicts
218 exch
219 cvlit dup type exec % key first - force a /
220 dup type exec % then the value
221 (def) Print Newline
222 } ifelse
223 } forall
224 LastLevel
225 Indent
226 (end ) Print
227 } ifelse
228 } def
229
230 %
231 % Strings containing characters not in AsciiDict are returned in hex. All
232 % others are ASCII strings and use AsciiDict for character mapping.
233 %
234
235 /onecharstring ( ) def
236 /twocharstring ( ) def
237
238 /stringtype {
239 dup
240 rcheck not {
241 (-string- ) Print
242 }{
243 /hexit false def
244 dup {
245 onecharstring 0 3 -1 roll put
246 AsciiDict onecharstring cvn known not {
247 /hexit true def exit
248 } if
249 } forall
250
251 hexit {(<)}{(\()} ifelse Print
252 0 1 2 index length 1 sub {
253 2 copy 1 getinterval exch pop
254 hexit {
255 0 get /n exch def
256 n -4 bitshift 16#F and 16 twocharstring cvrs pop
257 n 16#F and twocharstring 1 1 getinterval 16 exch cvrs pop
258 twocharstring
259 }{cvn AsciiDict exch get} ifelse
260 Print
261 column lastcolumn gt {
262 hexit not {(\\) Print} if
263 Newline
264 } if
265 } for
266 hexit {(> )}{(\) )} ifelse Print
267 } ifelse
268 pop
269 } def
270
271 %
272 % ASCII characters and replacement strings. Ensures the returned string will
273 % reproduce the original when passed through the scanner. Strings containing
274 % characters not in this list should be returned as hex strings.
275 %
276
277 /AsciiDict 128 dict dup begin
278 (\n) cvn (\\n) def
279 (\r) cvn (\\r) def
280 (\t) cvn (\\t) def
281 (\b) cvn (\\b) def
282 (\f) cvn (\\f) def
283 ( ) cvn ( ) def
284 (!) cvn (!) def
285 (") cvn (") def
286 (#) cvn (#) def
287 ($) cvn ($) def
288 (%) cvn (\\%) def
289 (&) cvn (&) def
290 (') cvn (') def
291 (\() cvn (\\\() def
292 (\)) cvn (\\\)) def
293 (*) cvn (*) def
294 (+) cvn (+) def
295 (,) cvn (,) def
296 (-) cvn (-) def
297 (.) cvn (.) def
298 (/) cvn (/) def
299 (0) cvn (0) def
300 (1) cvn (1) def
301 (2) cvn (2) def
302 (3) cvn (3) def
303 (4) cvn (4) def
304 (5) cvn (5) def
305 (6) cvn (6) def
306 (7) cvn (7) def
307 (8) cvn (8) def
308 (9) cvn (9) def
309 (:) cvn (:) def
310 (;) cvn (;) def
311 (<) cvn (<) def
312 (=) cvn (=) def
313 (>) cvn (>) def
314 (?) cvn (?) def
315 (@) cvn (@) def
316 (A) cvn (A) def
317 (B) cvn (B) def
318 (C) cvn (C) def
319 (D) cvn (D) def
320 (E) cvn (E) def
321 (F) cvn (F) def
322 (G) cvn (G) def
323 (H) cvn (H) def
324 (I) cvn (I) def
325 (J) cvn (J) def
326 (K) cvn (K) def
327 (L) cvn (L) def
328 (M) cvn (M) def
329 (N) cvn (N) def
330 (O) cvn (O) def
331 (P) cvn (P) def
332 (Q) cvn (Q) def
333 (R) cvn (R) def
334 (S) cvn (S) def
335 (T) cvn (T) def
336 (U) cvn (U) def
337 (V) cvn (V) def
338 (W) cvn (W) def
339 (X) cvn (X) def
340 (Y) cvn (Y) def
341 (Z) cvn (Z) def
342 ([) cvn ([) def
343 (\\) cvn (\\\\) def
344 (]) cvn (]) def
345 (^) cvn (^) def
346 (_) cvn (_) def
347 (`) cvn (`) def
348 (a) cvn (a) def
349 (b) cvn (b) def
350 (c) cvn (c) def
351 (d) cvn (d) def
352 (e) cvn (e) def
353 (f) cvn (f) def
354 (g) cvn (g) def
355 (h) cvn (h) def
356 (i) cvn (i) def
357 (j) cvn (j) def
358 (k) cvn (k) def
359 (l) cvn (l) def
360 (m) cvn (m) def
361 (n) cvn (n) def
362 (o) cvn (o) def
363 (p) cvn (p) def
364 (q) cvn (q) def
365 (r) cvn (r) def
366 (s) cvn (s) def
367 (t) cvn (t) def
368 (u) cvn (u) def
369 (v) cvn (v) def
370 (w) cvn (w) def
371 (x) cvn (x) def
372 (y) cvn (y) def
373 (z) cvn (z) def
374 ({) cvn ({) def
375 (|) cvn (|) def
376 (}) cvn (}) def
377 (~) cvn (~) def
378 end def
379
380 %
381 % OperatorDict can help format procedure listings. The value assigned to each
382 % name is used as an index into the OperatorProcs array. The procedure at that
383 % index is fetched and executed after the named operator is printed. What's in
384 % OperatorDict is a matter of taste rather than correctness. The default list
385 % represents our choice of which of Adobe's operators should end a line.
386 %
387
388 /OperatorProcs [{} {Newline Indent}] def
389
390 /OperatorDict 250 dict def
391
392 OperatorDict /arc 1 put
393 OperatorDict /arcn 1 put
394 OperatorDict /ashow 1 put
395 OperatorDict /awidthshow 1 put
396 OperatorDict /banddevice 1 put
397 OperatorDict /begin 1 put
398 OperatorDict /charpath 1 put
399 OperatorDict /clear 1 put
400 OperatorDict /cleardictstack 1 put
401 OperatorDict /cleartomark 1 put
402 OperatorDict /clip 1 put
403 OperatorDict /clippath 1 put
404 OperatorDict /closefile 1 put
405 OperatorDict /closepath 1 put
406 OperatorDict /concat 1 put
407 OperatorDict /copypage 1 put
408 OperatorDict /curveto 1 put
409 OperatorDict /def 1 put
410 OperatorDict /end 1 put
411 OperatorDict /eoclip 1 put
412 OperatorDict /eofill 1 put
413 OperatorDict /erasepage 1 put
414 OperatorDict /exec 1 put
415 OperatorDict /exit 1 put
416 OperatorDict /fill 1 put
417 OperatorDict /flattenpath 1 put
418 OperatorDict /flush 1 put
419 OperatorDict /flushfile 1 put
420 OperatorDict /for 1 put
421 OperatorDict /forall 1 put
422 OperatorDict /framedevice 1 put
423 OperatorDict /grestore 1 put
424 OperatorDict /grestoreall 1 put
425 OperatorDict /gsave 1 put
426 OperatorDict /handleerror 1 put
427 OperatorDict /if 1 put
428 OperatorDict /ifelse 1 put
429 OperatorDict /image 1 put
430 OperatorDict /imagemask 1 put
431 OperatorDict /initclip 1 put
432 OperatorDict /initgraphics 1 put
433 OperatorDict /initmatrix 1 put
434 OperatorDict /kshow 1 put
435 OperatorDict /lineto 1 put
436 OperatorDict /loop 1 put
437 OperatorDict /moveto 1 put
438 OperatorDict /newpath 1 put
439 OperatorDict /nulldevice 1 put
440 OperatorDict /pathforall 1 put
441 OperatorDict /print 1 put
442 OperatorDict /prompt 1 put
443 OperatorDict /put 1 put
444 OperatorDict /putinterval 1 put
445 OperatorDict /quit 1 put
446 OperatorDict /rcurveto 1 put
447 OperatorDict /renderbands 1 put
448 OperatorDict /repeat 1 put
449 OperatorDict /resetfile 1 put
450 OperatorDict /restore 1 put
451 OperatorDict /reversepath 1 put
452 OperatorDict /rlineto 1 put
453 OperatorDict /rmoveto 1 put
454 OperatorDict /rotate 1 put
455 OperatorDict /run 1 put
456 OperatorDict /scale 1 put
457 OperatorDict /setcachedevice 1 put
458 OperatorDict /setcachelimit 1 put
459 OperatorDict /setcacheparams 1 put
460 OperatorDict /setcharwidth 1 put
461 OperatorDict /setdash 1 put
462 OperatorDict /setdefaulttimeouts 1 put
463 OperatorDict /setdostartpage 1 put
464 OperatorDict /seteescratch 1 put
465 OperatorDict /setflat 1 put
466 OperatorDict /setfont 1 put
467 OperatorDict /setgray 1 put
468 OperatorDict /sethsbcolor 1 put
469 OperatorDict /setidlefonts 1 put
470 OperatorDict /setjobtimeout 1 put
471 OperatorDict /setlinecap 1 put
472 OperatorDict /setlinejoin 1 put
473 OperatorDict /setlinewidth 1 put
474 OperatorDict /setmargins 1 put
475 OperatorDict /setmatrix 1 put
476 OperatorDict /setmiterlimit 1 put
477 OperatorDict /setpacking 1 put
478 OperatorDict /setpagetype 1 put
479 OperatorDict /setprintname 1 put
480 OperatorDict /setrgbcolor 1 put
481 OperatorDict /setsccbatch 1 put
482 OperatorDict /setsccinteractive 1 put
483 OperatorDict /setscreen 1 put
484 OperatorDict /settransfer 1 put
485 OperatorDict /show 1 put
486 OperatorDict /showpage 1 put
487 OperatorDict /start 1 put
488 OperatorDict /stop 1 put
489 OperatorDict /store 1 put
490 OperatorDict /stroke 1 put
491 OperatorDict /strokepath 1 put
492 OperatorDict /translate 1 put
493 OperatorDict /widthshow 1 put
494 OperatorDict /write 1 put
495 OperatorDict /writehexstring 1 put
496 OperatorDict /writestring 1 put
497
498 end def
499
500 %
501 % Put an object on the stack and call Grabit. Output continues until stack
502 % is empty. For example,
503 %
504 % /letter load Grabit
505 %
506 % prints a listing of the letter procedure.
507 %
508
509 /Grabit {
510 /saveobj save def
511 GrabitDict begin
512 {
513 count 0 eq {exit} if
514 count {dup type exec} repeat
515 (\n) print flush
516 } loop
517 end
518 currentpoint % for hardcopy output
519 saveobj restore
520 moveto
521 } def
522