greid@adobe.com (Glenn Reid) (02/18/89)
Below is a slightly improved version of the "still.ps" program I posted last week. I have tracked down a bug related to its sometimes getting the wrong font, you can now control whether or not the original page gets printed by simply redefining "/showpage {} def" beforehand (it previously went directly into systemdict to avoid recursion problems if you loaded it twice). Thank you to those of you who have sent me test files in the mail. I hope those problems are all fixed now, although for those "hand-written" PostScript files that have nested loops (like fractals, for instance), there isn't much hope of generating a smaller file with the Distillery, unfortunately. Here is a quick followup to another TranScript-related problem, too: In article <4143@omepd.UUCP> merlyn@intelob.intel.com (Randal L. Schwartz @ Stonehenge) writes: >In article <3258@uhccux.uhcc.hawaii.edu>, richard@uhccux (Richard Foulk) writes: > It doesn't seem to work for me. I followed the directions under > How to use:/Printers: but the stuff just gets printed instead > of being sent to my log file. I've tried all kinds of input. The version that was posted will always print the page, but it should have showed up in the log file, too. > Sometimes I get a little something in the log file, like this: > ------------------ > umentFonts: > %%EOF Hmmm. That looks like the very end of what the Distillery would be sending back. Some kind of communication problem. I'm not sure what to suggest. Especially if other output comes back OK. Try changing the flags at the beginning of the file. In particular, change "debug" and/or "messages" to "true" and see if you get anything back. >I use Transcript under Ultrix 2.0 (I think), and have gotten similar >results. Basically, the log-file contains *almost* everything, but >any line that (was expected to) begin > > %%XYZ... > >gets edited to > > %%YZ... > >making the resulting file re-laserable but non-conforming. (Yes, the >first character after the double percent disappears... not one of the >percents, meaning I have to muck with the source to print some extra >garbage to get the right thing... yuck.) I think this was a problem with TranScript that has been fixed. If you don't have version 2.1 of TranScript, you might consider ordering an update. I think it costs $75 and you can get it by calling Phil Smith at Adobe through the main number at 415-961-4400. >I was also surprised when the first 'distilling' also *prints* the >document... this wasn't clear from your documentation (I was >expecting a simple translation pass, not a print). Whether or not the page prints is now up to you. Tweak the conditional called "printpages" at the beginning of the file.... Thanks for the flood of interesting mail related to this. Some of you might consider posting your experiences, since many were interesting. Glenn Reid Adobe Systems -------------------------------- cut here --------------------------- %!PS-Adobe-2.1 %%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 17 13:27:22 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 9 edit 02)) 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 true def % copy embedded user-defined fonts to output?; /printpages false def % do you want the pages to print? % % HOW TO USE: [see section below] % % OVERVIEW: % This is a meta-utility program that "distills" any PostScript % language program into a simpler one. The resulting program % will print exactly the same page as the original, but all % unnecessary execution overhead is eliminated and the file is % clean, uniform, and fast. % % RELEASE NOTES: [recent changes and details] % First public release: 2/10/89 % Second release: 2/17/89 % - reimplemented guess_font routines % - added support for color; not careful about RGB->CMYK->RGB % - added selective printing of pages during distill % % 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 printpages not { %if /showpage { erasepage initgraphics } bind def } if /currentcmykcolor where { pop }{ %else /currentcmykcolor { %def currentrgbcolor 3 { 1 exch sub 3 1 roll } repeat 0 } bind def } ifelse /setpacking where { pop setpacking } if %%EndProcSet %%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.1 debug version ) print adobe_still_version == }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 load type /arraytype eq { ostack { =string cvs writeop } forall } if fd systemdict /flushfile get exec handleerror end end } if } ifelse writetrailer fd closefile countdictstack orig_dictcount sub { end } repeat clear saveall { restore } stopped { %if trace { (couldn't restore after distill.) = } 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.1\n) writestring fd (%%Title: ) writestring fd OUTfile writestring fd (\n) writestring fd (%%Creator: Glenn Reid and still.ps ) writestring fd adobe_still_version writestring fd (\n) writestring fd (%%DocumentProcSets: Adobe_distill 0.902\n) writestring fd (%%Pages: (atend)\n) writestring fd (%%EndComments\n) writestring } bdef /writeprologue { %def % : writecomments mark (%%BeginProcSet: Adobe_distill 0.902) (/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) ( /C /setcmykcolor where { /setcmykcolor get }{ %ifelse) ( { pop 3{1 exch sub 3 1 roll} repeat setrgbcolor } bind) ( } ifelse def) ( /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.902) (%%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 writeANY writeNL } forall % { %forall % writeANY /CNT ++ CNT 10 gt { %if % /CNT 1 store writeNL indent % } if % } forall /indentlevel -- indent (]) writeop } ifelse } bdef /packedarraytype /arraytype load def /dicttype { %def % safety: 1 add (needed for User Fonts) dup maxlength 1 add 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 currentcmykcolor /currK exch def /currY exch def /currM exch def /currC exch def /linewidth currentlinewidth def /linecap currentlinecap def /linejoin currentlinejoin def /miterlimit currentmiterlimit def /screenang null def /screenfreq null def /screenproc null def /closed false def currentdash /dashoff exch def /dasharray exch def /pointX -1 def /pointY -1 def /initfontscale 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 currentcmykcolor /currK exch store /currY exch store /currM exch store /currC exch store /linewidth currentlinewidth XthruCTM store /linecap currentlinecap store /linejoin currentlinejoin store /miterlimit currentmiterlimit store currentdash /dashoff exch store /dasharray exch store /origfontname /InvalidFont store /definefontname /InvalidFont store /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 /currC 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 mark currentcmykcolor currC currM currY currK 4 { %repeat dup 5 index eq 10 1 roll 8 1 roll } repeat cleartomark or or or { currentcmykcolor /currK exch store /currY exch store /currM exch store /currC exch store currC 0 eq currM 0 eq currY 0 eq and and not { currC writenum currM writenum currY writenum currK writenum (C) writeop }{ %else 1 currK sub shave writenum (g) writeop } ifelse } if % 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 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 } 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 % don't actually print the pages... Fri Feb 17 13:13:10 1989 % /*showpage systemdict /showpage get def /*showpage where { pop }{ %ifelse /*showpage /showpage load def } ifelse /showpage { %def stackshow pagecount cvnum scratch cvs wout ( ENDPAGE\n) wout /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 % /realname is not there } forall tempfontname /UnKnownFont eq { %if FontDirectory { %forall /Ffont exch store /Fname exch store % if CharStrings match, then compare FontMatrix. If % FontMatrix matches or the *second* elements match, % (it might be oblique), then grab it. FontType 1 eq { Dfont/CharStrings known Ffont/CharStrings known and { Dfont/CharStrings get Ffont/CharStrings get eq { Dfont/FontMatrix known Ffont/FontMatrix known and { Dfont/FontMatrix get Ffont/FontMatrix get 2 copy eq 3 1 roll 2 get exch 2 get eq or { /tempfontname Fname store exit } if } if } if } if } if } forall } if tempfontname /UnKnownFont eq { %if FontDirectory { %forall /Ffont exch store /Fname exch store % if everything matches but some keys, grab it true % start with "true" on stack Dfont { %forall exch dup /Encoding eq 1 index /FID eq or { %ifelse pop pop }{ % else dup Ffont exch known { Ffont exch get ne { pop false exit } if }{ pop pop } ifelse } ifelse } forall % use either "true" that was there, or "false" from loop { %if /tempfontname Fname store exit } if } forall } if tempfontname /UnKnownFont eq { Dfont /Encoding get StandardEncoding eq substitutefonts or { %ifelse % If there is no comparable fontdict already there, and % if this is of FontType 1 and has StandardEncoding, % we guess that this is a downloadable font, and ignore it Dfont /FontName known { /tempfontname Dfont /FontName get store }{ /tempfontname /Courier store } ifelse (%substituting ) wout tempfontname writename writeNL messages { (substituting: ) 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 } if 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 *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