stephenf@softway.oz (Stephen Frede) (05/29/88)
Below is the definition of an "===" operator for PostScript, that
is essentially an enhanced version of "==". It will recursively
print the contents of dictionaries, avoiding infinite loops.
Very useful for seeing how some of the PostScript operators (eg "==")
are defined, and otherwise poking around the system dictionaries.
- Stephen Frede
Softway Pty Ltd, P.O. Box 305, Strawberry Hills, NSW 2012, AUSTRALIA
Phone: +61 2 698 2322; Fax: +61 2 699 9174; Telex: AA27987
ACSnet: stephenf@softway.oz UUCP: ...!uunet!softway.oz!stephenf
-----------------------------------------------------------------------
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: README list.ps tst1 tst1.out tst2
# Wrapped by stephenf@softway on Sun May 29 21:00:19 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(3276 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
It is a possibly little-known, but interesting fact that many
of the PostScript built-in operators, are themselves just PostScript
defined routines. It can be very instructive looking at the
definition of these routines, and otherwise poking around the
dictionaries in general. As an aid to doing this poking around,
I wrote the routine below. It is a somewhat enhanced version of
the "==" operator. It behaves normally for simple objects, but
when a dictionary is given as an argument, it recursively prints
out the entire contents of the dictionary. This isn't quite as
simple as it sounds, because a dictionary object is just a pointer,
and quite often a dictionary can be found referenced, directly
or indirectly, within itself. To avoid infinite loops, a separate
internal dictionary is kept of those dictionaries which have
been viewed previously. The same is done with arrays.
When a dictionary or array is printed for the first time, a
reference number in angle brackets will appear, like so:
X
X -dictionary-<=1>
X ...
X
When the dictionary is referenced again, the same number will appear
in angle brackets, but without the '=' sign, and without the
dictionary contents being listed again. See tst1 and tst1.out for
example input and output.
X
When I first did this, I found that much of the volume of output
consisted of the character strings and encoding vectors of the fonts.
This is fairly uninteresting (especially when the same thing is
repeated many times), so I added a check for uninteresting
components of dictionaries. These can be easily altered to suit.
X
I put this together about 2 years ago, and have committed the sin of
tidying it up a bit before posting it. I have tested it again fairly
thoroughly, so it should be ok. One thing I added was lots of comments
X(ie lots more - I do comment as I go), so this might be used as an
instructional example of using some of the non-graphic oriented
PostScript operators. My original version had some stuff that may have
been LaserWriter specific. The code here uses only documented
operators. Note that no output is produced on paper (your spooler has
an option to capture output and have it mailed back to you of course?).
A fairly simple mod to the "pr" and "nlprint" routines should get you
hardcopy if you want it.
X
Try running a simple test first:
X
X cat list.ps tst1 | lp -dalw -ov # (or whatever)
X
The output should be identical to what appears in the file tst1.out.
When that works, you can be more adventurous and try:
X
X cat list.ps tst2 | lp -dalw -ov # (or whatever)
X
The complete output (including all the boring font stuff)
is just under 10000 lines, 1/2 megabyte on an Apple
LaserWriter Plus. With the font stuff omitted (ie what the script
will generate now) you should get about 3700 lines, 175K.
If you declare all the font stuff uninteresting (uncomment
the font names in the "Uninteresting" dict in list.ps), the
output is reduced to about 2800 lines, 140K.
X
If anyone makes any changes to this, please either mail them
to me, or post them to this newsgroup.
X
X Regards,
X
X - Stephen Frede
X
Softway Pty Ltd, P.O. Box 305, Strawberry Hills, NSW 2012, AUSTRALIA
Phone: +61 2 698 2322; Fax: +61 2 699 9174; Telex: AA27987
ACSnet: stephenf@softway.oz UUCP: ...!uunet!softway.oz!stephenf
END_OF_FILE
if test 3276 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'list.ps' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'list.ps'\"
else
echo shar: Extracting \"'list.ps'\" \(9869 characters\)
sed "s/^X//" >'list.ps' <<'END_OF_FILE'
X%!
X
X% Copyright (C) 1986, 1987, 1988 Softway Pty Ltd.
X% Original program by Stephen Frede
X% This program may be freely copied or modified,
X% as long as this notice remains intact and it is not sold.
X
X% Please send any changes to me at ...!uunet!stephenf@softway.oz
X% or post to the appropriate newsgroup.
X
X
X% === print the definition of something, recursively descending
X% dictionaries where necessary.
X
X/=== {
X % stack: any
X % Save current context.
X % This lets us be slightly less careful about defining random items.
X save exch
X
X % Do all our work within this dict.
X % After all, we don't know how much room there is in userdict,
X % or even if some other dict is on top of the stack.
X
X 40 dict begin
X
X /cp 0 def % Current cursor position.
X /rmargin 160 def % Right hand margin.
X /IndentVal 4 def % Amount to indent by.
X /TabPos 0 def % Current tab position.
X /KnownDicts 200 dict def % Dictionary of dictionaries we've looked at.
X KnownDicts /n 0 put % No. of currently known dictionaries.
X /KnownArrays 200 dict def % Dictionary of arrays we've looked at.
X KnownArrays /n 0 put % no. of currently known arrays
X /str 4 string def % Miscellaneous use string.
X /cvsstr 200 string def % String used with cvs operator.
X % Note that the length may need increasing.
X
X % There are some things we're just not interested in.
X % Usually we can recognise them by their keys in a dictionary
X % they are in. This dictionary will contain the keys of these
X % uninteresting items. The values associated with these keys
X % are for now strings to print.
X % A variation would be to print the actual values the first time,
X % but not thereafter.
X /Uninteresting 100 dict def
X Uninteresting begin
X % These 2 items produce tons of output.
X /CharStrings (<Font character definitions>) def
X /Encoding (<A font encoding array>) def
X % Of course the rest of the fonts may be uninteresting.
X % /NewCenturySchlbk-Italic (<a font>) def
X % /Bookman-LightItalic (<a font>) def
X % /Helvetica (<a font>) def
X % /Courier-Bold (<a font>) def
X % /Helvetica-Narrow-Bold (<a font>) def
X % /Courier-BoldOblique (<a font>) def
X % /Times-Italic (<a font>) def
X % /Times-Bold (<a font>) def
X % /NewCenturySchlbk-Roman (<a font>) def
X % /Helvetica-Narrow-Oblique (<a font>) def
X % /Bookman-DemiItalic (<a font>) def
X % /Symbol (<a font>) def
X % /Bookman-Demi (<a font>) def
X % /Helvetica-BoldOblique (<a font>) def
X % /Bookman-Light (<a font>) def
X % /Helvetica-Oblique (<a font>) def
X % /AvantGarde-Book (<a font>) def
X % /AvantGarde-DemiOblique (<a font>) def
X % /AvantGarde-BookOblique (<a font>) def
X % /AvantGarde-Demi (<a font>) def
X % /Helvetica-Narrow (<a font>) def
X % /ZapfChancery-MediumItalic (<a font>) def
X % /Courier-Oblique (<a font>) def
X % /NewCenturySchlbk-BoldItalic (<a font>) def
X % /Helvetica-Bold (<a font>) def
X % /Times-Roman (<a font>) def
X % /Times-BoldItalic (<a font>) def
X % /Helvetica-Narrow-BoldOblique (<a font>) def
X % /NewCenturySchlbk-Bold (<a font>) def
X % /Palatino-Bold (<a font>) def
X % /Courier (<a font>) def
X % /Palatino-Italic (<a font>) def
X % /Palatino-Roman (<a font>) def
X % /Palatino-BoldItalic (<a font>) def
X % /ZapfDingbats (<a font>) def
X end
X
X % This does all the work.
X % stack: object
X % result:
X /typeprint
X {
X dup type % Get the type of the object.
X exec % Run the corresponding print routine.
X % There must be a routine defined below
X % for each of the possible names generated
X % by the type operator.
X } def % typeprint
X
X % Some utility routines.
X % The first two of these are the only ones that use "print" directly,
X % and thus are all that need be changed to get output on paper.
X
X % Just print a string.
X % If you want output on paper, redefine this routine.
X % stack: string
X /pr
X {
X dup length cp add /cp exch def % Update current position.
X print
X } def
X
X % Print a newline and indent.
X /nlprint
X {
X cp TabPos ne % Unless already at the beginning of a line.
X {
X (\n) print
X TabPos { ( ) print } repeat
X /cp TabPos def
X }
X if
X } def % nlprint
X
X % Increment the current indent level.
X % It would be reasonable to put some check in here to
X % see if we are approaching too close to the right margin.
X % But what could we do?
X /indent+
X {
X /TabPos TabPos IndentVal add def
X nlprint
X } def % indent+
X
X % Decrement the current indent level.
X /indent-
X {
X /TabPos TabPos IndentVal sub def
X nlprint
X } def % indent-
X
X % Print a string, possibly on a new line,
X % and possible with a space before it.
X % Long strings are not themselves broken.
X % stack: string
X /tprint
X {
X dup length % Length of the arg string.
X cp add rmargin gt % Would take us past right margin.
X { nlprint } % So start a new line.
X if
X cp TabPos ne % Unless we're at the start of a line,
X { ( ) pr } % space in from previous string.
X if
X dup length cp add /cp exch def % Update current position.
X pr
X } def % tprint
X
X % Print a reference for an array or dictionary.
X % Format is <number> or <=number> if being defined.
X % stack: number bool
X /refprint
X {
X (<) pr
X not { (=) pr } if % If we have just set the number.
X pr % Print ref. number.
X (>) pr
X % nlprint
X } def % refprint
X
X % Convert an object to a string and print it.
X % stack: object
X /cvsprint
X {
X cvsstr cvs
X tprint
X } def % cvsprint
X
X % Check to see if we already know a given array or dictionary.
X % stack: 'thing', dict of known things
X % result: no. of 'thing' (int), 'found' (bool)
X /searchfor
X {
X dup
X begin % Use dict of things as local storage as well.
X /found false def
X {
X % stack: thing, key, val
X 2 index
X % stack: thing, key, val, thing
X eq % Compare val with thing.
X {
X /found true def
X exit
X % Note that key is not popped.
X } if
X pop % key
X } forall
X found
X {
X % found 'thing'
X % stack: 'thing' 'key'
X exch pop % Don't need 'thing'.
X str cvs % Convert key to string and leave on stack.
X }
X {
X % Didn't find 'thing'.
X % stack: 'thing'
X /n n 1 add def % increment thing no.
X n str cvs cvn % convert no. to key
X exch def % save 'thing' in dict of known things
X n str cvs % leave no. as string on stack
X }
X ifelse
X found % Leave found result on top of stack.
X end % Dict of things.
X } def % searchfor
X
X % Common code for both packed and ordinary arrays.
X % stack: array
X /doarray
X {
X dup xcheck % Executable array (ie procedure)?
X {
X % Executable array (procedure).
X ({) pr
X indent+
X {
X % Print each item of the procedure.
X typeprint
X } forall
X indent-
X (}) pr
X }
X {
X % Non-executable (data) array.
X dup KnownArrays searchfor
X % stack: array number bool
X dup 3 1 roll % Save bool.
X % stack: array bool number bool
X refprint % Print reference number.
X % stack: array bool
X ([) pr
X {
X % Found a previously shown array.
X % Just print empty brackets after the reference number.
X pop % Throw away the array.
X }
X {
X % Isn't already known - print the array.
X % indent+
X {
X typeprint
X } forall
X % indent-
X }
X ifelse
X ( ]) pr
X }ifelse
X nlprint
X } def % doarray
X
X % End of utility routines.
X % Now come the routines to print the various types intelligibly.
X % Each of these routines expects an object of the appropriate
X % type on the stack, and uses it up.
X
X % A save object.
X /savetype
X { pop (-savelevel-) tprint } def % savetype
X
X /integertype
X { cvsprint } def % integertype
X
X /operatortype
X { (--) tprint cvsstr cvs pr (--) pr } def % operatortype
X
X /packedarraytype
X {
X dup rcheck
X { doarray } % If readable, print innards.
X { pop (-packedarray-) tprint } % Can't read, just print type.
X ifelse
X } def % packedarraytype
X
X /fonttype
X { pop (-fontid-) tprint } def % fonttype
X
X /nulltype
X { pop (-null-) tprint } def % nulltype
X
X /realtype { cvsprint } def % realtype
X
X /booleantype { cvsprint } def % booleantype
X
X /marktype
X { pop (-mark-) tprint } def % marktype
X
X /dicttype
X {
X % stack: dict
X dup rcheck
X {
X % Dictionary is readable.
X % Have we examined this dictionary before?
X dup KnownDicts searchfor
X % stack: dict thing-num found
X % In either case, print dictionary number.
X (-dictionary-) tprint
X dup 3 1 roll % save found
X % stack: dict found thing-num found
X refprint
X {
X % Dictionary previously shown, don't print contents again.
X pop
X }
X {
X % Dictionary not previously known - print contents.
X % Print format is "key : value".
X indent+
X % stack: dict
X {
X % stack: key val
X exch dup dup
X % stack: val key key key
X typeprint
X (:) pr
X % See if we should avoid printing the value.
X % We could print the value the first time only,
X % and not thereafter; for now don't bother.
X Uninteresting exch known
X { Uninteresting exch get pr pop }
X { pop typeprint }
X ifelse
X nlprint
X } forall
X indent-
X (% end dictionary) tprint
X }
X ifelse
X }
X { (-dictionary-) tprint pop } % not readable, just print type
X ifelse
X nlprint
X } def % dicttype
X
X /filetype
X {pop (-filestream-) tprint } def % filetype
X
X /nametype
X {
X dup xcheck not % Is this redundant?
X {
X (/) tprint
X }
X if
X cvsstr cvs pr
X } def % nametype
X
X /stringtype
X {
X dup rcheck
X {
X (\() tprint pr (\)) pr
X }
X {
X pop (-string-) tprint
X }
X ifelse
X } def % stringtype
X
X /arraytype
X {
X dup rcheck
X { doarray }
X { pop (-array-) tprint }
X ifelse
X } def % arraytype
X
X % End of the type routines.
X % Now do the work.
X
X typeprint
X nlprint
X flush
X
X end
X
X restore
X} bind def % ===
END_OF_FILE
if test 9869 -ne `wc -c <'list.ps'`; then
echo shar: \"'list.ps'\" unpacked with wrong size!
fi
# end of 'list.ps'
fi
if test -f 'tst1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tst1'\"
else
echo shar: Extracting \"'tst1'\" \(645 characters\)
sed "s/^X//" >'tst1' <<'END_OF_FILE'
X% Simple test for === operator
X
X% Make a simple test dictionary.
X
X/tstdict 10 dict def
tstdict begin
X /abool true def
X /astring (a string) def
X /aname /somename def
X /anarray [ 1 2 3 4 ] def
X /aproc { (a string in a proc) } def
X /adict
X 10 dict dup begin
X /anotherstring (a string in a dict) def
X /afile (%stdin) (r) file def
X /afontid /Times-Roman findfont /FID get def
X /afontdict /Times-Roman findfont def
X /anotherarray [ 10 9 8 7 ] def
X /anumber 42 def
X /amark mark def
X /anull null def
X /anop /add where pop /add get def
X /areal 42.24 def
X end def
X /asave save def
X /thedictagain tstdict def
end
X
tstdict
X===
END_OF_FILE
if test 645 -ne `wc -c <'tst1'`; then
echo shar: \"'tst1'\" unpacked with wrong size!
fi
# end of 'tst1'
fi
if test -f 'tst1.out' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tst1.out'\"
else
echo shar: Extracting \"'tst1.out'\" \(1486 characters\)
sed "s/^X//" >'tst1.out' <<'END_OF_FILE'
X-dictionary-<=1>
X /astring: (a string)
X /asave: -savelevel-
X /adict: -dictionary-<=2>
X /anotherarray:<=1>[ 10 9 8 7 ]
X /anumber: 42
X /anop: --add--
X /areal: 42.24
X /afile: -filestream-
X /anotherstring: (a string in a dict)
X /afontdict: -dictionary-<=3>
X /FontMatrix:<=2>[ 0.001 0 0 0.001 0 0 ]
X /UniqueID: 341
X /Private: -dictionary-
X /FID: -fontid-
X /CharStrings:<Font character definitions>
X /PaintType: 0
X /FontBBox:{
X -170 -217 1024 896
X }
X /FontInfo: -dictionary-<=4>
X /FullName: (Times Roman)
X /FamilyName: (Times)
X /ItalicAngle: 0
X /isFixedPitch: false
X /UnderlinePosition: -109
X /Weight: (Roman)
X /UnderlineThickness: 49
X /version: (001.000)
X /Notice: (Times Roman is a trademark of Allied Corporation.)
X
X % end dictionary
X /Encoding:<A font encoding array>
X /FontName: /Times-Roman
X /FontType: 1
X
X % end dictionary
X /amark: -mark-
X /anull: -null-
X /afontid: -fontid-
X
X % end dictionary
X /aname: /somename
X /anarray:<=3>[ 1 2 3 4 ]
X /aproc:{
X (a string in a proc)
X }
X /abool: true
X /thedictagain: -dictionary-<1>
X
X% end dictionary
END_OF_FILE
if test 1486 -ne `wc -c <'tst1.out'`; then
echo shar: \"'tst1.out'\" unpacked with wrong size!
fi
# end of 'tst1.out'
fi
if test -f 'tst2' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tst2'\"
else
echo shar: Extracting \"'tst2'\" \(476 characters\)
sed "s/^X//" >'tst2' <<'END_OF_FILE'
X% Print the contents of all system dictionaries
X% Make a simple test dictionary.
X
X% Make a dictionary of the common system dictionaries
X
X10 dict dup begin
X /fontdict FontDirectory def
X /userdict userdict def
X /systemdict systemdict def
X /statusdict statusdict def
X /serverdict serverdict def
X /errordict errordict def
end
X
X% Recursively print everything.
X% Warning: on an Apple LaserWriter Plus, this produces
X% ~ 10000 lines, half a megabyte of data.
X
X===
END_OF_FILE
if test 476 -ne `wc -c <'tst2'`; then
echo shar: \"'tst2'\" unpacked with wrong size!
fi
# end of 'tst2'
fi
echo shar: End of shell archive.
exit 0