| % |
| % Dump a PostScript object, occasionally in a form that can be sent back |
| % through the interpreter. Similiar to Adobe's == procedure, but output |
| % is usually easier to read. No binding so operators like rcheck and exec |
| % can be conviently redefined. |
| % |
| |
| /GrabitDict 100 dict dup begin |
| |
| /recursive true def |
| /scratchstring 200 string def |
| /slowdown 100 def |
| |
| /column 0 def |
| /lastcolumn 80 def |
| /level 0 def |
| /multiline 100 array def |
| /nextname 0 def |
| /arraylength 0 def |
| /lengthonly false def |
| |
| /GrabitSetup { |
| counttomark {OmitNames exch true put} repeat pop |
| 0 0 moveto % for hardcopy output |
| } def |
| |
| /OmitNames 30 dict def % ignore these names |
| /OtherDicts 200 dict def % unrecognized dictionaries |
| |
| % |
| % All strings returned to the host go through Print. First pass through an |
| % array has lengthonly set to true. |
| % |
| |
| /Print { |
| dup type /stringtype ne {scratchstring cvs} if |
| lengthonly { |
| length arraylength add /arraylength exch def |
| }{ |
| dup length column add /column exch def |
| print flush |
| slowdown {1 pop} repeat |
| } ifelse |
| } def |
| |
| /Indent {level {( ) Print} repeat} def |
| /Newline {(\n) Print lengthonly not {/column 0 def} if} def |
| |
| /NextLevel {/level level 1 add def multiline level 0 put} def |
| /LastLevel {/level level 1 sub def} def |
| |
| % |
| % Make a unique name for each unrecognized dictionary and remember the name |
| % and dictionary in OtherDicts. |
| % |
| |
| /Register { |
| dup type /dicttype eq { |
| /nextname nextname 1 add def |
| dup (UnknownDict ) dup |
| (UnknownDict) length nextname ( ) cvs putinterval |
| 0 (UnknownDict) length nextname ( ) cvs length add getinterval cvn |
| exch OtherDicts 3 1 roll put |
| } if |
| } def |
| |
| % |
| % Replace array or dictionary values by known names. Lookups are in the |
| % standard PostScript dictionaries and in OtherDicts. If found replace |
| % the value by the name and make it executable so nametype omits the |
| % leading /. |
| % |
| |
| /Replace { |
| false |
| 1 index type /dicttype eq {pop true} if |
| 1 index type /arraytype eq 2 index xcheck not and {pop true} if |
| { |
| false |
| [userdict systemdict statusdict serverdict OtherDicts] { |
| { |
| 3 index eq |
| {exch pop exch pop cvx true exit} |
| {pop} |
| ifelse |
| } forall |
| dup {exit} if |
| } forall |
| pop |
| } if |
| } def |
| |
| % |
| % Simple type handlers. In some cases (e.g. savetype) what's returned can't |
| % be sent back through the interpreter. |
| % |
| |
| /booleantype {{(true )}{(false )} ifelse Print} def |
| /marktype {pop (mark ) Print} def |
| /nulltype {pop (null ) Print} def |
| /integertype {Print ( ) Print} def |
| /realtype {Print ( ) Print} def |
| /filetype {pop (-file- ) Print} def |
| /fonttype {pop (-fontID- ) Print} def |
| /savetype {pop (-saveobj- ) Print} def |
| |
| % |
| % Special formatting for operators is enabled if the flag in multiline |
| % (for the current level) is set to 1. In that case each operator, after |
| % being printed, is looked up in OperatorDict. If found the value is used |
| % as an index into the OperatorProcs array and the object at that index |
| % is retrieved and executed. Currently only used to choose the operators |
| % that end a line. |
| % |
| |
| /operatortype { |
| dup Print ( ) Print |
| multiline level get 1 eq { |
| scratchstring cvs cvn dup OperatorDict exch known { |
| OperatorDict exch get |
| OperatorProcs exch get exec |
| }{ |
| pop |
| column lastcolumn gt {Newline Indent} if |
| } ifelse |
| }{pop} ifelse |
| } def |
| |
| % |
| % Executable names are passed to operatortype. Non-executable names get a |
| % leading /. |
| % |
| |
| /nametype { |
| dup xcheck { |
| operatortype |
| }{ |
| (/) Print Print ( ) Print |
| } ifelse |
| } def |
| |
| % |
| % Arrays are processed in two passes. The first computes the length of the |
| % string returned to the host without any special formatting. If it extends |
| % past the last column special formatting is enabled by setting a flag in |
| % array multiline. Arrays are processed in a for loop so the last element |
| % easily recognized. At that point special fortmatting is disabled. |
| % |
| |
| /packedarraytype {arraytype} def |
| |
| /arraytype { |
| NextLevel |
| lengthonly not { |
| /lengthonly true def |
| /arraylength 0 def |
| dup dup type exec |
| arraylength 20 gt arraylength column add lastcolumn gt and { |
| multiline level 1 put |
| } if |
| /lengthonly false def |
| } if |
| |
| dup rcheck not { |
| (-array- ) Print pop |
| }{ |
| dup xcheck {({)}{([)} ifelse Print |
| multiline level get 0 ne {Newline Indent}{( ) Print} ifelse |
| 0 1 2 index length 1 sub { |
| 2 copy exch length 1 sub eq multiline level get 1 eq and { |
| multiline level 2 put |
| } if |
| 2 copy get exch pop |
| dup type /dicttype eq { |
| Replace |
| dup type /dicttype eq { |
| dup Register Replace |
| recursive { |
| 2 copy cvlit |
| /def load 3 1 roll |
| count 3 roll |
| } if |
| exch pop |
| } if |
| } if |
| dup type exec |
| dup xcheck not multiline level get 1 eq and { |
| 0 index type /arraytype eq |
| 1 index type /packedarray eq or |
| 1 index type /stringtype eq or {Newline Indent} if |
| } if |
| } for |
| multiline level get 0 ne {Newline LastLevel Indent NextLevel} if |
| xcheck {(} )}{(] )} ifelse Print |
| } ifelse |
| LastLevel |
| } def |
| |
| % |
| % Dictionary handler. Try to replace the value by a name before processing |
| % the dictionary. |
| % |
| |
| /dicttype { |
| dup |
| rcheck not { |
| (-dictionary- ) Print pop |
| }{ |
| dup maxlength Print ( dict dup begin) Print Newline |
| NextLevel |
| { |
| 1 index OmitNames exch known { |
| pop pop |
| }{ |
| Indent |
| Replace % arrays and dicts by known names |
| Register % new dictionaries in OtherDicts |
| exch |
| cvlit dup type exec % key first - force a / |
| dup type exec % then the value |
| (def) Print Newline |
| } ifelse |
| } forall |
| LastLevel |
| Indent |
| (end ) Print |
| } ifelse |
| } def |
| |
| % |
| % Strings containing characters not in AsciiDict are returned in hex. All |
| % others are ASCII strings and use AsciiDict for character mapping. |
| % |
| |
| /onecharstring ( ) def |
| /twocharstring ( ) def |
| |
| /stringtype { |
| dup |
| rcheck not { |
| (-string- ) Print |
| }{ |
| /hexit false def |
| dup { |
| onecharstring 0 3 -1 roll put |
| AsciiDict onecharstring cvn known not { |
| /hexit true def exit |
| } if |
| } forall |
| |
| hexit {(<)}{(\()} ifelse Print |
| 0 1 2 index length 1 sub { |
| 2 copy 1 getinterval exch pop |
| hexit { |
| 0 get /n exch def |
| n -4 bitshift 16#F and 16 twocharstring cvrs pop |
| n 16#F and twocharstring 1 1 getinterval 16 exch cvrs pop |
| twocharstring |
| }{cvn AsciiDict exch get} ifelse |
| Print |
| column lastcolumn gt { |
| hexit not {(\\) Print} if |
| Newline |
| } if |
| } for |
| hexit {(> )}{(\) )} ifelse Print |
| } ifelse |
| pop |
| } def |
| |
| % |
| % ASCII characters and replacement strings. Ensures the returned string will |
| % reproduce the original when passed through the scanner. Strings containing |
| % characters not in this list should be returned as hex strings. |
| % |
| |
| /AsciiDict 128 dict dup begin |
| (\n) cvn (\\n) def |
| (\r) cvn (\\r) def |
| (\t) cvn (\\t) def |
| (\b) cvn (\\b) def |
| (\f) cvn (\\f) def |
| ( ) cvn ( ) def |
| (!) cvn (!) def |
| (") cvn (") def |
| (#) cvn (#) def |
| ($) cvn ($) def |
| (%) cvn (\\%) def |
| (&) cvn (&) def |
| (') cvn (') def |
| (\() cvn (\\\() def |
| (\)) cvn (\\\)) def |
| (*) cvn (*) def |
| (+) cvn (+) def |
| (,) cvn (,) def |
| (-) cvn (-) def |
| (.) cvn (.) def |
| (/) cvn (/) def |
| (0) cvn (0) def |
| (1) cvn (1) def |
| (2) cvn (2) def |
| (3) cvn (3) def |
| (4) cvn (4) def |
| (5) cvn (5) def |
| (6) cvn (6) def |
| (7) cvn (7) def |
| (8) cvn (8) def |
| (9) cvn (9) def |
| (:) cvn (:) def |
| (;) cvn (;) def |
| (<) cvn (<) def |
| (=) cvn (=) def |
| (>) cvn (>) def |
| (?) cvn (?) def |
| (@) cvn (@) def |
| (A) cvn (A) def |
| (B) cvn (B) def |
| (C) cvn (C) def |
| (D) cvn (D) def |
| (E) cvn (E) def |
| (F) cvn (F) def |
| (G) cvn (G) def |
| (H) cvn (H) def |
| (I) cvn (I) def |
| (J) cvn (J) def |
| (K) cvn (K) def |
| (L) cvn (L) def |
| (M) cvn (M) def |
| (N) cvn (N) def |
| (O) cvn (O) def |
| (P) cvn (P) def |
| (Q) cvn (Q) def |
| (R) cvn (R) def |
| (S) cvn (S) def |
| (T) cvn (T) def |
| (U) cvn (U) def |
| (V) cvn (V) def |
| (W) cvn (W) def |
| (X) cvn (X) def |
| (Y) cvn (Y) def |
| (Z) cvn (Z) def |
| ([) cvn ([) def |
| (\\) cvn (\\\\) def |
| (]) cvn (]) def |
| (^) cvn (^) def |
| (_) cvn (_) def |
| (`) cvn (`) def |
| (a) cvn (a) def |
| (b) cvn (b) def |
| (c) cvn (c) def |
| (d) cvn (d) def |
| (e) cvn (e) def |
| (f) cvn (f) def |
| (g) cvn (g) def |
| (h) cvn (h) def |
| (i) cvn (i) def |
| (j) cvn (j) def |
| (k) cvn (k) def |
| (l) cvn (l) def |
| (m) cvn (m) def |
| (n) cvn (n) def |
| (o) cvn (o) def |
| (p) cvn (p) def |
| (q) cvn (q) def |
| (r) cvn (r) def |
| (s) cvn (s) def |
| (t) cvn (t) def |
| (u) cvn (u) def |
| (v) cvn (v) def |
| (w) cvn (w) def |
| (x) cvn (x) def |
| (y) cvn (y) def |
| (z) cvn (z) def |
| ({) cvn ({) def |
| (|) cvn (|) def |
| (}) cvn (}) def |
| (~) cvn (~) def |
| end def |
| |
| % |
| % OperatorDict can help format procedure listings. The value assigned to each |
| % name is used as an index into the OperatorProcs array. The procedure at that |
| % index is fetched and executed after the named operator is printed. What's in |
| % OperatorDict is a matter of taste rather than correctness. The default list |
| % represents our choice of which of Adobe's operators should end a line. |
| % |
| |
| /OperatorProcs [{} {Newline Indent}] def |
| |
| /OperatorDict 250 dict def |
| |
| OperatorDict /arc 1 put |
| OperatorDict /arcn 1 put |
| OperatorDict /ashow 1 put |
| OperatorDict /awidthshow 1 put |
| OperatorDict /banddevice 1 put |
| OperatorDict /begin 1 put |
| OperatorDict /charpath 1 put |
| OperatorDict /clear 1 put |
| OperatorDict /cleardictstack 1 put |
| OperatorDict /cleartomark 1 put |
| OperatorDict /clip 1 put |
| OperatorDict /clippath 1 put |
| OperatorDict /closefile 1 put |
| OperatorDict /closepath 1 put |
| OperatorDict /concat 1 put |
| OperatorDict /copypage 1 put |
| OperatorDict /curveto 1 put |
| OperatorDict /def 1 put |
| OperatorDict /end 1 put |
| OperatorDict /eoclip 1 put |
| OperatorDict /eofill 1 put |
| OperatorDict /erasepage 1 put |
| OperatorDict /exec 1 put |
| OperatorDict /exit 1 put |
| OperatorDict /fill 1 put |
| OperatorDict /flattenpath 1 put |
| OperatorDict /flush 1 put |
| OperatorDict /flushfile 1 put |
| OperatorDict /for 1 put |
| OperatorDict /forall 1 put |
| OperatorDict /framedevice 1 put |
| OperatorDict /grestore 1 put |
| OperatorDict /grestoreall 1 put |
| OperatorDict /gsave 1 put |
| OperatorDict /handleerror 1 put |
| OperatorDict /if 1 put |
| OperatorDict /ifelse 1 put |
| OperatorDict /image 1 put |
| OperatorDict /imagemask 1 put |
| OperatorDict /initclip 1 put |
| OperatorDict /initgraphics 1 put |
| OperatorDict /initmatrix 1 put |
| OperatorDict /kshow 1 put |
| OperatorDict /lineto 1 put |
| OperatorDict /loop 1 put |
| OperatorDict /moveto 1 put |
| OperatorDict /newpath 1 put |
| OperatorDict /nulldevice 1 put |
| OperatorDict /pathforall 1 put |
| OperatorDict /print 1 put |
| OperatorDict /prompt 1 put |
| OperatorDict /put 1 put |
| OperatorDict /putinterval 1 put |
| OperatorDict /quit 1 put |
| OperatorDict /rcurveto 1 put |
| OperatorDict /renderbands 1 put |
| OperatorDict /repeat 1 put |
| OperatorDict /resetfile 1 put |
| OperatorDict /restore 1 put |
| OperatorDict /reversepath 1 put |
| OperatorDict /rlineto 1 put |
| OperatorDict /rmoveto 1 put |
| OperatorDict /rotate 1 put |
| OperatorDict /run 1 put |
| OperatorDict /scale 1 put |
| OperatorDict /setcachedevice 1 put |
| OperatorDict /setcachelimit 1 put |
| OperatorDict /setcacheparams 1 put |
| OperatorDict /setcharwidth 1 put |
| OperatorDict /setdash 1 put |
| OperatorDict /setdefaulttimeouts 1 put |
| OperatorDict /setdostartpage 1 put |
| OperatorDict /seteescratch 1 put |
| OperatorDict /setflat 1 put |
| OperatorDict /setfont 1 put |
| OperatorDict /setgray 1 put |
| OperatorDict /sethsbcolor 1 put |
| OperatorDict /setidlefonts 1 put |
| OperatorDict /setjobtimeout 1 put |
| OperatorDict /setlinecap 1 put |
| OperatorDict /setlinejoin 1 put |
| OperatorDict /setlinewidth 1 put |
| OperatorDict /setmargins 1 put |
| OperatorDict /setmatrix 1 put |
| OperatorDict /setmiterlimit 1 put |
| OperatorDict /setpacking 1 put |
| OperatorDict /setpagetype 1 put |
| OperatorDict /setprintname 1 put |
| OperatorDict /setrgbcolor 1 put |
| OperatorDict /setsccbatch 1 put |
| OperatorDict /setsccinteractive 1 put |
| OperatorDict /setscreen 1 put |
| OperatorDict /settransfer 1 put |
| OperatorDict /show 1 put |
| OperatorDict /showpage 1 put |
| OperatorDict /start 1 put |
| OperatorDict /stop 1 put |
| OperatorDict /store 1 put |
| OperatorDict /stroke 1 put |
| OperatorDict /strokepath 1 put |
| OperatorDict /translate 1 put |
| OperatorDict /widthshow 1 put |
| OperatorDict /write 1 put |
| OperatorDict /writehexstring 1 put |
| OperatorDict /writestring 1 put |
| |
| end def |
| |
| % |
| % Put an object on the stack and call Grabit. Output continues until stack |
| % is empty. For example, |
| % |
| % /letter load Grabit |
| % |
| % prints a listing of the letter procedure. |
| % |
| |
| /Grabit { |
| /saveobj save def |
| GrabitDict begin |
| { |
| count 0 eq {exit} if |
| count {dup type exec} repeat |
| (\n) print flush |
| } loop |
| end |
| currentpoint % for hardcopy output |
| saveobj restore |
| moveto |
| } def |
| |
