522 lines
12 KiB
PostScript
522 lines
12 KiB
PostScript
%
|
|
% 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
|
|
|