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.
8 /GrabitDict 100 dict dup begin
11 /scratchstring 200 string def
17 /multiline 100 array def
23 counttomark {OmitNames exch true put} repeat pop
24 0 0 moveto % for hardcopy output
27 /OmitNames 30 dict def % ignore these names
28 /OtherDicts 200 dict def % unrecognized dictionaries
31 % All strings returned to the host go through Print. First pass through an
32 % array has lengthonly set to true.
36 dup type /stringtype ne {scratchstring cvs} if
38 length arraylength add /arraylength exch def
40 dup length column add /column exch def
42 slowdown {1 pop} repeat
46 /Indent {level {( ) Print} repeat} def
47 /Newline {(\n) Print lengthonly not {/column 0 def} if} def
49 /NextLevel {/level level 1 add def multiline level 0 put} def
50 /LastLevel {/level level 1 sub def} def
53 % Make a unique name for each unrecognized dictionary and remember the name
54 % and dictionary in OtherDicts.
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
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
76 1 index type /dicttype eq {pop true} if
77 1 index type /arraytype eq 2 index xcheck not and {pop true} if
80 [userdict systemdict statusdict serverdict OtherDicts] {
83 {exch pop exch pop cvx true exit}
94 % Simple type handlers. In some cases (e.g. savetype) what's returned can't
95 % be sent back through the interpreter.
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
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
118 multiline level get 1 eq {
119 scratchstring cvs cvn dup OperatorDict exch known {
120 OperatorDict exch get
121 OperatorProcs exch get exec
124 column lastcolumn gt {Newline Indent} if
130 % Executable names are passed to operatortype. Non-executable names get a
138 (/) Print Print ( ) Print
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.
150 /packedarraytype {arraytype} def
158 arraylength 20 gt arraylength column add lastcolumn gt and {
159 multiline level 1 put
161 /lengthonly false def
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
174 dup type /dicttype eq {
176 dup type /dicttype eq {
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
193 multiline level get 0 ne {Newline LastLevel Indent NextLevel} if
194 xcheck {(} )}{(] )} ifelse Print
200 % Dictionary handler. Try to replace the value by a name before processing
207 (-dictionary- ) Print pop
209 dup maxlength Print ( dict dup begin) Print Newline
212 1 index OmitNames exch known {
216 Replace % arrays and dicts by known names
217 Register % new dictionaries in OtherDicts
219 cvlit dup type exec % key first - force a /
220 dup type exec % then the value
231 % Strings containing characters not in AsciiDict are returned in hex. All
232 % others are ASCII strings and use AsciiDict for character mapping.
235 /onecharstring ( ) def
236 /twocharstring ( ) def
245 onecharstring 0 3 -1 roll put
246 AsciiDict onecharstring cvn known not {
251 hexit {(<)}{(\()} ifelse Print
252 0 1 2 index length 1 sub {
253 2 copy 1 getinterval exch pop
256 n -4 bitshift 16#F and 16 twocharstring cvrs pop
257 n 16#F and twocharstring 1 1 getinterval 16 exch cvrs pop
259 }{cvn AsciiDict exch get} ifelse
261 column lastcolumn gt {
262 hexit not {(\\) Print} if
266 hexit {(> )}{(\) )} ifelse Print
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.
277 /AsciiDict 128 dict dup begin
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.
388 /OperatorProcs [{} {Newline Indent}] def
390 /OperatorDict 250 dict def
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
501 % Put an object on the stack and call Grabit. Output continues until stack
502 % is empty. For example,
504 % /letter load Grabit
506 % prints a listing of the letter procedure.
514 count {dup type exec} repeat
518 currentpoint % for hardcopy output