🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.postscript
Article #7970

Amazing program....

#7970
From: Glenn Reid
Date: Sat, 11 Feb 1989 05:42
1873 lines
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!greid
References: <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