greid@adobe.com (Glenn Reid) (06/09/89)
[still.ps 1.0d release 11 edit 4]
Thanks for all your comments and bug files from the last release of the
Distillery. Here is the latest release, which I think fixes most of
the bugs reported. There was one file that I couldn't fix that was
combining user-defined fonts with Times fonts in strange ways to form
Hebrew characters (I think) that still confuses the distillery. Other
than that, I hope it is pretty robust at this point. As usual, bug
reports, comments, and encouragement should be sent to greid@adobe.COM
Thanks,
Glenn Reid
Adobe Systems
---
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#
# still.ps
#
# This archive created: Fri Jun 9 07:06:46 1989
# By: Roger L. Long (bytebug@dhw68k.cts.com)
export PATH; PATH=/bin:$PATH
if test -f 'still.ps'
then
echo shar: will not over-write existing file "'still.ps'"
else
sed 's/^X//' << \SHAR_EOF > 'still.ps'
X%!PS-Adobe-2.1
X%%Title: still.ps
X%%Creator: Glenn Reid, Adobe Systems <adobe!greid@decwrl.dec.com>
X%%CreationDate: greid Wed Jul 6 18:02:53 1988 EDIT: Wed Jun 7 10:45:32 1989
X%%VMUsage: 58008 (approx)
X%%EndComments
X
X% Notice: Copyright 1988 1989 Adobe Systems Incorporated. All Rights Reserved.
X
X/adobe_distill 155 200 add dict def % 155 required by still.ps
X/adobe_still_version ((V 1.0d release 11 edit 4)) def
X
X% options:
X/debug true def % generate debugging messages
X/messages false def % generate more debugging messages (verbose!)
X/trace true def % print tracing messages like "page: 3"
X/substitutefonts true def % substitute fonts if guess_font fails....
X/includeuserfonts true def % copy embedded user-defined fonts to output?
X/printpages false def % do you want the pages to print?
X/optimize true def % optimize "show" to "widthshow", etc.
X/tolerance .05 def % for "essentially equal to" operations
X/cachefonts true def % use the /F1 <font> def cache technique
X/cachedir 60 dict def % how many font dicts to cache (optimization)
X/includeprologue true def % output files with/without prologue
X/usernametrack 500 def % how many names to track in user-defined fonts
X % (uses much VM; decrease if no user fonts)
X/hexformat 78 def % width of column for formatted hex data
X
X%
X% HOW TO USE: [see section below]
X%
X% OVERVIEW:
X% This is a meta-utility program that "distills" any PostScript
X% language program into a simpler one. The resulting program
X% will print exactly the same page as the original, but all
X% unnecessary execution overhead is eliminated and the file is
X% clean, uniform, and fast.
X%
X% RELEASE NOTES: [recent changes and details]
X% First public release: 2/10/89
X% Second release (numbered release 8): 2/17/89
X% - reimplemented guess_font routines
X% - added support for color; not careful about RGB->CMYK->RGB
X% - added selective printing of pages during distill
X% Release 9: 3/2/89
X% - fixed color-induced [major efficiency loss] bug
X% - produces %%BoundingBox and %%PageBoundingBox info (atend)
X% - works better (bugs fixed) on rotated (landscape) documents
X% - fixed horrible bug related to CTM that made it resolution-
X% dependent in some cases.
X% - included flag to omit the prologue on output if desired
X% - moved some of the flags to the beginning of the file
X% - improved prologue code to simulate CMYK color with RGB
X% Release 10: 3/10/89
X% - fixed bug related to rotated text
X% - fixed rotated charpath bug mentioned in KNOWN PROBLEMS list
X% - fixed bug with "closepath" followed by "rmoveto"
X% - '=' and 'print' operators now pass data through to output
X% - bug fixes for and much better support of user-defined fonts
X% - (edit 07) fixed "undefined" "fd" problem.
X% - (edit 08) took out redefinitions of '=' and 'print'; fixed
X% a different "undefined" "fd" problem!
X% Release 11: 6/7/89
X% - release numbered (V 1.0d release 11 edit 4)
X% - most reported bugs fixed
X% - optimization added for vertical and horizontal lines
X% - code from Anders Blomdell for arrayeq and formatted hex output
X% - fixed (I think) problems with dropped lines in MacDraw files
X% - declared "Towneley Plays" test file to be incorrigible
X% - adjusted ProcSet comments
X% - fixed bug that generated extra blank pages at end of doc.
X%
X% MANY USES:
X% * If you archive documents in PostScript format, they can often
X% be made more compact and efficient by distilling them.
X% * As a development tool, you can see what your program is
X% really doing, and how simple and fast the driver could be.
X% * Distilled files can be used as an interchange format,
X% since arbitrary PostScript files can be converted to this
X% uniform representation.
X% * If your program can parse distilled files, then any arbitrary
X% PostScript program can be used as input after distilling.
X% * Many others.
X%
X% FEATURES:
X% * correctly distills arbitrarily complex PostScript programs
X% * output is universal, simple, and in default user coordinates
X% * handles "charpath", "image", "imagemask", "awidthshow", etc.
X% * correctly follows "save", "restore", "gsave", "grestore"
X% * re-encodes fonts automatically to match application encoding
X% * reduces prologue size to only about 25-30 lines
X% * For machine-generated code:
X% * output files are almost always SMALLER than original files
X% * output files are almost always FASTER than original files
X% * optimizes "show" to use "widthshow" whenever possible.
X% * uses save/restore at page boundaries
X% * observes structuring conventions and page independence
X% * caches font dictionaries instead of repeating "findfonts"
X% * output is normally VERY fast.
X%
X% HOW TO USE:
X% This program redefines a bunch of operators, and is invoked
X% with the word "distill". This file has to precede the job it is
X% distilling, and you have to invoke it by calling "distill".
X%
X% PRINTERS:
X% In general, start with this file (still.ps), add the word
X% "distill" at the end (to invoke the procedure), and tack
X% any PostScript language file onto the end. Send this to
X% your favorite PostScript printer with an appropriate
X% end-of-file indication at the end. Results will
X% be returned across communication channel, often to a log
X% file somewhere (Unix: /usr/adm/printername.log)
X%
X% INTERPRETERS: if you have an interpreter with a file system
X% handy, first type "(still.ps) run" to load this file, then
X% distill your file like this: "(prog.ps) distill". It will
X% write the results in "prog.psx" (appends an x to the file
X% name you give it).
X%
X% MACINTOSH: I have written a small Mac utility that is called
X% "DistillPS" (an adaptation of "SendPS") that will perform the
X% above PRINTER steps for you. If you are an Adobe registered
X% developer, you can get a copy directly from Adobe (or see
X% posting in USENET comp.binaries.mac group).
X%
X% BACKGROUND
X% The basic idea is to execute the input file completely, with all of
X% the painting operators redefined. When one of these operators is
X% called by the client program, the distillery will write the
X% path the output file (with all coordinates normalized to the default
X% userspace coordinate system). Note that it will usually take LONGER
X% to distill a file than it would to print it, because it executes the
X% whole program, and much of it in a redefined state (slower). Usually
X% only about 20% slower than original print time to distill.
X%
X% The routines in this file are broken down into several areas. Most
X% of them are concerned with writing things to the output file,
X% actually, although there are two other interesting areas. The first
X% are the graphics state procedures, which attempt to keep track of the
X% graphics state and, when a painting op is called, it writes out any
X% changes to the graphics state since the last time it was called. This
X% keeps each painting op from having to write gstate itself. The other
X% interesting procs are simply the redefinitions of the painting ops
X% themselves.
X%
X% KNOWN COMPATIBLE PROGRAMS
X% The following applications have been tested (with some version of the
X% driver, at least), successfully:
X% Lotus Manuscript
X% Macintosh "LaserPrep" (all documents, I think)
X% DEC's VaxDocument
X% Scribe
X% PageMaker
X% Frame Maker
X% Adobe Illustrator
X% TranScript (ditroff and enscript drivers)
X% Pedigree Plot package (incomplete testing)
X%
X% KNOWN PROBLEMS:
X% Clipping isn't handled correctly.
X%
X% The bounding box for text is a crude estimate.
X%
X% Some font tricks are difficult or impossible to distill correctly.
X% Especially those that involve sharing various parts of a font
X% between different font dictionaries, or changing the contents
X% of a font after "definefont" has been executed. Luckily there
X% aren't many programs that do things like that.
X%
X% Hand-written PostScript language programs (especially those
X% that take advantage of looping constructs) may get BIGGER
X% when you distill them, because the Distillery unrolls all loops.
X% It is really intended for machine-generated files, but it should
X% still work on programs tightly coded by hand (like Cookbook
X% examples).
X%
X% Use of the "put" and "putinterval" operators to overwrite
X% string bodies can confuse the optimization technique. If you
X% see strange output (wrong characters printed, especially),
X% try changing "/optimize true def" to "/optimize false def"
X% at the very beginning of this program.
X%
X% Programs that use the "transform" operator to make resolution-
X% rounding decisions may have the output file bound to a specific
X% resolution. The last ProcSet (called "hacks") redefines a few
X% operators to try to work around this. Output file is still
X% device-independent in any case, but might look different.
X%
X% Distillery relies on bug in save/restore related to string bodies
X% to preserve some information across save/restore. It is localized
X% to the "adobe_staticvar" procedure set, but may not always work.
X%
X% In order to optimize re-encoding of fonts, the distillery takes
X% an educated guess that the first re-encoded font it sees will
X% have a representative encoding vector ("stdvec"). If this
X% first font is not encountered before other marks are made, the encoding
X% vector cannot be produced in the %%BeginSetup section, and the still
X% is forced to repeat the vector every time a font is used. Work
X% is in progress on a heuristic to improve this.
X%
X% In order to avoid building up the dictionary stack during
X% execution, all definitions are made in one dictionary
X% (PROLOGUE) and it is not explicitly brought to the top of
X% the dictionary stack for each operation (to avoid
X% "dictstackoverflow" errors). Most of the identifiers have
X% been chosen to be reasonably unique, but there could be a
X% conflict if user programs use the same names.
X%
X% Sometimes generates unnecessarily verbose code in the presence
X% of lots of save/restores in original file. Try distilling the
X% output a second time to improve this (like whiskey)....
X%
X% Some of the ProcSets depend on each other in weird ways, which
X% is wrong, since only the script should depend on the procset
X% definitions. Eventually this will get fixed.
X%
X% Does not always work correctly with user-defined fonts, especially
X% those defined by the standard TeX driver (unfortunately). In
X% particular, TeX bitmap fonts that are defined and have characters
X% added on the fly are almost impossible to deal with reliably in this
X% distillery approach.
X
X%%BeginProcSet: originals 0.5 0
X% This dictionary contains the original definitions of native operators
X% that have been redefined by the Distillery. They are needed on
X% occasion to permit the original program to execute operators without
X% having the results distilled. The motivating factor for this is
X% user-defined fonts, which "draw" into the font cache, but the effects
X% are not wanted in the output file.
X%
X% This also serves as a list of the redbook operators that are redefined
X% by the distillery code.
X
Xmark
X /show
X /widthshow
X /ashow
X /awidthshow
X /kshow
X /fill
X /eofill
X /stroke
X /clip
X /image
X /imagemask
X /showpage
X /pathbbox
X /save
X /restore
X /gsave
X /grestore
X /charpath
X /newpath
X /definefont
X /flushfile
X /=
X /print
Xcounttomark dup dict begin { dup load def } repeat pop
X/originals currentdict end def
X
X%%EndProcSet: originals 0.5 0
X
X%%BeginProcSet: distill_defs 1.0 0
X/setpacking where { pop currentpacking true setpacking } if
X/firstmtx matrix currentmatrix def
X
X/bdef { bind def } bind def
X
X/ifnotdef { %def
X % only does the "def" if the key has not already been defined:
X 1 index where { pop pop pop }{ def } ifelse
X} bdef
X
X/*flushfile /flushfile load ifnotdef
X
Xprintpages not { %if
X /showpage { erasepage initgraphics } bind def
X} if
X
X/currentcmykcolor where { pop }{ %else
X /currentcmykcolor { %def
X currentrgbcolor 3 { 1 exch sub 3 1 roll } repeat 0
X } bind def
X} ifelse
X
X/setpacking where { pop setpacking } if
X%%EndProcSet distill_defs 1.0 0
X
X%%BeginProcSet: Adobe_staticvar 1.0 0
X % this procedure set implements the "magic" stuff to hide numbers
X % and other things where they will not be subject to save/restore
X /magicval { 8 string } bdef
X /hideval { %def % /name int : % "hideval" uses save/restore bug!
X exch load dup 0 (\040\040\040\040\040\040\040\040) putinterval
X exch (\040\040\040\040\040\040\040\040) cvs
X dup length 8 exch sub exch putinterval
X } bdef
X /magicbool { 5 string } bdef
X /hidebool { %def % /name int : % "hideval" uses save/restore bug!
X exch load dup 0 (\040\040\040\040\040) putinterval
X exch (\040\040\040\040\040) cvs 0 exch putinterval
X } bdef
X /cvnum { cvx exec } bdef % makes hidden val back into an integer
X /cvbool { cvx exec } bdef % makes hidden val back into a boolean
X /hidefontname { %def
X % hides a font name in a string body, for use in %%DocumentFonts
X scratch cvs
X % look to see if it is already in the docfonts string:
X % lots of hacks to search for (FontName\n), not just (FontName)
X save % cause we're using memory for temporary string
X adobe_distill begin
X 1 index length 1 add string /tmpstring exch def
X tmpstring dup length 1 sub (\040) 0 get put
X tmpstring 0 3 index putinterval
X pagefonts tmpstring search {pop pop pop false}{pop true} ifelse
X docfonts tmpstring search {pop pop pop false}{pop true}ifelse
X end
X 3 -1 roll restore % roll save object past booleans
X
X % first deal with docfonts, then with pagefonts booleans
X { %ifelse
X exch % extra boolean for page fonts
X dup dfontcount cvnum 1 index length add 1 add
X docfonts length lt {
X dup docfonts exch dfontcount cvnum exch putinterval
X length 1 add dfontcount cvnum add /dfontcount exch hideval
X docfonts dfontcount cvnum 1 sub (\040) putinterval
X }{ %else
X pop (% No more room for fonts in document font list\n) d=
X } ifelse
X messages { %if
X (document fonts: ) pr=
X docfonts 0 dfontcount cvnum getinterval d= flush
X } if
X exch % page font boolean still on stack, under "dup"ed string
X }{ } ifelse
X { %ifelse
X pfontcount cvnum 1 index length add 1 add
X pagefonts length lt {
X dup pagefonts exch pfontcount cvnum exch putinterval
X length 1 add pfontcount cvnum add /pfontcount exch hideval
X pagefonts pfontcount cvnum 1 sub (\040) putinterval
X }{ %else
X pop (% No more room for fonts in page font list\n) d=
X } ifelse
X messages { %if
X (page fonts: ) pr=
X pagefonts 0 pfontcount cvnum getinterval d= flush
X } if
X }{ pop } ifelse
X } bdef
X%%EndProcSet: Adobe_staticvar 1.0 0
X
X%%BeginProcSet: distill 1.0 0
X/setpacking where { pop currentpacking true setpacking } if
X
X/adobe_distill dup where { pop pop }{ 165 200 add dict def } ifelse
X
X% some variables
X % magic variables depending on "hideval", not subject to save/restore
X /pagecount magicval def /pagecount 1 hideval
X /beginsetup magicbool def /beginsetup true hidebool
X /lastshowpage magicbool def /lastshowpage false hidebool
X /begunpage magicbool def /begunpage false hidebool
X /?distilling magicbool def /?distilling true hidebool
X
X /dfontcount magicval def /dfontcount 0 hideval
X /pfontcount magicval def /pfontcount 0 hideval
X /docfonts 40 30 mul string def % room for 40 30-byte font names
X /pagefonts 40 30 mul string def % room for 40 30-byte font names
X /LLx magicval def /LLx 10000 hideval
X /LLy magicval def /LLy 10000 hideval
X /URx magicval def /URx -10000 hideval
X /URy magicval def /URy -10000 hideval
X /docLLx magicval def /docLLx 10000 hideval
X /docLLy magicval def /docLLy 10000 hideval
X /docURx magicval def /docURx -10000 hideval
X /docURy magicval def /docURy -10000 hideval
X
X /optim optimize def
X /scratch 128 string def
X /fontcount 0 def
X /indentlevel 0 def
X /ANYtype null def
X /insideproc false def
X /Dfont null def
X /Ffont null def
X /Fname null def
X /lastshow false def
X /imageproc null def
X /imagematrix null def
X /imagedepth null def
X /imageheight null def
X /imagewidth null def
X /unames usernametrack dict def % for keeping track of user-defined names
X
X% a few of them go into userdict:
X/cvp {
X messages { % ifelse
X ( ) cvs pr= (\040) pr=
X }{ pop } ifelse
X} bdef
X/pr= { messages { rprint }{ pop } ifelse } bdef
X/d= { messages { r= }{ pop } ifelse } bdef
X
X/distill {
X adobe_distill begin
X debug{(%!PS-Adobe-2.1 debug version ) rprint adobe_still_version == }if
X userdict /orig_dictcount countdictstack put
X count 0 eq { %ifelse
X /INfile (%stdin) def
X /OUTfile (%stdout) def
X /fd (%stdout) (w) file def
X initstill
X writeprologue
X initgstate
X INfile (r) file cvx exec
X writetrailer
X }{ %else
X dup type /stringtype ne { %if
X (\n% Distill Error; invoked with bogus file name: ) print
X == (\n) print flush
X stop
X } if
X /filenameforall where { pop }{ %ifelse
X (\n% Distill Error; invoked with file name: ) print ==
X (% This interpreter cannot open files directly.) =
X (% Please add "distill" at end of file and concatenate with) =
X (% file to be distilled.) = (\n) print flush
X stop
X } ifelse
X initgraphics
X /saveall save def
X /INfile exch def
X /OUTfile INfile length 1 add string def
X OUTfile 0 INfile putinterval
X OUTfile dup length 1 sub (x) 0 get put
X trace { (output file: ) rprint OUTfile == } if
X /outfile OUTfile (w) file def
X /fd /outfile load def
X initstill
X writeprologue
X initgstate
X debug { %ifelse
X INfile run
X }{ % else
X { INfile run } stopped { % if
X errordict begin $error begin
X (\n%%[Error: ) wout
X /errorname load =string cvs wout
X (; OffendingCommand: ) wout
X /command load =string cvs wout (]%%) wout writeNL
X (STACK:) writeop /ostack load type /arraytype eq {
X ostack { =string cvs writeop } forall
X } if
X fd systemdict /flushfile get exec
X handleerror
X end end
X } if
X } ifelse
X writetrailer
X fd closefile
X countdictstack orig_dictcount sub { end } repeat
X clear
X saveall { restore } stopped { %if
X trace { (couldn't restore after distill.) r= } if
X } if
X } ifelse
X end
X} bdef
X
X% the rest of them go in "adobe_distill"
Xadobe_distill begin
X /setdistill { %def
X /?distilling exch hidebool
X } bdef
X
X /initstill { %def
X /beginsetup true hidebool
X /lastshowpage false hidebool
X /begunpage false hidebool
X /pagecount 1 hideval
X /STDvec 0 hideval
X /PAGEvec 0 hideval
X /dfontcount 0 hideval
X /pfontcount 0 hideval
X /LLx 10000 hideval /LLy 10000 hideval
X /URx -10000 hideval /URy -10000 hideval
X /docLLx 10000 hideval /docLLy 10000 hideval
X /docURx -10000 hideval /docURy -10000 hideval
X /SharedFontDirectory where { %ifelse
X /SharedFontDirectory get
X }{ /FontDirectory load } ifelse
X /FontDirectory exch def
X 0 1 pagefonts length 1 sub { pagefonts exch 0 put } for
X 0 1 docfonts length 1 sub { docfonts exch 0 put } for
X } bdef
X debug { %if
X /BB {
X debug {
X (% BBox: ) pr=
X LLx pr= ( ) pr= LLy pr= ( ) pr=
X URx pr= ( ) pr= URy pr= (\n) pr= flush
X (% DocBBox: ) pr=
X docLLx pr= ( ) pr= docLLy pr= ( ) pr=
X docURx pr= ( ) pr= docURy pr= () r= flush
X } if
X } bdef
X } if
X /?box { %def % X Y
X dup URy cvnum gt { dup /URy exch cvi hideval } if
X dup LLy cvnum lt { dup /LLy exch cvi hideval } if pop
X dup URx cvnum gt { dup /URx exch cvi hideval } if
X dup LLx cvnum lt { dup /LLx exch cvi hideval } if pop
X } bdef
X /doc?box {
X dup docURy cvnum gt { dup /docURy exch cvi hideval } if
X dup docLLy cvnum lt { dup /docLLy exch cvi hideval } if pop
X dup docURx cvnum gt { dup /docURx exch cvi hideval } if
X dup docLLx cvnum lt { dup /docLLx exch cvi hideval } if pop
X } bdef
X /pageBBox-docBBox {
X LLx cvnum LLy cvnum doc?box
X URx cvnum URy cvnum doc?box
X } bdef
X /writeRmove { %def
X 2 copy lineY sub exch lineX sub exch
X dup 0.0 eq { pop writenum (x) writeop }{ %ifelse
X 1 index 0.0 eq { writenum (y) writeop pop }{ %ifelse
X writepair (r) writeop
X } ifelse
X } ifelse
X 2 copy ?box
X /lineY exch store /lineX exch store
X } bdef
X /writelines { %def
X counttomark REPEAT_LINETO_THRESHOLD gt { % ifelse
X counttomark /lcount exch store
X lcount -2 2 { %for
X dup /rcount exch store
X -2 roll 2 copy lineY sub exch lineX sub exch 4 -2 roll
X 2 copy ?box
X /lineY exch store /lineX exch store
X rcount 2 roll
X } for
X lcount 2 idiv { writepair writeNL } repeat
X lcount 2 idiv writenum (R) writeop
X }{ % else
X counttomark -2 2 { -2 roll writeRmove } for
X } ifelse
X } bdef
X /writepath {
X /closed false store
X % optimize special case of just "moveto lineto stroke"
X mark
X % pathforall
X { counttomark 2 gt { cleartomark false exit } if thruCTM true }
X { counttomark 5 gt { cleartomark false exit } if thruCTM true }
X { cleartomark false exit }
X { cleartomark false exit }
X pathforall { %ifelse
X counttomark 5 ne { %ifelse
X % degenerate case...
X ischarpath counttomark 2 eq and { % just moveto
X 2 copy ?box
X writepair (m) writeop
X } if
X cleartomark
X }{ %else
X 3 -1 roll pop
X /?simplepath true store
X simplepath astore pop
X pop %mark
X } ifelse
X }{ %else
X /?simplepath false store
X mark
X { % moveto
X closed { (cp ) wout /closed false store } if
X counttomark 2 gt { %if
X counttomark 1 add 2 roll writelines 3 1 roll
X } if
X 2 copy thruCTM /lineY exch store /lineX exch store
X /closeX lineX store /closeY lineY store
X 2 copy ?box
X writeTpair (m) writeop
X } % moveto proc
X { %lineto proc
X thruCTM count 490 gt { writelines } if
X } % lineto
X { % curveto
X counttomark 6 gt { %if
X counttomark 1 add 6 roll writelines 7 1 roll
X } if
X 2 copy thruCTM /lineY exch store /lineX exch store
X 3 { %repeat
X 6 -2 roll 2 copy thruCTM
X 2 copy ?box
X exch writenum writenum
X } repeat (c) writeop 6 {pop} repeat
X } % curveto
X { % closepath
X counttomark 0 gt { writelines } if
X /closed true store
X /lineX closeX store /lineY closeY store
X } % closepath
X pathforall
X counttomark 0 gt { writelines } if
X pop %mark
X } ifelse
X } bdef
X /hashpath { %def
X % manufacture a [fairly] unique integer to represent a path:
X -1 % initial value
X { .5 add add 2 div add } % moveto
X { add sub } % lineto
X { add add sub add add add } % curveto
X { 1 add } % closepath
X pathforall
X dup 100 lt { 10 mul truncate 10 div } if
X } bdef
X /hashencoding { %def
X % manufacture a [fairly] unique integer for an encoding vector,
X % by alternately adding then subtracting the length of the name.
X % The alternation makes reordered lists with same names still come out
X % with a different hash value (the "-1 exch" and the "mul" do this)
X -1 exch 0 exch % initial value: 0
X { % forall
X dup type /nametype eq { length }{ pop 1 } ifelse
X 2 index mul add % multiply by 1 or -1 and add
X exch -1 mul exch % flip 1 and -1
X } forall
X exch pop % get rid of -1, leave hash val
X } bdef
X /STDvec magicval def /STDvec 0 hideval
X /PAGEvec magicval def /PAGEvec 0 hideval
X /enc1 null def /enc2 null def
X /diffencoding { %def
X % check the "top128" boolean to see if it's worth reencoding them
X /enc2 exch store /enc1 exch store % enc2 is the new one
X [
X 32 1 127 { %for % 0 1 255 ??
X dup dup enc2 exch get exch enc1 exch get
X 1 index eq { pop pop } if
X } for
X ]
X } bdef
X /indent { indentlevel { fd ( ) writestring } repeat } bdef
X /++ { dup load 1 add store } bdef
X /-- { dup load dup 1 ge { 1 sub } if store } bdef
X
Xend %adobe_distill
X/setpacking where { pop setpacking } if
X%%EndProcSet distill 1.0 0
X
X%%BeginProcSet: distill_writetofile 1.0 0
X/setpacking where { pop currentpacking true setpacking } if
X/adobe_distill dup where { pop pop }{ 165 200 add dict def } ifelse
Xadobe_distill begin
X /writetrailer { %def % :
X stackptr 0 ne { stackshow } if
X begunpage cvbool { %if
X lastshowpage cvbool not { %if
X ( /showpage {} def) writeop
X } if
X pagecount cvnum scratch cvs wout ( ENDPAGE\n) wout
X (%%PageTrailer) writeop
X (%%PageFonts: ) wout
X pfontcount cvnum 0 eq { writeNL }{ %else
X pfontcount cvnum 200 lt { %ifelse
X pagefonts 0 pfontcount cvnum getinterval writeop
X }{ %else
X pagefonts (\040) search not { writeop }{ %else
X writeop % first one without the %%+
X { %loop
X search { (%%+ ) wout writeop }{ %else
X (\000) search { writeop pop pop }{ pop } ifelse
X exit
X } ifelse
X } loop
X } ifelse
X } ifelse
X 0 1 pfontcount cvnum { pagefonts exch 0 put } for
X /pfontcount 0 hideval
X } ifelse
X LLx 10000 eq LLy 10000 eq or
X URx -10000 eq URy -10000 eq or or not {
X (%%PageBoundingBox: ) wout
X LLx cvnum writenum LLy cvnum writenum
X URx cvnum writenum URy cvnum writenum writeNL
X } if
X pageBBox-docBBox
X } if
X (%%Trailer) writeop
X (end %PROLOGUE) writeop
X (%%Pages: ) wout pagecount cvnum writenum writeNL
X (%%BoundingBox: ) wout
X docLLx cvnum writenum docLLy cvnum writenum
X docURx cvnum writenum docURy cvnum writenum writeNL
X (%%DocumentFonts: ) wout
X dfontcount cvnum 0 eq { writeNL }{ %else
X dfontcount cvnum 200 lt { %ifelse
X docfonts 0 dfontcount cvnum getinterval writeop
X }{ %else
X docfonts (\040) search not { writeop }{ %else
X writeop % first one without the %%+
X { %loop
X search { (%%+ ) wout writeop }{ %else
X (\000) search { writeop pop pop }{ pop } ifelse
X exit
X } ifelse
X } loop
X } ifelse
X } ifelse
X } ifelse
X (%%EOF) writeop
X } bdef
X /writecomments { %def
X fd (%!PS-Adobe-2.1\n) writestring
X fd (%%Title: ) writestring fd OUTfile writestring fd (\n) writestring
X fd (%%Creator: Glenn Reid and still.ps ) writestring
X fd adobe_still_version writestring fd (\n) writestring
X fd (%%BoundingBox: (atend)\n) writestring
X fd (%%Pages: (atend)\n) writestring
X includeprologue { %ifelse
X fd (%%DocumentProcSets: Adobe_distill 0.112\n) writestring
X }{ %else
X fd (%%DocumentNeededProcSets: Adobe_distill 0.112\n) writestring
X } ifelse
X fd (%%EndComments\n) writestring
X } bdef
X /writeprologue { %def % :
X writecomments
X includeprologue { %ifelse
X mark
X (%%BeginProcSet: Adobe_distill 0.112 0)
X (/PROLOGUE 30 40 add dict def)
X ( % 30 procedure entries + room for 40 cached font dictionaries)
X ( PROLOGUE begin)
X ( /clip { } def % causes problems. remove if "clip" is needed)
X ( /bdef { bind def } bind def /ldef { load def } bdef)
X ( /T { moveto show } bdef /A { moveto ashow } bdef)
X ( /W { moveto widthshow } bdef /AW { moveto awidthshow } bdef)
X ( /f /fill ldef /R { { rlineto } repeat } bdef)
X ( /r /rlineto ldef /L { { lineto } repeat } bdef)
X ( /m /moveto ldef /l { moveto lineto stroke } bdef)
X ( /x { 0 rlineto } bdef /y { 0 exch rlineto } bdef)
X ( /X { moveto 0 rlineto stroke } bdef)
X ( /Y { moveto 0 exch rlineto stroke } bdef)
X ( /c /curveto ldef /cp /closepath ldef)
X ( /s /stroke ldef /w /setlinewidth ldef)
X ( /g /setgray ldef /j /setlinejoin ldef)
X ( /d /setdash ldef /F /setfont ldef)
X ( /C /setcmykcolor where { /setcmykcolor get }{ %ifelse)
X ( { %def)
X ( 1 sub 3 { 3 index add neg dup 0 lt { pop 0 } if 3 1 roll } repeat)
X ( setrgbcolor)
X ( } bind)
X ( } ifelse def)
X ( /selectfont where { pop }{ %ifelse)
X ( /selectfont { exch findfont exch scalefont setfont } bdef)
X ( } ifelse)
X ( /MF { exch findfont exch makefont setfont } bdef)
X ( /FF /selectfont ldef)
X ( /DF { selectfont currentfont def } bdef)
X ( /BEGINPAGE { pop /pagesave save def } bdef)
X ( /ENDPAGE { pop pagesave restore showpage } def)
X ( /REMAP { %def)
X ( FontDirectory 2 index known { pop pop pop } { %ifelse)
X ( findfont dup length dict begin)
X ( { 1 index /FID ne {def}{pop pop} ifelse } forall)
X ( exch dup length 0 gt { /Encoding exch def }{ pop } ifelse)
X ( currentdict end definefont pop)
X ( } ifelse)
X ( } bdef)
X ( /RECODE { %def)
X ( 3 -1 roll 1 index findfont /Encoding get 256 array copy exch)
X ( 0 exch { %forall)
X ( dup type/nametype eq)
X ( { 3 {2 index} repeat put pop 1 add }{ exch pop }ifelse)
X ( } forall pop 3 1 roll REMAP)
X ( } bdef)
X ( end %PROLOGUE)
X (%%EndProcSet: Adobe_distill 0.112 0)
X % write all the above strings to the output file:
X counttomark -1 1 { %for
X -1 roll fd exch writestring fd (\n) writestring
X } for
X fd systemdict /flushfile get exec
X pop %mark
X }{ %else
X (%%IncludeProcSet: Adobe_distill 0.112 0\n) fd exch writestring
X } ifelse
X fd (%%EndProlog\n) writestring
X fd (%%BeginSetup\n) writestring
X fd (PROLOGUE begin\n) writestring
X } bdef
X /checksetup { %def
X % called from "fontstate", "graphicstate", and "definefont"
X beginsetup cvbool {
X /beginsetup false hidebool
X fd (\n%%EndSetup\n%%Page: 1 1\n) writestring
X fd (%%PageFonts: (atend)\n) writestring
X fd (%%PageBoundingBox: (atend)\n) writestring
X fd (1 BEGINPAGE\n) writestring
X /begunpage true hidebool
X /fontcount 0 store
X }{ %else
X lastshowpage cvbool { %if
X /lastshowpage false hidebool
X /fontcount 0 store
X writeNL (%%Page: ) wout
X trace { (page: ) rprint pagecount cvnum == flush } if
X /pagecount pagecount cvnum 1 add hideval
X pagecount cvnum dup writenum writenum writeNL
X (%%PageFonts: (atend)) writeop
X (%%PageBoundingBox: (atend)) writeop
X pagecount cvnum scratch cvs wout ( BEGINPAGE\n) wout
X /begunpage true hidebool
X % invalidate all remapped fonts, for page independence
X FontDirectory { %forall
X exch pop dup /FontInfo known { %ifelse
X /FontInfo get dup /pleasemap known { %ifelse
X begin (Glenn Reid)
X pleasemap cvbool not {
X /pleasemap true hidebool
X } if pop
X end
X }{ pop } ifelse
X }{ pop } ifelse
X } forall
X currentfont null ne { % if
X currentfont dup /FontInfo known { %ifelse
X /FontInfo get dup /pleasemap known { %ifelse
X begin /pleasemap true hidebool end
X }{ pop } ifelse
X }{ pop } ifelse
X } if
X % forcegstate
X } if
X } ifelse
X } bdef
X /writenamearray { % [ /name ... ] :
X fd ([) writestring
X /indentlevel ++ fd (\n) writestring indent
X /CNT 1 store
X %| maintain CNT to count bytes. wrap lines at a reasonable
X %| place when writing out character names, to avoid long lines
X { %forall
X fd (/) writestring
X dup type /nametype eq { scratch cvs }{ pop (.notdef) } ifelse
X dup length 1 add CNT add /CNT exch store fd exch writestring
X CNT 60 ge { /CNT 1 store fd (\n) writestring indent } if
X } forall
X /indentlevel -- fd (\n) writestring indent fd (]) writestring
X } bdef
X /writediffencoding { % [ 32/name 37/etc ... ] :
X fd ([) writestring
X /indentlevel ++ fd (\n) writestring indent
X /CNT 1 store
X %| maintain CNT to count bytes. wrap lines at a reasonable
X %| place when writing out character names, to avoid long lines
X { %forall
X dup type /integertype eq { %ifelse
X fd (\040) writestring
X scratch cvs fd exch writestring /CNT CNT 4 add store
X }{ %else
X fd (/) writestring
X dup type /nametype eq { scratch cvs }{ pop (.notdef) } ifelse
X dup length 1 add CNT add /CNT exch store fd exch writestring
X } ifelse
X CNT 60 ge { /CNT 1 store fd (\n) writestring indent } if
X } forall
X /indentlevel -- fd (\n) writestring indent fd (]) writestring
X } bdef
X
X % write numbers in various formats:
X
X /thruCTM { CTM transform } bdef
X /dthruCTM { CTM dtransform } bdef
X /XthruCTM { %def
X dup CTM dtransform
X rot not { pop }{ %else
X 2 copy gt { pop }{ exch pop } ifelse
X } ifelse
X } bdef
X
X /*writestring { %def
X writestring fd *flushfile
X } bdef
X /shave { %def
X % eliminate significant digits beyond .0001; compensate for roundoff
X dup type /realtype eq { %if
X 10000 mul round 10000 div
X } if
X } bdef
X /writenum { % def % num :
X dup abs 0.001 le { pop 0 } if % --> 0
X dup dup cvi eq { cvi } if
X fd exch scratch cvs writestring _space
X } bdef
X /writeprecisenum { % def % num :
X fd exch scratch cvs writestring _space
X } bdef
X /writeXnum { % def % num :
X CTM 0 get mul writenum
X } bdef
X /writeYnum { % def % num :
X CTM 3 get mul writenum
X } bdef
X /writeTpair { % def % num1 num2 :
X thruCTM exch
X writenum writenum
X } bdef
X /writepair { % def % num1 num2 :
X exch writenum writenum
X } bdef
X /writenumarray { % [ nums ] :
X fd ([) writestring
X { writenum } forall
X fd (] ) writestring
X } bdef
X
X % write out names and strings:
X /rprint /print load def
X /r= /= load def
X% /print { fd exch writestring } bind def
X% /= { scratch cvs fd exch writestring writeNL } bind def
X
X /writeNL { fd (\n) writestring } bdef
X /_space { fd (\040) writestring } bdef
X /wout { % def % (string) :
X fd exch writestring
X } bdef
X /writestr { % def % (string) :
X fd exch writestring _space
X } bdef
X /writeop { %def % (string) :
X fd exch writestring writeNL
X } bdef
X /writePSstring { % def % (string) :
X fd (\() writestring dup length 75 gt exch
X wordfix fd (\) ) writestring { writeNL } if % if length > 75 bytes
X } bdef
X % formathexstring, thanks to Anders Blomdell
X % file string linelength formathexstring
X /formathexstring { %def
X hexformat 2 idiv 1 index length
X 0 2 index 2 index { %for
X dup 3 index add 2 index lt { %ifelse
X 2 index
X }{ %else
X dup 2 index sub neg
X } ifelse
X 4 index 3 1 roll getinterval
X 4 index exch writehexstring writeNL
X } for
X pop pop pop pop
X } bdef
X /writename { % def % name :
X scratch cvs fd exch writestring _space
X } bdef
X /writeRname { % def % name :
X (/) wout scratch cvs wout (R ) wout
X } bdef
X /checkusernames { %def % array :
X { % forall
X dup type /nametype ne { pop }{ %ifelse
X dup systemdict exch known { pop }{ % ifelse
X dup xcheck not { pop }{ %ifelse
X dup unames exch known { pop }{ %ifelse
X dup where not { %ifelse
X dup unames exch true put
X pop % assume it's taken care of
X }{ %else
X pop dup load dup type /arraytype eq
X 1 index type /packedarraytype eq or
X { checkusernames }{ pop } ifelse
X indent (userdict /) wout dup writename
X dup unames exch true put
X load writeANY
X (put) writeop indent
X } ifelse
X } ifelse
X } ifelse
X } ifelse
X } ifelse
X } forall
X } bdef
X /arrayusernames { %def
X dup type /arraytype eq 1 index type /packedarraytype eq or { %ifelse
X dup checkusernames
X { arrayusernames } forall
X }{ pop } ifelse
X } bdef
X /writeproc { %def
X ({) writestr
X insideproc exch /insideproc true store
X dup type /arraytype eq 1 index type /packedarraytype eq or { % ifelse
X dup length 20 lt { %ifelse
X { writeANY } forall
X }{ %else
X writeNL /indentlevel ++ indent
X { writeANY writeNL indent } forall
X /indentlevel -- writeNL indent
X } ifelse
X }{ %else
X writename
X } ifelse
X /insideproc exch store
X (} ) writestr
X } bdef
X /typedict 12 dict def
X typedict begin
X /stringtype {
X dup 0 get 0 eq 1 index dup length 1 sub get 0 eq or {
X (<) wout fd exch formathexstring (> ) wout
X }{ writePSstring } ifelse
X } bdef
X /arraytype { %def
X % dup checkusernames
X dup xcheck { %ifelse
X writeproc
X }{ %else
X /CNT 1 store
X dup length 20 lt { %ifelse
X ([ ) wout { writeANY } forall (] ) wout
X }{ %else
X ([) writeop /indentlevel ++
X { indent writeANY writeNL } forall
X /indentlevel -- indent (] ) wout
X } ifelse
X } ifelse
X } bdef
X /packedarraytype /arraytype load def
X /dicttype { %def
X % safety: 1 add (needed for User Fonts)
X dup maxlength 1 add writenum (dict begin) writeop indent
X { %forall
X exch writeANY writeANY (def ) writeop indent
X } forall (currentdict end ) wout
X } bdef
X /integertype { writenum } def
X /realtype { writeprecisenum } def
X /nulltype { pop (null ) wout } def
X /operatortype { %def
X insideproc { %ifelse
X writename
X }{ %else
X (/) wout writename (load) writestr
X } ifelse
X } bdef
X /nametype { %def
X dup xcheck not { (/) wout dup unames exch true put } if
X writename
X } bdef
X end % typedict
X /writeANY { %def
X dup type dup typedict exch known { %ifelse
X typedict exch get exec
X }{ %else
X pop writename
X } ifelse
X } bdef
X % The following writes an escaped string that may contain special chars.
X % It regenerates the (\035string) notation.
X /wordfix { %def % (string) :
X (\() search { %ifelse
X rparenfix (\\\() wout pop wordfix
X }{ rparenfix } ifelse
X } bdef
X /rparenfix { %def
X (\)) search { %ifelse
X binaryfix (\\\)) wout pop rparenfix
X }{ binaryfix } ifelse
X } bdef
X /str1 1 string def
X /longstr 1028 string def
X /writetomark { %def
X counttomark -1 0 { %for
X longstr exch exch put
X } for
X } bdef
X /binaryfix { %def
X dup false exch { %forall
X dup 128 gt 1 index 32 lt or { %ifelse
X str1 exch 0 exch put pop true exit
X }{ pop } ifelse
X } forall
X { %ifelse % depending on whether binary num was found
X str1 search {
X quotefix % string previous to binary num
X (\\) wout % the backslash
X 0 get dup 8 eq {
X pop (b) wout
X }{ %else
X dup 10 eq {
X pop (n) wout
X }{ %else
X % write binary char as octal: \008
X 8 scratch cvrs
X dup length 3 exch sub { (0) wout } repeat wout
X } ifelse
X } ifelse
X binaryfix % recurse on rest of string
X }{
X (ERROR: search lied in "binaryfix".) r= flush stop
X } ifelse
X }{ quotefix } ifelse
X } bdef
X /quotefix { %def
X (\\) search { %ifelse
X wout (\\\\) wout pop quotefix
X }{ wout } ifelse
X } bdef
X
Xend %adobe_distill
X/setpacking where { pop setpacking } if
X%%EndProcSet distill 1.0 0
X
X%%BeginProcSet: distill_graphicstate 1.0 0
X% we don't want packed arrays for all these matrices; set packing later
X/adobe_distill dup where { pop pop }{ 165 200 add dict def } ifelse
Xadobe_distill begin
X
X % define a bunch of state variables, then use "store" subsequently
X % to write into them (to avoid currentdict problems).
X /mtx matrix def
X /tmpmtx matrix def
X /fontmtx matrix def
X /curfontmtx matrix def
X /CTM matrix currentmatrix def
X /normalCTM tmpmtx currentmatrix matrix invertmatrix def
X /compareCTM matrix currentmatrix def
X /newCTM matrix def
X /mtx1 0 def
X /mtx2 0 def
X /$normalize {
X dup tmpmtx copy normalCTM 3 -1 roll concatmatrix
X } bind def
X /rot false def
X /gray currentgray def
X currentcmykcolor
X /colK exch def /colY exch def /colM exch def /colC exch def
X /linewidth currentlinewidth def
X /linecap currentlinecap def
X /linejoin currentlinejoin def
X /miterlimit currentmiterlimit def
X /screenang null def
X /screenfreq null def
X /screenproc null def
X /closed false def
X currentdash /dashoff exch def /dasharray exch def
X /pointX -1 def /pointY -1 def
X /initfontscale { 1 0 0 1 0 0 $fontscale astore pop } bind def
X /$fontscale matrix def
X /0a 0 def /0b 0 def
X /X1 0 def /X2 0 def
X /origfontname null def
X /currfontdict null def
X /definefontname null def
X /tempfontname /Courier def
X% /defaultfontname substitutefonts { /Courier }{ /Unknown } ifelse def
X /defaultfontname {
X /FontType where { %ifelse
X pop FontType 3 eq {
X FontInfo /realname get
X }{ substitutefonts { /Courier }{ /Unknown } ifelse } ifelse
X }{ %else
X substitutefonts { /Courier }{ /Unknown } ifelse
X } ifelse
X } def
X /ischarpath false def
X /currpath newpath hashpath def
X /pathstr () def
X /pathbool false def
X /pathX 0 def /pathY 0 def
X /lineX 0 def /lineY 0 def
X /closeX 0 def /closeY 0 def
X /lcount 0 def /rcount 0 def
X /REPEAT_LINETO_THRESHOLD 20 def % point at which repeat loop is used
X /currX -1 def /currY -1 def
X /diffX 0 def
X /gstates 0 def
X /charpathgstate 0 def
X /CNT 0 def
X /showX null def /showY null def
X /currfont currentfont def
X /cliphash newpath hashpath def
X /?simplepath false def
X /simplepath [ 0 0 0 0 ] def
X
X/setpacking where { pop currentpacking true setpacking } if
X
X /matrixeq { %def % compares two matrices
X /mtx2 exch store
X /mtx1 exch store
X 0 1 5 { %for
X dup mtx1 exch get
X exch mtx2 exch get eq
X } for
X 5 { and } repeat
X } bdef
X % begin eqarray AB 890420 (thanks to Anders Blomdell)
X % array1 array2 eqarray bool
X /arrayeq {
X % if they're equal, they're equal: simplicity first...
X 2 copy eq { pop pop true }{ %ifelse
X % next check their lengths, for trivial eq/ne:
X 2 copy length exch length eq { %ifelse
X % We now have to compare all elements
X true % arr arr true
X 0 1 3 index length 1 sub % arr arr true 0 1 length-1
X { % arr arr bool index
X 3 index 1 index get % arr arr bool index val1
X 3 index 2 index get % arr arr bool index val1 val2
X eq exch pop and % arr arr bool
X } for
X exch pop exch pop
X }{ pop pop false } ifelse
X } ifelse
X } bdef
X /arrayne {
X arrayeq not
X } bdef
X
X % procedure definitions for state machinery ---------------
X
X /initgstate { %def
X gsave
X initgraphics
X /CTM mtx currentmatrix $normalize store
X tmpmtx currentmatrix compareCTM matrixeq not {
X .345 dup 0 dtransform pop 0 idtransform
X pop ne dup /rot exch store not optimize and /optim exch store
X } if
X compareCTM currentmatrix pop
X /gray currentgray store
X currentcmykcolor
X /colK exch store /colY exch store
X /colM exch store /colC exch store
X /linewidth currentlinewidth XthruCTM store
X /linecap currentlinecap store
X /linejoin currentlinejoin store
X /miterlimit currentmiterlimit store
X currentdash /dashoff exch store /dasharray exch store
X /origfontname /InvalidFont store
X /definefontname /InvalidFont store
X initfontscale
X /currfontdict currentfont store
X currentscreen
X /screenproc exch store
X /screenang exch store
X /screenfreq exch store
X /cliphash clippath hashpath store % Wed Dec 28 12:41:07 1988
X grestore
X } bdef % initgstate
X /forcegstate { %def
X % after save & restore, you may have to explicitly "undo" anything
X % that was done within the saved context. Since save & restore
X % affect all our state variables, we dump anything that is different
X % from the default graphics state:
X /CTM [1.01 0 1.01 0 .5 .5] store
X /compareCTM [1.01 0 1.01 0 .5 .5] store
X initfontscale
X /currfontdict null store
X /gray null store
X /colC null store
X % checkgstate % fontstate
X currentfont null ne { % if
X currentfont dup /FontInfo known { %ifelse
X /FontInfo get dup /pleasemap known { %ifelse
X begin /pleasemap true hidebool end
X }{ pop } ifelse
X }{ pop } ifelse
X } if
X } bdef % initgstate
X /checkgstate { %def
X graphicstate
X fontstate
X } def %checkgstate
X /checkCTM { %def
X tmpmtx currentmatrix compareCTM matrixeq not {
X % /CTM mtx currentmatrix $normalize store
X CTM currentmatrix $normalize pop
X compareCTM currentmatrix $normalize pop
X .345 dup 0 dtransform pop 0 idtransform
X pop ne dup /rot exch store not optimize and /optim exch store
X } if
X } bdef
X /generalstate { %def
X stackptr 0 ne { stackshow } if
X /lastshow false store
X checkCTM
X } bdef % generalstate
X /colorstate { %def
X mark currentcmykcolor
X colC colM colY colK 4 { %repeat
X dup 5 index ne 10 1 roll 8 1 roll
X } repeat
X cleartomark or or or {
X currentcmykcolor
X /colK exch store /colY exch store
X /colM exch store /colC exch store
X colC 0 eq colM 0 eq colY 0 eq and and not { %ifelse % COLOR
X colC writenum colM writenum colY writenum colK writenum
X (C) writeop
X }{ %else % GRAY
X 1 colK sub shave writenum (g) writeop
X } ifelse
X } if
X } bdef % colorstate
X /registerfont { %def
X % dup =string cvs print ( registered ) print 1 index == flush
X dup cachedir exch 20 dict put % allow 20 point sizes
X cachedir exch get % ptsize dict
X exch fontcount put
X } bdef
X /addfontsize { %def
X % dup =string cvs print ( point size ) print 1 index == flush
X cachedir exch get
X exch fontcount put
X } bdef
X
X /fontstate { %def
X currentfont null eq not { %if
X currentfont dup /ScaleMatrix known not { pop }{ %ifelse
X begin
X % determine if anything has changed:
X tmpmtx currentmatrix compareCTM matrixeq not
X currfontdict currentfont ne or
X ScaleMatrix CTM tmpmtx concatmatrix $fontscale matrixeq not or
X { %if
X % get and set new font names
X /origfontname
X /FontInfo where { %ifelse
X pop FontInfo /realname known
X { FontInfo /realname get }{ % ifelse
X currentdict /FontName known { FontName }{
X defaultfontname
X } ifelse
X } ifelse
X }{ %else
X currentdict /FontName known { FontName }{
X defaultfontname
X } ifelse
X } ifelse
X store
X /definefontname
X currentdict /FontName known { FontName }{
X origfontname
X } ifelse
X FontDirectory { %forall
X currentdict eq
X { exch pop exit }
X { pop } ifelse
X } forall
X store
X origfontname hidefontname
X % check for font reencoding:
X % The current font is the one required in the distilled
X % program. If it is a reeconded font, we must generate
X % a call to "REMAP", but at the same time let's mark it
X % so we don't generate too may "REMAP" calls.
X
X checksetup generalstate colorstate
X % worry about reencoding:
X /FontInfo where { %ifelse
X pop FontInfo /pleasemap known { %ifelse
X FontInfo /pleasemap get cvbool
X }{ %else
X false % evidently has not been reencoded...
X } ifelse % leaves a boolean
X }{ false } ifelse
X { % if remapping has not been done yet:
X Encoding hashencoding
X origfontname findfont /Encoding get hashencoding
X ne { %ifelse
X Encoding hashencoding
X STDvec cvnum eq { %ifelse
X (stdvec) writestr
X origfontname writeRname
X origfontname (/) wout writename
X ( REMAP) writeop
X }{ %else
X Encoding hashencoding PAGEvec cvnum eq {
X (pagevec) writestr
X origfontname writeRname
X origfontname (/) wout writename
X ( REMAP) writeop
X }{ %else
X origfontname findfont /Encoding get Encoding
X diffencoding writediffencoding
X origfontname writeRname
X origfontname (/) wout writename
X ( RECODE) writeop
X } ifelse
X } ifelse
X /FontInfo where { %if
X pop FontInfo /pleasemap known { %if
X FontInfo begin
X /pleasemap false hidebool
X end
X } if
X } if
X } if
X } if % /pleasemap
X % check font scale change:
X % This stuff is absolutely horrible....
X ScaleMatrix CTM $fontscale concatmatrix
X aload pop % Xscale 0a 0b Yscale 0 0
X pop pop 3 1 roll % X Y 0b 0a
X % if 0a and 0b are really both 0 ...
X % and X Y are equal and positive, then you can use
X % "scalefont", else you have to use "makefont"
X /0a exch store /0b exch store
X /X1 exch store /X2 exch store
X X1 X2 % leave on stack
X 0a 0b eq 0b 0 eq and % make sure 0's are 0
X X1 X2 EQ and % X1 and X2 are equal
X X1 dup abs eq X2 dup abs eq and % and positive
X and
X { %ifelse
X pop dup dup round EQ { round } if
X % if you find it in the "font dict cache"....
X cachedir definefontname known { %ifelse
X cachedir definefontname get dup 2 index known {
X exch get (F) wout writenum
X (F) writeop
X }{ %else
X pop
X /fontcount ++
X dup definefontname addfontsize
X (/F) wout fontcount writenum %+ cvnum writenum
X origfontname
X /FontInfo where { %ifelse
X pop FontInfo /pleasemap known { %ifelse
X FontInfo /pleasemap get cvbool
X }{ false } ifelse % leaves a boolean
X }{ false } ifelse
X Encoding hashencoding
X origfontname findfont /Encoding get
X hashencoding ne and
X { %ifelse
X writeRname
X }{ (/) wout writename } ifelse
X writenum % point size
X (DF) writeop
X } ifelse
X }{ %else if you DON'T find the name in the cache
X cachefonts { %if
X /fontcount ++
X dup definefontname registerfont
X (/F) wout fontcount writenum
X } if
X origfontname % either "FontName" or "FontNameR"
X /FontInfo where { %ifelse
X pop FontInfo /pleasemap known { %ifelse
X FontInfo /pleasemap get cvbool not
X }{ false } ifelse % leaves a boolean
X }{ false } ifelse
X Encoding hashencoding
X origfontname findfont /Encoding get
X hashencoding ne and
X { %ifelse
X writeRname
X }{ (/) wout writename } ifelse
X writenum % point size
X cachefonts { (DF) }{ (FF) } ifelse writeop
X } ifelse
X }{ %else
X % need either "makefont" or rotated coordinate system
X % careful.... there's still stuff on the stack.
X origfontname
X /FontInfo where {
X pop FontInfo /pleasemap known
X }{ false } ifelse { %ifelse
X writeRname
X }{ (/) wout writename } ifelse
X pop pop $fontscale aload pop curfontmtx astore
X dup 4 ScaleMatrix 4 get put
X dup 5 ScaleMatrix 5 get put % no translate
X writenumarray
X (MF) writeop
X } ifelse
X /currfontdict currentfont store
X } if % anything has changed
X end
X } ifelse
X beginsetup cvbool not {
X generalstate
X colorstate
X } if
X } if
X } bdef %fontstate
X
X /graphicstate { %def
X checksetup
X generalstate
X colorstate
X linewidth currentlinewidth XthruCTM ne {
X /linewidth currentlinewidth XthruCTM store
X linewidth shave writenum (w) writeop
X } if
X linecap currentlinecap ne {
X /linecap currentlinecap store
X linecap writenum (setlinecap) writeop
X } if
X linejoin currentlinejoin ne {
X /linejoin currentlinejoin store
X linejoin writenum (j) writeop
X } if
X miterlimit currentmiterlimit ne {
X /miterlimit currentmiterlimit store
X miterlimit shave writenum (setmiterlimit) writeop
X } if
X currentdash dashoff ne exch dasharray arrayne or {
X currentdash /dashoff exch store /dasharray exch store
X fd ([) writestring
X dasharray { XthruCTM writenum } forall
X fd (] ) writestring
X dashoff XthruCTM writenum (d) writeop
X } if
X gsave
X % don't clip to degenerate paths of any kind:
X newpath clippath hashpath cliphash ne { %if
X mark { pathbbox } stopped not {
X exch 4 -1 roll sub abs 1 gt
X 3 1 roll sub abs 1 gt and { % if
X writepath
X (clip newpath) writeop
X /cliphash hashpath store
X } if
X } if cleartomark
X } if
X grestore
X currentscreen
X /screenproc load ne exch screenang ne or exch screenfreq ne or { %if
X currentscreen
X /screenproc exch store
X /screenang exch store
X /screenfreq exch store
X screenfreq writenum screenang writenum writeNL
X /screenproc load
X dup type /arraytype eq
X 1 index type /packedarraytype eq or { %ifelse
X checkusernames
X }{ pop } ifelse
X /screenproc load writeproc
X (setscreen) writeop
X } if
X } bdef %graphicstate
X
Xend %adobe_distill
X/setpacking where { pop setpacking } if
X%%EndProcSet distill_graphicstate 1.0 0
X
X%%BeginProcSet: distill_optimize 1.0 0
X/adobe_distill dup where { pop pop }{ 165 200 add dict def } ifelse
Xadobe_distill begin
X % These procedures implement an optimization scheme for recognizing
X % sequences of "show" operations that could be optimized into calls
X % to "widthshow" (or just "show" with a longer string body). In
X % order to accomplish this, we have implemented a stack to store
X % string bodies until they are flushed by a font change, a change
X % in Y coordinate, or an inter-string space that is inconsistent.
X % When comparing coordinates for equality, anything with the given
X % tolerance is accepted as being equal (to combat roundoff error).
X /tolerance .05 ifnotdef
X /EQ { sub abs tolerance le } bdef
X /stack 250 array def
X /stackptr 0 def
X/setpacking where { pop currentpacking true setpacking } if
X /push { %def
X stackptr 0 eq { % if
X currentpoint thruCTM
X /showY exch store /showX exch store
X } if
X /stackptr stackptr 1 add store
X stackptr 249 ge { (STACK OVERFLOW!) r= flush exit } if
X stack stackptr 3 -1 roll put
X } bdef
X /pull { %def
X stack stackptr get
X /stackptr stackptr dup 0 gt { 1 sub } if store
X } bdef
X
X /*save systemdict /save get def
X /save { % def
X stackshow % in case there's anything pending....
X *save
X } bdef
X
X /*restore systemdict /restore get def
X /restore { % def
X % after save & restore, you may have to explicitly "undo" anything
X % that was done within the saved context. Since save & restore
X % affect all distillery state variables, we dump anything different
X % from the default graphics state:
X stackshow % in case there's anything pending....
X currentlinecap % 5
X currentlinewidth % 4
X currentgray % 3
X currentmiterlimit % 2
X currentlinejoin % 1
X 6 -1 roll *restore
X setlinejoin % 1
X setmiterlimit % 2
X setgray % 3
X setlinewidth % 4
X setlinecap % 5
X forcegstate % checkgstate %graphicstate
X } bdef
X
X /stackshow { %def
X stackptr 0 ne { %if
X messages {
X (stackshow: ) d=
X 1 1 stackptr { ( ) pr= stack exch get == } for
X } if
X% currfont /FontType known {
X% currfont /FontType get 3 eq {
X% ?distilling false setdistill
X% } if
X% } if
X stackptr 1 eq { %ifelse
X %- if there is only one string, use "show":
X pull writePSstring
X showX showY writepair (T) writeop
X }{ %else
X %- otherwise, build single string (with \b to use W):
X diffX 0 EQ not { % if
X gsave % figure out widthshow value
X currfont setfont
X diffX (\b) stringwidth CTM dtransform pop sub
X grestore
X writenum (0) writestr (\b) 0 get writenum
X (\\b) % padding character
X }{ % else
X () % empty padding character
X } ifelse
X (\() wout
X 1 1 stackptr 1 sub { % for
X stack exch get wordfix dup wout
X } for
X pop % padding character
X pull wordfix
X (\)) wout % writeNL
X showX showY writepair
X %- if diffX is 0, don't use "widthshow":
X diffX 0 EQ { (T) }{ (W) } ifelse writeop
X } ifelse
X /stackptr 0 store
X% currfont /FontType known {
X% currfont /FontType get 3 eq { setdistill } if
X% } if
X } if
X } bdef
X
X /setcurrpoint { %def
X currentpoint thruCTM
X /currY exch store /currX exch store
X } bdef % setcurrpoint
X
Xend %adobe_distill
X/setpacking where { pop setpacking } if
X%%EndProcSet distill_optimize 1.0 0
X
X%%BeginProcSet: distill_paintops 1.0 0
X/setpacking where { pop currentpacking true setpacking } if
X/adobe_distill dup where { pop pop }{ 165 200 add dict def } ifelse
Xadobe_distill begin
X
X % text operators
X /sameYcoords { %def
X % this is pulled out of the "show" proc for readability; it is
X % not used anywhere else
X currentfont currfont ne { %ifelse
X stackshow fontstate push
X }{ %else
X currentpoint thruCTM pop
X currX sub dup diffX EQ { %ifelse
X pop % dup'ed value
X push
X }{ %else
X diffX -1 eq { %ifelse
X /diffX exch store push
X }{ % else
X pop stackshow fontstate
X /diffX -1 store push
X } ifelse
X } ifelse
X } ifelse
X } bdef
X
X /*stringwidth /stringwidth load def
X /stringwidth { %def
X false setdistill *stringwidth true setdistill
X } bdef
X /show { %def
X checkCTM currentpoint thruCTM ?box
X optim { %ifelse
X dup length 0 eq { pop } { %ifelse
X dup % save string for use at the end
X lastshow not { %ifelse
X stackshow fontstate
X /currfont currentfont store
X push
X /diffX -1 store
X }{ % else
X % don't optimize if matrix is different...
X tmpmtx currentmatrix compareCTM matrixeq
X currentpoint thruCTM exch pop
X currY eq and { %ifelse Y = Y
X sameYcoords
X }{ %else currY ne
X stackshow % flush the pending show stack
X fontstate
X push % the string (and set showX, showY)
X /diffX -1 store
X } ifelse
X /currfont currentfont store
X } ifelse %lastshow
X currentfont dup null ne { /FontType known }{ pop false } ifelse
X { %gcr Fri May 5 15:22:16 1989
X currentfont /FontType get 3 eq {
X false setdistill show true setdistill
X }{ show } ifelse
X }{ false setdistill show true setdistill } ifelse
X setcurrpoint
X /lastshow true store
X } ifelse % if length is not 0
X }{ % else
X dup length 0 eq { pop } { %ifelse
X fontstate
X dup writePSstring currentpoint writeTpair
X (T) writeop
X currentfont dup null ne { /FontType known }{ pop false } ifelse
X { %gcr Fri May 5 15:22:45 1989
X currentfont /FontType get 3 eq {
X false setdistill show true setdistill
X }{ show } ifelse
X }{ false setdistill show true setdistill } ifelse
X } ifelse % if operand is not null string
X } ifelse
X currentpoint thruCTM ?box
X } bdef
X
X /widthshow { %def
X checkCTM currentpoint thruCTM ?box
X optim { %ifelse
X dup length 0 eq { 4{pop}repeat } { %ifelse
X 4 copy pop pop
X 1 index EQ exch 0.0 EQ and { % ifelse
X fontstate
X 4 1 roll pop pop pop
X show % make sure it's not "bound"
X }{ %else
X fontstate
X 4 copy
X 4 2 roll dthruCTM writepair %exch writeXnum writeYnum
X exch writenum writePSstring currentpoint writeTpair
X (W) writeop
X currentfont dup null ne {
X /FontType known
X }{ pop false } ifelse
X { %ifelse
X currentfont /FontType get 3 eq {
X false setdistill widthshow true setdistill
X }{ widthshow } ifelse
X }{ false setdistill widthshow true setdistill } ifelse
X } ifelse
X } ifelse
X }{ %else
X % Cx Cy char (string) widthshow
X dup length 0 eq { 4{pop}repeat } { %ifelse
X fontstate
X 4 copy
X % 4 -2 roll exch writeXnum writeYnum exch writenum
X 4 -2 roll dthruCTM writepair exch writenum
X writePSstring currentpoint writeTpair
X (W) writeop
X currentfont dup null ne { /FontType known }{ pop false } ifelse
X { %ifelse
X currentfont /FontType get 3 eq {
X false setdistill widthshow true setdistill
X }{ widthshow } ifelse
X }{ false setdistill widthshow true setdistill } ifelse
X } ifelse
X } ifelse
X currentpoint thruCTM ?box
X } bdef
X
X /ashow { %bdef
X checkCTM currentpoint thruCTM ?box
X optim { %ifelse
X dup length 0 eq { pop pop pop } { %ifelse
X 3 copy pop
X 1 index EQ exch 0.0 EQ and { % ifelse
X fontstate
X 3 1 roll pop pop
X show % make sure it's not "bound"
X }{ %else
X fontstate
X 3 copy
X 3 1 roll dthruCTM writepair
X writePSstring currentpoint writeTpair
X (A) writeop
X currentfont dup null ne { %ifelse
X /FontType known
X }{ pop false } ifelse
X { %ifelse
X currentfont /FontType get 3 eq {
X false setdistill ashow true setdistill
X }{ ashow } ifelse
X }{ false setdistill ashow true setdistill } ifelse
X } ifelse
X } ifelse
X }{ %else
X dup length 0 eq { pop pop pop } { %ifelse
X fontstate
X 3 copy
X 3 1 roll dthruCTM writepair % exch writeXnum writeYnum
X writePSstring currentpoint writeTpair
X (A) writeop
X currentfont dup null ne { %ifelse
X /FontType known
X }{ pop false } ifelse
X { %ifelse
X currentfont /FontType get 3 eq {
X false setdistill ashow true setdistill
X }{ ashow } ifelse
X }{ false setdistill ashow true setdistill } ifelse
X } ifelse
X } ifelse
X currentpoint thruCTM ?box
X } bdef
X
X /awidthshow { %def
X % Cx Cy 32 Ax Ay (string) awidthshow
X checkCTM currentpoint thruCTM ?box
X optim { %def
X dup length 0 eq { 6{pop}repeat } { %ifelse
X fontstate
X 6 copy 6 1 roll
X 1 index EQ exch 0.0 EQ and { %ifelse
X 4 1 roll 1 index eq exch 0.0 eq and { %leaves 32 (str)
X 8 1 roll 7 { pop } repeat
X show % make sure it's not "bound"
X }{ %else
X pop pop 3 1 roll pop pop
X widthshow % make sure it's not "bound"
X } ifelse
X }{ %else
X pop pop pop pop 6 copy 6 -3 roll pop
X 1 index EQ exch 0.0 EQ and { % ifelse
X 9 3 roll 6 { pop } repeat
X ashow % make sure it's not "bound"
X }{ %else
X pop pop pop 6 copy
X 6 -2 roll dthruCTM writepair
X 4 -1 roll writenum 3 1 roll dthruCTM writepair
X writePSstring currentpoint writeTpair
X (AW) writeop
X currentfont /FontType known {
X currentfont /FontType get 3 eq {
X false setdistill awidthshow true setdistill
X }{ awidthshow } ifelse
X }{ false setdistill awidthshow true setdistill } ifelse
X } ifelse
X } ifelse
X } ifelse
X }{ %else
X dup length 0 eq { 6{pop}repeat } { %ifelse
X fontstate
X 6 copy
X % 6 -2 roll exch writeXnum writeYnum
X % 4 -1 roll writenum 3 -1 roll writeXnum exch writeYnum
X 6 -2 roll dthruCTM writepair
X 4 -1 roll writenum 3 1 roll dthruCTM writepair
X writePSstring currentpoint writeTpair
X (AW) writeop
X currentfont /FontType known {
X currentfont /FontType get 3 eq {
X false setdistill awidthshow true setdistill
X }{ awidthshow } ifelse
X }{ false setdistill awidthshow true setdistill } ifelse
X } ifelse
X } ifelse
X currentpoint thruCTM ?box
X } bdef
X
X /kshow { %def
X (%AAAAAH: kshow) writeop
X kshow
X } bdef
X
X % graphics operators
X /fillguts { %def
X (starting fill) d=
X generalstate
X graphicstate
X % do nothing for empty path!
X hashpath -1 ne { writepath } if % watch for empty path!
X ischarpath { % if
X pathstr length 0 gt {
X pathX writenum pathY writenum (m) writeop
X pathstr writePSstring (false charpath) writeop
X } if
X gstates 0 le {
X /ischarpath false store
X /closed false store
X } if
X } if
X } bdef
X
X /fill { %def
X ?distilling cvbool { %if
X fillguts
X ?simplepath {
X simplepath aload pop
X 4 2 roll writepair (moveto) writeop writepair (lineto) writeop
X /?simplepath false store
X } if
X hashpath -1 ne { (f) writeop } if
X } if
X fill
X } bdef
X /eofill { %def
X ?distilling cvbool { %if
X fillguts
X ?simplepath { %ifelse
X simplepath aload pop
X 4 2 roll writepair (moveto) writeop writepair (lineto) writeop
X /?simplepath false store
X } if
X hashpath -1 ne { (eofill) writeop } if
X } if
X eofill
X } bdef
X
X /stroke { %def
X ?distilling cvbool { %if
X fillguts
X ?simplepath { %ifelse
X generalstate graphicstate
X simplepath aload pop
X 4 copy 3 -1 roll eq { %ifelse
X pop pop 4 -1 roll 2 index sub writenum
X writepair (X) writeop pop
X }{ %else
X eq { %ifelse
X 3 -1 roll 1 index sub writenum
X writepair (Y) writeop pop
X }{ %else
X writepair writepair (l) writeop
X } ifelse
X } ifelse
X %% writepair writepair (l) writeop
X /?simplepath false store
X }{ % else
X closed { (cp ) wout } if
X hashpath -1 ne { (s) writeop } if
X } ifelse
X } if
X stroke
X } bdef
X
X /clip { %def
X ?distilling cvbool { %if
X /lastshow false store
X } if
X clip
X } bdef
X /eoclip /clip load def
X /imageguts { % def
X graphicstate
X /imageproc exch store
X /imagematrix exch store
X /imagedepth exch store
X /imageheight exch store
X /imagewidth exch store
X % set up the call to "image" in the output file:
X (/imagesave save def) writeop
X CTM writenumarray (concat) writeop
X 0 0 thruCTM ?box
X imagewidth imagedepth dup type /booleantype eq { pop 1 } if
X div imageheight imagematrix itransform thruCTM ?box
X (/imagebuff) writestr
X imagedepth dup type /booleantype eq { pop 1 } if
X imagewidth mul dup dup 8 idiv 8 mul eq {8 idiv}{8 idiv 1 add} ifelse
X writenum ( string def) writeop
X % invoke "image" with correct args in output file:
X imagewidth writenum imageheight writenum
X imagedepth ( ) cvs writestr
X imagematrix writenumarray
X } bdef
X /image { %def % width height depth matrix { proc } :
X ?distilling cvbool { %ifelse
X imageguts
X ({ currentfile imagebuff readhexstring pop } image) writeop
X imagewidth imageheight imagedepth imagematrix
X { imageproc dup fd exch formathexstring writeNL } image
X (imagesave restore) writeop
X }{ image } ifelse
X } bdef
X /imagemask { % def % width height depth matrix { proc } :
X ?distilling cvbool { %ifelse
X imageguts
X ({ currentfile imagebuff readhexstring pop } imagemask) writeop
X imagewidth imageheight imagedepth imagematrix
X { imageproc dup fd exch formathexstring writeNL } imagemask
X (imagesave restore) writeop
X }{ imagemask } ifelse
X } bdef
X % don't actually print the pages... Fri Feb 17 13:13:10 1989
X % /*showpage systemdict /showpage get def
X /*showpage where { pop }{ %ifelse
X /*showpage /showpage load def
X } ifelse
X /showpage { %def
X stackshow
X pagecount cvnum scratch cvs wout ( ENDPAGE\n) wout
X (%%PageTrailer) writeop
X (%%PageFonts: ) wout
X pfontcount cvnum 0 eq { writeNL }{ %else
X pfontcount cvnum 200 lt { %ifelse
X pagefonts 0 pfontcount cvnum getinterval writeop
X }{ %else
X pagefonts (\040) search not { writeop }{ %else
X writeop % first one without the %%+
X { %loop
X search { (%%+ ) wout writeop }{ %else
X (\000) search { writeop pop pop }{ pop } ifelse
X exit
X } ifelse
X } loop
X } ifelse
X } ifelse
X } ifelse
X 0 1 pfontcount cvnum { pagefonts exch 0 put } for
X /pfontcount 0 hideval
X LLx 10000 eq LLy 10000 eq or URx -10000 eq URy -10000 eq or or not {
X (%%PageBoundingBox: ) wout
X LLx cvnum writenum LLy cvnum writenum
X URx cvnum writenum URy cvnum writenum writeNL
X pageBBox-docBBox
X } if
X /LLx 10000 hideval /LLy 10000 hideval
X /URx -10000 hideval /URy -10000 hideval
X *showpage
X checksetup
X /lastshowpage true hidebool
X /begunpage false hidebool
X /PAGEvec 0 hideval
X } bdef
X /*pathbbox systemdict /pathbbox get def
X /pathbbox { %def
X ?distilling cvbool { %if
X ischarpath { %ifelse
X gsave
X { currentpoint } stopped { 0 0 } if
X systemdict /moveto get exec
X pathstr false charpath flattenpath *pathbbox
X grestore
X }{ %else
X *pathbbox
X } ifelse
X } if
X } bdef
X /gsave { % def
X ?distilling cvbool { /gstates gstates 1 add store } if
X gsave
X } bdef
X /grestore { % def
X ?distilling cvbool { %if
X gstates 0 gt { %if
X /gstates gstates 1 sub store
X gstates charpathgstate lt { /ischarpath false store } if
X } if
X } if
X grestore
X } bdef
X /charpath { %def
X % need to make sure that when "stroke" or "fill" comes along
X % that the "charpath" elements are in the right place in the path...
X %- writepath
X ?distilling cvbool { %if
X checkgstate
X /ischarpath true store
X /charpathgstate gstates store
X /pathbool exch store
X /pathstr exch store
X { currentpoint } stopped { 0 0 } if thruCTM
X /pathY exch store /pathX exch store
X pathstr stringwidth rmoveto
X } if
X } bdef
X /newpath { %def
X ?distilling cvbool { gstates 0 le { /ischarpath false store } if } if
X newpath
X } bdef
X
Xend %adobe_distill
X/setpacking where { pop setpacking } if
X%%EndProcSet: distill_paintops 1.0 0
X
X%%BeginProcSet: distill_guessfont 1.0 0
X/setpacking where { pop currentpacking true setpacking } if
X/adobe_distill dup where { pop pop }{ 165 200 add dict def } ifelse
Xadobe_distill begin
X /*definefont systemdict /definefont get def
X /definefont { %def
X % make a dictionary into which to put things
X % put the ORIGINAL name of the font into that dictionary
X % put the original FID in that dictionary, for easy comparison
X dup /FontType known {
X dup /FontType get 3 eq { %ifelse
X dup begin
X includeuserfonts { %if
X (%%BeginFont: ) wout 1 index writename writeNL
X currentdict maxlength writenum (dict begin) writeop
X save
X /indentlevel ++
X unames /Encoding true put
X currentdict { %forall
X exch dup /Encoding eq { %ifelse
X indent (/) wout writename
X writenamearray ( def) writeop indent
X }{ %else
X % dup unames exch true put
X ( /) wout writename writeANY
X (def) writeop indent
X } ifelse
X } forall
X currentdict { pop unames exch true put } forall
X currentdict { exch pop arrayusernames } forall
X restore
X indent (currentdict end\n) wout
X 1 index writeANY (exch definefont pop) writeop
X (%%EndFont: ) wout 1 index writename writeNL
X } if
X currentdict /FontInfo known not
X currentdict /FontName known not or
X currentdict dup length 3 add exch maxlength ge and { %if
X % make slightly bigger version of current dictionary
X pop currentdict end
X dup maxlength 2 add dict begin
X { def } forall currentdict
X } if
X /FontInfo 5 dict def
X FontInfo begin
X /realname 2 index def
X /pleasemap magicbool def
X /pleasemap false hidebool
X end
X /FontName 2 index def
X end
X false
X }{ true } ifelse
X }{ true } ifelse
X % previous code leaves either true or false on stack
X { %if
X /Dfont exch store
X % This might be the first time we've ever seen a new
X % encoding. If so, let's guess that we'll see lots
X % more of the vector, and give it the name "stdvec".
X Dfont begin
X %gcr FontType 1 eq STDvec cvnum 0 eq and
X STDvec cvnum 0 eq
X Encoding StandardEncoding ne and { %if
X /STDvec Encoding hashencoding hideval
X fd (/stdvec\n) *writestring
X STDvec
X StandardEncoding hashencoding eq { %ifelse
X fd (StandardEncoding ) *writestring
X }{ %else
X Encoding writenamearray
X } ifelse
X fd (def\n) *writestring
X fd (stdvec /CourierR /Courier REMAP\n) *writestring
X % checksetup
X }{ %else
X %gcr FontType 1 eq STDvec cvnum 0 eq and
X STDvec cvnum 0 eq
X Encoding StandardEncoding ne and { %if
X /PAGEvec Encoding hashencoding hideval
X fd (/pagevec\n) *writestring
X PAGEvec
X StandardEncoding hashencoding eq { %ifelse
X fd (StandardEncoding ) *writestring
X }{ %else
X Encoding writenamearray
X } ifelse
X fd (def\n) *writestring
X % checksetup
X } if
X } ifelse
X end
X % try to find the "real" font in FontDirectory from which this
X % font was derived, assuming it was reencoded....
X /tempfontname /Courier store
X /tempfontname /UnKnownFont store
X FontDirectory { %forall
X /Ffont exch store /Fname exch store
X % if the font was already touched, ignore it:
X Ffont /FontInfo known { %ifelse
X Ffont /FontInfo get /realname known not
X }{ true } ifelse % leaves boolean
X { % if
X % if UniqueID's match, grab it!
X Dfont /UniqueID known Ffont /UniqueID known and {
X Dfont /UniqueID get Ffont /UniqueID get eq {
X /tempfontname Fname store exit
X } if
X } if
X } if % /realname is not there
X } forall
X tempfontname /UnKnownFont eq { %if
X Dfont begin
X FontDirectory { %forall
X /Ffont exch store /Fname exch store
X % if CharStrings match, then compare FontMatrix. If
X % FontMatrix matches or the *second* elements match,
X % (it might be oblique), then grab it.
X Dfont /FontType known {
X FontType 1 eq {
X Dfont/CharStrings known Ffont/CharStrings known and {
X Dfont/CharStrings get Ffont/CharStrings get eq {
X Dfont/FontMatrix known Ffont/FontMatrix known and {
X Dfont/FontMatrix get Ffont/FontMatrix get
X 2 copy eq 3 1 roll
X 2 get exch 2 get eq or {
X /tempfontname Fname store exit
X } if
X } if
X } if
X } if
X } if
X } if
X } forall
X end
X } if
X tempfontname /UnKnownFont eq { %if
X FontDirectory { %forall
X /Ffont exch store /Fname exch store
X % if everything matches but some keys, grab it
X true % start with "true" on stack
X Dfont { %forall
X exch dup /Encoding eq 1 index /FID eq or { %ifelse
X pop pop
X }{ % else
X dup Ffont exch known {
X Ffont exch get ne { pop false exit } if
X }{ pop pop } ifelse
X } ifelse
X } forall
X % use either "true" that was there, or "false" from loop
X { %if
X /tempfontname Fname store exit
X } if
X } forall
X } if
X tempfontname /UnKnownFont eq {
X Dfont /Encoding get StandardEncoding eq
X substitutefonts or { %ifelse
X % If there is no comparable fontdict already there, and
X % if this is of FontType 1 and has StandardEncoding,
X % we guess that this is a downloadable font, and ignore it
X Dfont /FontName known {
X /tempfontname Dfont /FontName get store
X }{
X /tempfontname /Courier store
X } ifelse
X (%substituting ) wout tempfontname writename writeNL
X messages {
X (substituting: ) pr= tempfontname ==
X } if
X Dfont % needed by *definefont below...
X }{ %else
X (ERROR: Couldn't find original fontdict to match: ) print
X Dfont /FontName get == flush
X (Fonts in FontDirectory include:) r=
X FontDirectory { pop (\040) print == } forall flush
X stop
X } ifelse
X } if
X Dfont /FontInfo known not
X Dfont /FontName known not or {
X Dfont dup length 3 add exch maxlength ge and { %if
X % make slightly bigger version of current dictionary
X Dfont maxlength 2 add dict begin
X Dfont { def } forall
X currentdict end /Dfont exch def
X } if
X } if
X Dfont dup begin
X /FontName 2 index def
X /FontInfo 5 dict def
X FontInfo begin
X /realname tempfontname def
X /pleasemap magicbool def
X /pleasemap
X tempfontname findfont /Encoding get
X StandardEncoding eq
X hidebool
X end
X end
X } if
X *definefont
X } bdef
X
Xend %adobe_distill
X/setpacking where { pop setpacking } if
X%%EndProcSet: distill_guessfont 1.0 0
X
X%%BeginProcSet: hacks 0.5 0
X % defeat the "transform round exch round exch itransform" trick:
X /round { } bdef
X /transform { dup type /arraytype eq { pop } if } bdef
X /itransform { dup type /arraytype eq { pop } if } bdef
X % redefine control-D:
X (\004) { (\n%%EOF) writeop } bdef
X%%EndProcSet: hacks 0.5 0
SHAR_EOF
if test 73248 -ne "`wc -c < 'still.ps'`"
then
echo shar: error transmitting "'still.ps'" '(should have been 73248 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
---