home *** CD-ROM | disk | FTP | other *** search
- % Copyright (C) 1991, 1995 Aladdin Enterprises. All rights reserved.
- %
- % This file is part of Aladdin Ghostscript.
- %
- % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND. No author
- % or distributor accepts any responsibility for the consequences of using it,
- % or for whether it serves any particular purpose or works at all, unless he
- % or she says so in writing. Refer to the Aladdin Ghostscript Free Public
- % License (the "License") for full details.
- %
- % Every copy of Aladdin Ghostscript must include a copy of the License,
- % normally in a plain ASCII text file named PUBLIC. The License grants you
- % the right to copy, modify and redistribute Aladdin Ghostscript, but only
- % under certain conditions described in the License. Among other things, the
- % License requires that the copyright notice and this notice be preserved on
- % all copies.
-
- % Extract the ASCII text from a PostScript file. Nothing is displayed.
- % Instead, ASCII information is written to stdout. The idea is similar to
- % Glenn Reid's `distillery', only a lot more simple-minded, and less robust.
-
- % If SIMPLE is defined, just the text is written, with a guess at line
- % breaks and word spacing. If SIMPLE is not defined, lines are written
- % to stdout as follows:
- %
- % F <height> <width> (<fontname>)
- % Indicate the font height and the width of a space.
- %
- % P
- % Indicate the end of the page.
- %
- % S <x> <y> (<string>) <width>
- % Display a string.
- %
- % <width> and <height> are integer dimensions in units of 1/720".
- % <x> and <y> are integer coordinates, in units of 1/720", with the origin
- % at the lower left.
- % <string> and <fontname> are strings represented with the standard
- % PostScript escape conventions.
-
- % If COMPLEX is defined, the following additional types of lines are
- % written to stdout.
- %
- % C <r> <g> <b>
- % Indicate the current color.
- %
- % I <x> <y> <width> <height>
- % Note the presence of an image.
- %
- % R <x> <y> <width> <height>
- % Fill a rectangle.
- %
- % <r>, <g>, and <b> are RGB values expressed as integers between 0 and 1000.
- %
- % Note that future versions of this program (in COMPLEX mode) may add
- % other output elements, so programs parsing the output should be
- % prepared to ignore elements that they do not recognize.
-
- % Note that this code will only work in all cases if systemdict is writable
- % and if `binding' the definitions of operators defined as procedures
- % is deferred. For this reason, it is normally invoked with
- % gs -q -dNODISPLAY -dNOBIND -dWRITESYSTEMDICT ps2ascii.ps
-
- % Thanks to J Greely <jgreely@cis.ohio-state.edu> for improvements
- % to this code, and to Jerry Whelan <jerryw@abode.ccd.bnl.gov> for
- % motivating other improvements.
-
- /QUIET true def
- systemdict wcheck { systemdict } { userdict } ifelse begin
- /.max where { pop } { /.max { 2 copy lt { exch } if pop } bind def } ifelse
- /COMPLEX dup where { pop true } { false } ifelse def
- /SIMPLE dup where { pop true } { false } ifelse def
- /setglobal where
- { pop currentglobal /setglobal load true setglobal }
- { { } }
- ifelse
-
- % Define a way to store and retrieve integers that survives save/restore.
- /.i.string0 (0 ) def
- /.i.string .i.string0 length string def
- /.iget { cvi } bind def
- /.iput { exch //.i.string exch copy cvs pop } bind def
- /.inew { //.i.string0 dup length string copy } bind def
-
- % We only want to redefine operators if they are defined already.
-
- /codef { 1 index where { pop def } { pop pop } ifelse } def
-
- % Redefine the end-of-page operators.
-
- /erasepage { } codef
- /copypage { SIMPLE { (\014) } { (P\n) } ifelse //print } codef
- /showpage { copypage erasepage initgraphics } codef
-
- % Redefine the fill operators to detect rectangles.
-
- /.orderrect % <llx> <lly> <urx> <ury> .orderrect <llx> <lly> <w> <h>
- { % Ensure llx <= urx, lly <= ury.
- 1 index 4 index lt { 4 2 roll } if
- dup 3 index lt { 3 1 roll exch } if
- exch 3 index sub exch 2 index sub
- } odef
- /.fillcomplex
- { % Do a first pass to see if the path is all rectangles in
- % the output coordinate system. We don't worry about overlapping
- % rectangles that might be partially not filled.
- % Stack: mark llx0 lly0 urx0 ury0 ... true mark x0 y0 ...
- mark true mark
- % Add a final moveto so we pick up any trailing unclosed subpath.
- 0 0 itransform moveto
- { .coord counttomark 2 gt
- { counttomark 4 gt { .fillcheckrect } { 4 2 roll pop pop } ifelse }
- if
- }
- { .coord }
- { cleartomark not mark exit }
- { counttomark -2 roll 2 copy counttomark 2 roll .fillcheckrect }
- pathforall cleartomark
- { .showcolor counttomark 4 idiv
- { counttomark -4 roll .orderrect
- (R ) //print .show==4
- }
- repeat pop
- }
- { cleartomark
- }
- ifelse
- } odef
- /.fillcheckrect
- { % Check whether the current subpath is a rectangle.
- % If it is, add it to the list of rectangles being accumulated;
- % if not exit the .fillcomplex loop.
- % The subpath has not been closed.
- % Stack: as in .fillcomplex, + newx newy
- counttomark 10 eq { 9 index 9 index 4 2 roll } if
- counttomark 12 ne { cleartomark not mark exit } if
- 12 2 roll
- % Check for the two possible forms of rectangles:
- % x0 y0 x0 y1 x1 y1 x1 y0 x0 y0
- % x0 y0 x1 y0 x1 y1 x0 y1 x0 y0
- 9 index 2 index eq 9 index 2 index eq and
- 10 index 9 index eq
- { % Check for first form.
- 7 index 6 index eq and 6 index 5 index eq and 3 index 2 index eq and
- }
- { % Check for second form.
- 9 index 8 index eq and
- 8 index 7 index eq and 5 index 4 index eq and 4 index 3 index eq and
- }
- ifelse not { cleartomark not mark exit } if
- % We have a rectangle.
- pop pop pop pop 4 2 roll pop pop 8 4 roll
- } odef
- /eofill { COMPLEX { .fillcomplex } if newpath } codef
- /fill { COMPLEX { .fillcomplex } if newpath } codef
- /rectfill { gsave newpath .rectappend fill grestore } codef
- /ueofill { gsave newpath uappend eofill grestore } codef
- /ufill { gsave newpath uappend fill grestore } codef
-
- % Redefine the stroke operators to detect rectangles.
-
- /rectstroke
- { gsave newpath
- dup type dup /arraytype eq exch /packedarraytype eq or
- { dup length 6 eq { exch .rectappend concat } { .rectappend } ifelse }
- { .rectappend }
- ifelse stroke grestore
- } codef
- /.strokeline % <fromx> <fromy> <tox> <toy> .strokeline <tox> <toy>
- % Note: fromx and fromy are in output coordinates;
- % tox and toy are in user coordinates.
- { .coord 2 copy 6 2 roll .orderrect
- % Add in the line width. Assume square or round caps.
- currentlinewidth 2 div dup .dcoord add abs 1 max 5 1 roll
- 4 index add 4 1 roll 4 index add 4 1 roll
- 4 index sub 4 1 roll 5 -1 roll sub 4 1 roll
- (R ) //print .show==4
- } odef
- /.strokecomplex
- { % Do a first pass to see if the path is all horizontal and vertical
- % lines in the output coordinate system.
- % Stack: true mark origx origy curx cury
- true mark null null null null
- { .coord 6 2 roll pop pop pop pop 2 copy }
- { .coord 1 index 4 index eq 1 index 4 index eq or
- { 4 2 roll pop pop }
- { cleartomark not mark exit }
- ifelse
- }
- { cleartomark not mark exit }
- { counttomark -2 roll 2 copy counttomark 2 roll
- 1 index 4 index eq 1 index 4 index eq or
- { pop pop 2 copy }
- { cleartomark not mark exit }
- ifelse
- }
- pathforall cleartomark
- 0 currentlinewidth .dcoord 0 eq exch 0 eq or and
- % Do the second pass to write out the rectangles.
- % Stack: origx origy curx cury
- { .showcolor null null null null
- { 6 2 roll pop pop pop pop 2 copy .coord }
- { .strokeline }
- { }
- { 3 index 3 index .strokeline }
- pathforall pop pop pop pop
- }
- if
- } odef
- /stroke { COMPLEX { .strokecomplex } if newpath } codef
- /ustroke
- { gsave newpath
- dup length 6 eq { exch uappend concat } { uappend } ifelse
- stroke grestore
- } codef
-
- % The image operators must read the input and note the dimensions.
- % Eventually we should redefine these to detect 1-bit-high all-black images,
- % since this is how dvips does underlining (!).
-
- /.noteimagerect % <width> <height> <matrix> .noteimagerect -
- { COMPLEX
- { gsave setmatrix itransform 0 0 itransform
- grestore .coord 4 2 roll .coord .orderrect
- (I ) //print .show==4
- }
- { pop pop pop
- }
- ifelse
- } odef
- /colorimage where
- { pop /colorimage
- { 1 index
- { dup 6 add index 1 index 6 add index 2 index 5 add index }
- { 6 index 6 index 5 index }
- ifelse .noteimagerect gsave nulldevice //colorimage grestore
- } codef
- } if
- /.noteimage % Arguments as for image[mask]
- { dup type /dicttype eq
- { dup /Width get 1 index /Height get 2 index /ImageMatrix get }
- { 4 index 4 index 3 index }
- ifelse .noteimagerect
- } odef
- /image { .noteimage gsave nulldevice //image grestore } codef
- /imagemask { .noteimage gsave nulldevice //imagemask grestore } codef
-
- % Output the current color if necessary.
- /.color.r .inew def
- .color.r -1 .iput % make sure we write the color at the beginning
- /.color.g .inew def
- /.color.b .inew def
- /.showcolor
- { COMPLEX
- { currentrgbcolor
- 1000 mul round cvi
- 3 1 roll 1000 mul round cvi
- exch 1000 mul round cvi
- % Stack: b g r
- dup //.color.r .iget eq
- 2 index //.color.g .iget eq and
- 3 index //.color.b .iget eq and
- { pop pop pop
- }
- { (C ) //print
- dup //.color.r exch .iput .show==only
- ( ) //print dup //.color.g exch .iput .show==only
- ( ) //print dup //.color.b exch .iput .show==only
- (\n) //print
- }
- ifelse
- }
- if
- } bind def
-
- % Redefine `show'.
-
- % Set things up so our output will be in tenths of a point, with origin at
- % lower left. This isolates us from the peculiarities of individual devices.
-
- /.show.ident.matrix matrix def
- /.show.ident
- % { //.show.ident.matrix defaultmatrix
- % % Assume the original transformation is well-behaved.
- % 0.1 0 2 index dtransform abs exch abs .max /.show.scale exch def
- % 0.1 dup 3 -1 roll scale
- { gsave initmatrix
- % Assume the original transformation is well-behaved.
- 0.1 0 dtransform abs exch abs .max /.show.scale exch def
- 0.1 dup scale .show.ident.matrix currentmatrix
- grestore
- } bind def
- /.coord
- { transform .show.ident itransform
- exch round cvi exch round cvi
- } odef
- /.dcoord
- { % Transforming distances is trickier, because
- % the coordinate system might be rotated.
- .show.ident pop
- exch 0 dtransform
- dup mul exch dup mul add sqrt
- .show.scale div round cvi
- exch 0 exch dtransform
- dup mul exch dup mul add sqrt
- .show.scale div round cvi
- } odef
-
- % Remember the current X, Y, and height.
- /.show.x .inew def
- /.show.y .inew def
- /.show.height .inew def
- % Remember the last character of the previous string; if it was a
- % hyphen preceded by a letter, we didn't output the hyphen.
- /.show.last (\000) def
- % Remember the current font.
- /.font.name 130 string def
- /.font.name.length .inew def
- /.font.height .inew def
- /.font.width .inew def
-
- % We have to redirect stdout somehow....
- /.show.stdout { (%stdout) (w) file } bind def
-
- % Make sure writing will work even if a program uses =string.
- /.show.string =string length string def
- /.show.=string =string length string def
- /.show==only
- { //=string //.show.=string copy pop
- dup type /stringtype eq
- { dup length //.show.string length le
- { dup rcheck { //.show.string copy } if
- } if
- } if
- .show.stdout exch write==only
- //.show.=string //=string copy pop
- } odef
- /.show==4
- { 4 -1 roll .show==only ( ) //print
- 3 -1 roll .show==only ( ) //print
- exch .show==only ( ) //print
- .show==only (\n) //print
- } odef
-
- /.showwidth % Same as stringwidth, but disable COMPLEX so that
- % we don't try to detect rectangles during BuildChar.
- { COMPLEX
- { /COMPLEX false def stringwidth /COMPLEX true def }
- { stringwidth }
- ifelse
- } odef
- /.showfont % <string> .showfont <string>
- { gsave
- % Try getting the height and width of the font from the FontBBox.
- currentfont /FontBBox .knownget not { {0 0 0 0} } if
- aload pop exch 4 -1 roll sub 3 1 roll exch sub
- 2 copy .max 0 ne
- { currentfont /FontMatrix get dtransform
- }
- { pop pop
- % Fonts produced by dvips, among other applications, have
- % BuildChar procedures that bomb out when given unexpected
- % characters, and there is no way to determine whether a given
- % character will do this. So for Type 1 fonts, we measure a
- % typical character ('X'); for others, we punt.
- currentfont /FontType get 1 eq
- { (X) .showwidth pop dup 1.3 mul
- }
- { % No safe way to get the character size. Punt.
- 0 0
- }
- ifelse
- }
- ifelse .dcoord exch
- currentfont /FontName .knownget not { () } if
- dup type /stringtype ne { //.show.string cvs } if
- grestore
- % Stack: height width fontname
- SIMPLE
- { pop pop //.show.height exch .iput }
- { 2 index //.font.height .iget eq
- 2 index //.font.width .iget eq and
- 1 index //.font.name 0 //.font.name.length .iget getinterval eq and
- { pop pop pop
- }
- { (F ) //print
- 3 -1 roll dup //.font.height exch .iput .show==only ( ) //print
- exch dup //.font.width exch .iput .show==only ( ) //print
- dup length //.font.name.length exch .iput
- //.font.name cvs .show==only (\n) //print
- }
- ifelse
- }
- ifelse
- } odef
-
- % Define the letters -- characters which, if they occur followed by a hyphen
- % at the end of a line, cause the hyphen and line break to be ignored.
- /.letter.chars 100 dict def
- mark
- 65 1 90 { dup 32 add } for
- counttomark { StandardEncoding exch get .letter.chars exch dup put } repeat
- pop
-
- % Define a set of characters which, if they occur at the start of a line,
- % are taken as indicating a paragraph break.
- /.break.chars 50 dict def
- mark
- /bullet /dagger /daggerdbl /periodcentered /section
- counttomark { .break.chars exch dup put } repeat
- pop
-
- % Define character translation to ASCII.
- % We have to do this for the entire character set.
- /.char.map 500 dict def
- /.chars.def { counttomark 2 idiv { .char.map 3 1 roll put } repeat pop } def
- % Encode the printable ASCII characters.
- mark 32 1 126
- { 1 string dup 0 4 -1 roll put
- dup 0 get StandardEncoding exch get exch
- }
- for .chars.def
- % Encode accents.
- mark
- /acute (') /caron (^) /cedilla (,) /circumflex (^)
- /dieresis (") /grave (`) /ring (*) /tilde (~)
- .chars.def
- % Encode the ISO accented characters.
- mark 192 1 255
- { ISOLatin1Encoding exch get =string cvs
- dup 0 1 getinterval 1 index dup length 1 sub 1 exch getinterval
- .char.map 2 index known .char.map 2 index known and
- { .char.map 3 -1 roll get .char.map 3 -1 roll get concatstrings
- .char.map 3 1 roll put
- }
- { pop pop pop
- }
- ifelse
- }
- for .chars.def
- % Encode the remaining standard and ISO alphabetic characters.
- mark
- /AE (AE) /Eth (DH) /OE (OE) /Thorn (Th)
- /ae (ae) /eth (dh)
- /ffi (ffi) /ffl (ffl) /fi (fi) /fl (fl)
- /germandbls (ss) /oe (oe) /thorn (th)
- .chars.def
- % Encode the other standard and ISO characters.
- mark
- /brokenbar (|) /bullet (*) /copyright ((C)) /currency (#)
- /dagger (#) /daggerdbl (##) /degree (o) /divide (/) /dotaccent (.)
- /dotlessi (i)
- /ellipsis (...) /emdash (--) /endash (-) /exclamdown (!)
- /florin (f) /fraction (/)
- /guillemotleft (<<) /guillemotright (>>)
- /guilsingleft (<) /guilsingright (>) /hungarumlaut ("") /logicalnot (~)
- /macron (_) /minus (-) /mu (u) /multiply (*)
- /ogonek (,) /onehalf (1/2) /onequarter (1/4) /onesuperior (1)
- /ordfeminine (-a) /ordmasculine (-o)
- /paragraph (||) /periodcentered (*) /perthousand (o/oo) /plusminus (+-)
- /questiondown (?) /quotedblbase (") /quotedblleft (") /quotedblright (")
- /quotesinglbase (,) /quotesingle (') /registered ((R))
- /section ($) /sterling (#)
- /threequarters (3/4) /threesuperior (3) /trademark ((TM)) /twosuperior (2)
- /yen (Y)
- .chars.def
- % Encode a few common Symbol characters.
- mark
- /asteriskmath (*) /copyrightsans ((C)) /copyrightserif ((C))
- /greaterequal (>=) /lessequal (<=) /registersans ((R)) /registerserif ((R))
- /trademarksans ((TM)) /trademarkserif ((TM))
- .chars.def
-
- % Write out a string. If it ends in a letter and a hyphen,
- % don't write the hyphen, and set .show.last to a hyphen;
- % otherwise, set .show.last to the character (or \000 if it was a hyphen).
- /.show.write % <string> .show.write -
- { dup length 1 ge
- { dup dup length 1 sub get
- dup 45 eq % hyphen
- { 1 index length 1 gt
- { 1 index dup length 2 sub get }
- { //.show.last 0 get }
- ifelse
- currentfont /Encoding get exch get
- //.letter.chars exch known
- { % Remove the hyphen
- exch dup length 1 sub 0 exch getinterval exch
- }
- { pop 0
- }
- ifelse
- }
- if
- //.show.last 0 3 -1 roll put
- }
- if
- { dup currentfont /Encoding get exch get
- % Stack: charcode charname
- dup //.char.map exch .knownget
- { .show.stdout exch writestring pop pop
- }
- { currentfont /Encoding get dup StandardEncoding eq
- exch ISOLatin1Encoding eq or
- { % Untranslated character in standard encoding
- pop .show.stdout exch write
- }
- { % Character in non-standard encoding, substitute
- pop pop .show.stdout (*) writestring
- }
- ifelse
- }
- ifelse
- }
- forall
- } odef
- /.showstring1
- { currentpoint .coord
- 3 -1 roll dup .showwidth 1 index 0 rmoveto
- .dcoord pop
- % Stack: x y string width
- SIMPLE
- { 2 index //.show.y .iget ne
- { % Try to figure out whether we have a line break
- % or a paragraph break.
- 2 index //.show.y .iget sub abs
- //.show.height .iget 1.3 mul ge
- 2 index length 0 gt
- { 2 index 0 get currentfont /Encoding get exch get
- //.break.chars exch known { pop true } if
- }
- if
- { (\n\n) % Paragraph
- }
- { ( ) % Line
- }
- ifelse //print
- //.show.y 3 index .iput
- //.show.x 4 index .iput
- }
- { % If the word processor split a hyphenated word within
- % the same line, put out the hyphen now.
- //.show.last 0 get 45 eq { (-) //print } if
- }
- ifelse
- 3 index //.show.x .iget 10 add gt
- { ( ) //print
- }
- if
- 4 1 roll .show.write pop add //.show.x exch .iput
- }
- { (S ) //print .show==4
- }
- ifelse
- } odef
- /.showstring
- { dup () eq { pop } { .showstring1 } ifelse
- } bind def
-
- % Redefine all the string display operators.
-
- /show
- { .showfont .showcolor .showstring
- } codef
-
- % We define all the other operators in terms of .show1.
- /.show1.string ( ) def
- /.show1 { //.show1.string exch 0 exch put //.show1.string .showstring } odef
- /ashow
- { .showfont .showcolor
- { .show1 2 copy rmoveto } forall
- pop pop
- } codef
- /awidthshow
- { .showfont .showcolor
- { dup .show1 4 index eq { 4 index 4 index rmoveto } if
- 2 copy rmoveto
- }
- forall
- pop pop pop pop pop
- } codef
- /widthshow
- { .showfont .showcolor
- //.show1.string 0 4 -1 roll put
- { //.show1.string search not { exit } if
- .showstring .showstring
- 2 index 2 index rmoveto
- } loop
- .showstring pop pop
- } codef
- /kshow
- { .showfont .showcolor
- %**************** Should construct a closure, in case the procedure
- %**************** affects the o-stack.
- { .show1 dup exec } forall pop
- } codef
- % We don't really do the right thing with the Level 2 show operators,
- % but we do something semi-reasonable.
- /xshow { pop show } codef
- /yshow { pop show } codef
- /xyshow { pop show } codef
- /glyphshow
- { currentfont /Encoding .knownget not { {} } if
- 0 1 2 index length 1 sub
- { % Stack: glyph encoding index
- 2 copy get 3 index eq { exch pop exch pop null exit } if
- }
- for null eq { (X) dup 0 4 -1 roll put show } { pop } ifelse
- } codef
-
- % Redirect the printing operators.
-
- /.stdout (_temp_.out) (w) file def
- /.stderr (_temp_.err) (w) file def
- %****************
- %/print { //.stdout exch writestring } codef
- %/=only { //.stdout exch write=only } codef
- %/==only { //.stdout exch write==only } codef
-
- end
-
- % Bind the operators we just defined, and all the others if we didn't
- % do it before. Also reenable 'bind' for future files.
-
- .bindoperators
- NOBIND currentdict systemdict ne and
- { systemdict begin .bindoperators end }
- if
- NOBIND
- { /bind /.bind load def }
- if
-
- % Make systemdict read-only if it wasn't already.
-
- systemdict wcheck { systemdict readonly pop } if
-
- % Restore the current local/global VM mode.
-
- exec
-