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