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