Article View: comp.lang.postscript
Article #7970Amazing program....
From: Glenn Reid
Date: Sat, 11 Feb 1989 05:42
Date: Sat, 11 Feb 1989 05:42
1873 lines
59968 bytes
59968 bytes
Enclosed in this package is an amazing PostScript program that I think
will help you enormously, if you take the time to figure out how to use
it. I call it the "Distillery." It actually filters through any
PostScript program and returns an extremely simple program that paints
the same picture, usually in far less time. It makes non-conforming PS
files into conforming files. It helps refute the claim that
"PostScript is slow", because it can make almost anything go fast. It
optimizes your program. It provides a benchmark to test your programs
against. It makes PostScript files editable, if you like, or provides
a uniform interchange format. The Distillery is many things.
But it isn't quite perfect yet. This is an experimental version that
still has a few bugs in it. Please use it and send me any bug reports,
especially those that come with a file that will provoke the bug. If
you have questions about it, post them, and maybe we can start a
discussion.
There's a fair amount of documentation inside the program, in the form
of comments.
Glenn Reid
PostScript Developer Tools & Strategies
Adobe Systems
------------------------- cut here ------------------------
%!PS-Adobe-2.0
%%Title: still.ps
%%Creator: Glenn Reid, Adobe Systems <adobe!greid@decwrl.dec.com>
%%CreationDate: greid Wed Jul 6 18:02:53 1988 EDIT: Fri Feb 10 19:06:24 1989
%%VMUsage: 40696
%%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 8 edit 07)) def
% options:
/debug false def
/messages false def
/trace false def % print tracing messages like "page: 3"
/substitutefonts true def % substitute fonts if guess_font fails....
/includeuserfonts false def % copy imbedded user-defined fonts to output?;
%
% 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
%
% MANY USES:
% * If you archive documents in PostScript format, they can be
% made as compact and efficient as possible 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 these 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", "clip", etc.
% * correctly follows "save", "restore", "gsave", "grestore"
% * re-encodes fonts automatically to match application encoding
% * reduces prologue size to only about 25-30 lines
% * 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 VERY, 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.
%
% 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.
%
% 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).
%
% 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)
%
% KNOWN PROBLEMS:
% Rotated text with "charpath" isn't working quite right.
%
% Does not really support color yet.
%
% 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.
%
% Relies on bug in save/restore related to string bodies to
% preserve some information across save/restore. Localized
% to the "adobe_staticvar" procedure set.
%
% 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 encounterd 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 definitely 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).
%%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
/setpacking where { pop setpacking } if
%%EndProcSet
%%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 { 4 string } bdef
/hideval { %def % /name int : % "hideval" uses save/restore bug!
exch load dup 0 (\040\040\040\040) putinterval
exch (\040\040\040\040) cvs dup length 4 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: ) print
docfonts 0 dfontcount cvnum getinterval = 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: ) print
pagefonts 0 pfontcount cvnum getinterval = 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
/optimize true def % optimize "show" variants
/tolerance .05 ifnotdef % for "approximately equal to" operations
/cachedir 60 dict def % how many fonts to hang onto
% 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
/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
/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
% a few of them go into userdict:
/cvp {
messages { % ifelse
( ) cvs print (\040) print
}{ pop } ifelse
} bdef
/pr= { messages { print }{ pop } ifelse } bdef
/d= { messages { = }{ pop } ifelse } bdef
/distill {
adobe_distill begin
debug { (%!PS-Adobe-2.0 debug version ) print dup == } if
userdict /orig_dictcount countdictstack put
count 0 eq { %ifelse
/OUTfile (%stdin) def
/fd (%stdout) (w) file def
initstill
writeprologue
initgstate
currentfile cvx exec
writetrailer
}{ %else
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: ) print 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 { =string cvs writeop } forall
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.) = } if
} if
} ifelse
end
} bdef
% the rest of them go in "adobe_distill"
adobe_distill begin
% /stopped {
% (stopped: ) print dup ==
% exec false
% } bdef
/initstill {
/beginsetup true hidebool
/lastshowpage false hidebool
/begunpage false hidebool
/pagecount 1 hideval
/STDvec 0 hideval
/PAGEvec 0 hideval
/dfontcount 0 hideval
/pfontcount 0 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
/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
/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 /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
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
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
exch writenum writenum
} repeat (c) writeop 6 {pop} repeat
} % curveto
{ % closepath
counttomark 0 gt { writelines } if
/closed true 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
%%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
} if
(%%Trailer) writeop
(end %PROLOGUE) writeop
(%%Pages: ) wout pagecount 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.0\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 (%%DocumentProcSets: Adobe_distill 0.807\n) writestring
fd (%%Pages: (atend)\n) writestring
fd (%%EndComments\n) writestring
} bdef
/writeprologue { %def % :
writecomments
mark
(%%BeginProcSet: Adobe_distill 0.807)
(/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)
( /c /curveto ldef /cp /closepath ldef)
( /s /stroke ldef /w /setlinewidth ldef)
( /g /setgray ldef /j /setlinejoin ldef)
( /d /setdash ldef /F /setfont ldef)
( /MF { findfont exch makefont setfont } bdef)
( /DF { findfont exch scalefont setfont 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 begin currentdict 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 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.807)
(%%EndProlog)
(%%BeginSetup)
(PROLOGUE begin)
% 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
} 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 (1 BEGINPAGE\n) writestring
/begunpage true hidebool
/fontcount 0 store
}{ %else
lastshowpage cvbool { %if
/lastshowpage false hidebool
/fontcount 0 store
(%%Page: ) wout
trace { (page: ) print pagecount cvnum == flush } if
/pagecount pagecount cvnum 1 add hideval
pagecount cvnum dup writenum writenum writeNL
(%%PageFonts: (atend)\n) 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
% 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 { 0 CTM dtransform pop } bdef
/*writestring { %def
writestring fd *flushfile
} bdef
/shave { %def
% eliminate significant digits beyond .001; compensate for roundoff
dup type /realtype eq { %if
1000 mul truncate 1000 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:
/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
/writename { % def % name :
scratch cvs fd exch writestring _space
} bdef
/writeRname { % def % name :
(/) wout scratch cvs wout (R ) wout
} bdef
/checkallnames { %def % proc :
{ % forall
dup type /nametype ne { pop }{ %ifelse
dup systemdict exch known { pop }{ % ifelse
dup xcheck not { pop }{ %ifelse
dup load dup type /arraytype eq %
{ checkallnames }{ pop } ifelse
(userdict /) wout dup writename
load writeANY
(put) writeop
} ifelse
} ifelse
} ifelse
} forall
} bdef
/writeproc { %def
({) writestr writeNL
insideproc exch /insideproc true store /indentlevel ++
dup type /arraytype eq 1 index type /packedarraytype eq or { % ifelse
dup length 20 lt { %ifelse
{ writeANY } forall
}{ %else
{ writeANY writeNL indent } forall
} ifelse
}{ %else
writename
} ifelse
/insideproc exch store /indentlevel --
indent (}) writestr
} bdef
/typedict 12 dict def
typedict begin
/stringtype { writePSstring } def
/arraytype { %def
dup xcheck { %ifelse
writeproc
}{ %else
/CNT 1 store
([) writeop /indentlevel ++ indent
{ indent writeANY writeNL } forall
% { %forall
% writeANY /CNT ++ CNT 10 gt { %if
% /CNT 1 store writeNL indent
% } if
% } forall
/indentlevel -- writeNL indent
(]) writeop
} ifelse
} bdef
/packedarraytype /arraytype load def
/dicttype { %def
dup maxlength writenum (dict begin) writeop
{ %forall
indent exch writeANY writeANY (def) writeop
} forall (currentdict end) writeop
} bdef
/integertype { writenum } def
/realtype { writenum } def
/nulltype { pop (null ) wout } def
/operatortype { %def
insideproc { %ifelse
writename
}{ %else
(/) wout writename (load) writestr
} ifelse
} bdef
/nametype { %def
dup xcheck not { (/) wout } 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 num>128 was found
str1 search {
quotefix % string previous to num>128
(\\) wout % the backslash
% write suspicious char as octal
0 get 8 scratch cvrs % padding with leading 0 as needed
dup length 3 exch sub { (0) wout } repeat wout
binaryfix % recurse on rest of string
}{
(ERROR: search lied in "binaryfix".) = 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
%%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
% /origCTM matrix currentmatrix def
/currCTM matrix currentmatrix def
/compareCTM matrix currentmatrix def
/newCTM matrix def
/mtx1 0 def
/mtx2 0 def
/invmtx
tmpmtx currentmatrix matrix invertmatrix
def
/$normalize {
invmtx currCTM concatmatrix
} bind def
/gray currentgray 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 matrix def
/fontscale initfontscale 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
/ischarpath false def
/currpath newpath hashpath def
/pathstr () def
/pathbool false def
/pathX 0 def /pathY 0 def
/lineX 0 def /lineY 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
/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
% procedure definitions for state machinery ---------------
/initgstate { %def
gsave
initgraphics
tmpmtx currentmatrix compareCTM matrixeq not {
/CTM mtx currentmatrix $normalize store
compareCTM currentmatrix pop
} if
/gray currentgray 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
/fontscale initfontscale store
/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
/fontscale initfontscale store
/currfontdict null store
/gray null store
% checkgstate % fontstate
} bdef % initgstate
/checkgstate { %def
graphicstate
fontstate
} def %checkgstate
/checkCTM { %def
% tmpmtx currentmatrix $normalize CTM matrixeq not {
% /CTM mtx currentmatrix $normalize store
% } if
tmpmtx currentmatrix compareCTM matrixeq not {
/CTM mtx currentmatrix $normalize store
compareCTM currentmatrix pop
} if
} bdef
/generalstate { %def
stackptr 0 ne { stackshow } if
/lastshow false store
checkCTM
} bdef % generalstate
/colorstate { %def
gray currentgray ne {
/gray currentgray store
gray shave writenum (g) writeop
} if
} bdef % colorstate
/registerfont { %def
dup cachedir exch 20 dict put % allow 20 point sizes
cachedir exch get % ptsize dict
exch fontcount put
} bdef
/addfontsize { %def
cachedir exch get
exch fontcount put
} bdef
/fontstate { %def
% (fontstate in: ) print count ==
currentfont dup /ScaleMatrix known not { pop }{ %ifelse
begin
% determine if anything has changed:
tmpmtx currentmatrix compareCTM matrixeq not
currfontdict currentfont ne or
ScaleMatrix fontscale ne or
{ %if
% get and set new font names
/origfontname
/FontInfo where { %ifelse
pop FontInfo /realname known
{ FontInfo /realname get }{ % ifelse
/FontName where {pop FontName}{/Unknown} ifelse
} ifelse
}{ %else
/FontName where {pop FontName}{/Unknown} ifelse
} ifelse
store
/definefontname
/FontName where { pop FontName }{ /Unknown } 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....
/fontscale ScaleMatrix store
fontscale CTM curfontmtx concatmatrix
aload pop % Xscale 0a 0b Yscale 0 0
% pop 3 -1 roll pop 3 -1 roll % X Y 0b 0a [wrong]
pop pop 3 1 roll % X Y 0b 0a
% if 2nd and 5th elements are 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 shave % eliminate unnecessary precision
% 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
writenum
origfontname
/FontInfo where { %ifelse
pop FontInfo /pleasemap known { %ifelse
FontInfo /pleasemap get cvbool
}{ false } ifelse % leaves a boolean
}{ false } ifelse
Encoding hashencoding %new!
origfontname findfont /Encoding get
hashencoding ne and
{ %ifelse
writeRname
}{ (/) wout writename } ifelse
(DF) writeop
} ifelse
}{ %else if you DON'T find the name in the cache
/fontcount ++
dup definefontname registerfont
(/F) wout fontcount writenum
writenum
origfontname
/FontInfo where { %ifelse
pop FontInfo /pleasemap known { %ifelse
FontInfo /pleasemap get cvbool not
}{ false } ifelse % leaves a boolean
}{ false } ifelse
Encoding hashencoding %new!
origfontname findfont /Encoding get
hashencoding ne and
{ %ifelse
writeRname
}{ (/) wout writename } ifelse
(DF) writeop
} ifelse
}{ %else
% need either "makefont" or rotated coordinate system
pop pop curfontmtx
dup 4 0. put dup 5 0. put % no translate
writenumarray
origfontname
/FontInfo where {
pop FontInfo /pleasemap known
}{ false } ifelse { %ifelse
writeRname
}{ (/) wout writename } ifelse
(MF) writeop
} ifelse
/currfontdict currentfont store
} if % anything has changed
end
} ifelse
beginsetup cvbool not {
generalstate
colorstate
} if
% (fontstate out: ) print count == () = flush
} 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 ne 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
checkallnames
}{ pop } ifelse
/screenproc load writeproc
(setscreen) writeop
} if
} bdef %graphicstate
end %adobe_distill
/setpacking where { pop setpacking } if
%%EndProcSet
%%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!) = 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
% initgstate
forcegstate % checkgstate %graphicstate
(after restore) d=
} bdef
/stackshow { %def
stackptr 0 ne { %if
(stackshow: ) d= 1 1 stackptr { ( ) pr= stack exch get d= } for
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
} if
} bdef
/setcurrpoint { %def
currentpoint thruCTM
/currY exch store /currX exch store
} bdef % setcurrpoint
end %adobe_distill
/setpacking where { pop setpacking } if
%%EndProcSet
%%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
optimize { %ifelse
/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
/show { %def
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 /FontType known {
currentfont /FontType get 3 eq {
end show adobe_distill begin
}{ show } ifelse
}{ end show adobe_distill begin } ifelse
setcurrpoint
/lastshow true store
} ifelse % if length is not 0
} bdef
}{ % else
/show { %def
dup length 0 eq { pop } { %ifelse
fontstate
dup writePSstring currentpoint writeTpair
(T) writeop
currentfont /FontType known {
currentfont /FontType get 3 eq {
end show adobe_distill begin
}{ show } ifelse
}{ end show adobe_distill begin } ifelse
} ifelse % if operand is not null string
} bdef
} ifelse
/widthshow optimize { %ifelse
{ %def
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 /FontType known {
currentfont /FontType get 3 eq {
end widthshow adobe_distill begin
}{ widthshow } ifelse
}{ end widthshow adobe_distill begin } ifelse
} ifelse
} ifelse
} % if optimized
}{ %else
{ %def % 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 /FontType known {
currentfont /FontType get 3 eq {
end widthshow adobe_distill begin
}{ widthshow } ifelse
}{ end widthshow adobe_distill begin } ifelse
} ifelse
} % if not optimized
} ifelse bdef
/ashow optimize { %ifelse
{ %def
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 /FontType known {
currentfont /FontType get 3 eq {
end ashow adobe_distill begin
}{ ashow } ifelse
}{ end ashow adobe_distill begin } ifelse
} ifelse
} ifelse
} % if optimized
}{ %else
{ %def
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 /FontType known {
currentfont /FontType get 3 eq {
end ashow adobe_distill begin
}{ ashow } ifelse
}{ end ashow adobe_distill begin } ifelse
} ifelse
} % if not optimized
} ifelse bdef
/awidthshow optimize { %ifelse
% Cx Cy 32 Ax Ay (string) awidthshow
{ %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 {
end awidthshow adobe_distill begin
}{ awidthshow } ifelse
}{ end awidthshow adobe_distill begin } ifelse
} ifelse
} ifelse
} ifelse
} % if optimized
}{ %else
{ %def
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 {
end awidthshow adobe_distill begin
}{ awidthshow } ifelse
}{ end awidthshow adobe_distill begin } ifelse
} ifelse
} % if not optimized
} ifelse bdef
% graphics operators
/fillguts { %def
(starting fill) d=
% I'm not sure why this was here to begin with, but it breaks "charpath"...
% gstates 0 le {
% /ischarpath false store
% /closed false store
% } if
generalstate
graphicstate
writepath
ischarpath { % if
pathstr length 0 gt {
pathX writenum pathY writenum (m) writeop
pathstr writePSstring (false charpath) writeop
} if
} if
} bdef
/fill { %def
fillguts
?simplepath { %ifelse
simplepath aload pop
4 2 roll writepair (moveto) writeop writepair (lineto) writeop
/?simplepath false store
} if
(f) writeop
fill
} bdef
/eofill { %def
fillguts
?simplepath { %ifelse
simplepath aload pop
4 2 roll writepair (moveto) writeop writepair (lineto) writeop
/?simplepath false store
} if
(eofill) writeop
eofill
} bdef
/stroke { %def
fillguts
?simplepath { %ifelse
generalstate graphicstate
simplepath aload pop writepair writepair (l) writeop
/?simplepath false store
}{ % else
closed { (cp ) wout } if
(s) writeop
} ifelse
stroke
} bdef
/clip { %def
/lastshow false store
clip
} bdef
/eoclip { clip } 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
(/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 } :
imageguts
({ currentfile imagebuff readhexstring pop } image) writeop
imagewidth imageheight imagedepth imagematrix
{ imageproc dup fd exch writehexstring writeNL } image
(imagesave restore) writeop
} bdef
/imagemask { % def % width height depth matrix { proc } :
imageguts
({ currentfile imagebuff readhexstring pop } imagemask) writeop
imagewidth imageheight imagedepth imagematrix
{ imageproc dup fd exch writehexstring writeNL } imagemask
(imagesave restore) writeop
} bdef
/*showpage systemdict /showpage get def
/showpage { %def
stackshow
pagecount cvnum scratch cvs wout ( ENDPAGE\n) wout
/lastshowpage true hidebool
/begunpage false hidebool
/PAGEvec 0 hideval
*showpage
(%%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
% checksetup
} bdef
/*moveto systemdict /moveto get def
/*pathbbox systemdict /pathbbox get def
/pathbbox { %def
ischarpath { %ifelse
gsave
{ currentpoint } stopped { 0 0 } if *moveto
pathstr false charpath flattenpath *pathbbox
grestore
}{ %else
*pathbbox
} ifelse
} bdef
/gsave { % def
/gstates gstates 1 add store
gsave
} bdef
/grestore { % def
gstates 0 gt { /gstates gstates 1 sub store } 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
checkgstate
/ischarpath true store
/pathbool exch store
/pathstr exch store
{ currentpoint } stopped { 0 0 } if thruCTM
/pathY exch store /pathX exch store
pathstr stringwidth rmoveto
} bdef
/newpath { %def
gstates 0 le { /ischarpath false store } if
newpath
} bdef
end %adobe_distill
/setpacking where { pop setpacking } if
%%EndProcSet: distill_paintops 1.0
%%BeginProcSet: distill_guessfont 1.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 get 3 eq { %ifelse
dup begin
includeuserfonts {
currentdict writeANY
1 index writeANY (exch definefont pop) writeop
} if
currentdict /FontInfo known {
/FontInfo 5 dict def
FontInfo begin
/realname 2 index def
/pleasemap magicbool def
/pleasemap false hidebool
end
} if
end
}{ %else
/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
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 CharStrings match, then compare FontMatrix. If
% FontMatrix matches or the *second* elements match,
% (it might be oblique), then grab it.
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 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
{ /tempfontname Fname store exit } if
} if % /realname is not there
} forall
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: ) print 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:) =
FontDirectory { pop (\040) print == } forall flush
stop
} ifelse
}{ %else
Dfont dup begin
/FontInfo 5 dict def
FontInfo begin
/realname tempfontname def
/pleasemap magicbool def
/pleasemap
tempfontname findfont /Encoding get
StandardEncoding eq
hidebool
end
end
} ifelse
} ifelse
*definefont
} bdef
end %adobe_distill
/setpacking where { pop setpacking } if
%%EndProcSet: distill_guessfont 1.0
%%BeginProcSet: hacks 0.5
% defeat the "transform round exch round exch itransform" trick:
/round { } def
/transform { dup type /arraytype eq { pop } if } bdef
/itransform { dup type /arraytype eq { pop } if } bdef
% redefine control-D:
(\004) { (\n%%EOF) writeop } def
%%EndProcSet: hacks 0.5
Technical Details
Message-ID:
<430@adobe.UUCP>Path:
arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!purdue!decwrl!adobe!greidReferences:
<4242@pt.cs.cmu.edu> <50250@yale-celray.yale.UUCP>Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!purdue!decwrl!adobe!greid From: greid@adobe.com (Glenn Reid) Newsgroups: comp.lang.postscript Subject: Amazing program.... Message-ID: <430@adobe.UUCP> Date: 11 Feb 89 05:42:11 GMT References: <4242@pt.cs.cmu.edu> <50250@yale-celray.yale.UUCP> Sender: news@adobe.COM Reply-To: greid@adobe.COM (Glenn Reid) Organization: Adobe Systems Incorporated, Mountain View Lines: 1873