diff options
Diffstat (limited to 'Master/tlpkg/tlgs/lib/font2pcl.ps')
-rw-r--r--[-rwxr-xr-x] | Master/tlpkg/tlgs/lib/font2pcl.ps | 1206 |
1 files changed, 603 insertions, 603 deletions
diff --git a/Master/tlpkg/tlgs/lib/font2pcl.ps b/Master/tlpkg/tlgs/lib/font2pcl.ps index 8da03b0f85f..e5ee4e35a8a 100755..100644 --- a/Master/tlpkg/tlgs/lib/font2pcl.ps +++ b/Master/tlpkg/tlgs/lib/font2pcl.ps @@ -1,603 +1,603 @@ -% Copyright (C) 1993, 1994, 1995, 1997 Aladdin Enterprises. All rights reserved.
-%
-% This software is provided AS-IS with no warranty, either express or
-% implied.
-%
-% This software is distributed under license and may not be copied,
-% modified or distributed except as expressly authorized under the terms
-% of the license contained in the file LICENSE in this distribution.
-%
-% For more information about licensing, please refer to
-% http://www.ghostscript.com/licensing/. For information on
-% commercial licensing, go to http://www.artifex.com/licensing/ or
-% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
-% San Rafael, CA 94903, U.S.A., +1(415)492-9861.
-
-% $Id: font2pcl.ps 6300 2005-12-28 19:56:24Z giles $
-% font2pcl.ps
-% Write out a font as a PCL bitmap font.
-
-/pcldict 60 dict def
-
-% Write out the current font as a PCL bitmap font.
-% The current transformation matrix defines the font size and orientation.
-
-/WriteResolution? false def % true=use "resolution bound font" format,
- % false=use older format
-
-/LJ4 false def % true=use LJ4 Typeface code
- % false=use LJIIP/IID/IIIx Typeface code
-
-pcldict begin % internal procedures
-
-/findstring % <string> <substring> findstring <bool>
- { search { pop pop pop true } { pop false } ifelse
- } def
-
- % Determine which set of keywords is present in a string.
- % The last keyword set must be empty.
-
-/keysearch % <string> <array of arrays of keywords> keysearch <index>
- { 0 1 2 index length 1 sub
- { 2 copy get true exch
- { % Stack: <string> <a.a.k.> <index> <bool> <keyword>
- 4 index exch findstring and
- }
- forall
- { 0 exch getinterval exit
- }
- if pop
- }
- for
- exch pop length % invalid index if missing
- } def
-
- % Determine the device height of a string in quarter-dots.
-
-/charheight % <string> charheight <int>
- { gsave newpath 0 0 moveto false charpath
- pathbbox exch pop exch sub exch pop 0 exch grestore
- dtransform add abs 4 mul cvi
- } def
-
- % Compute an integer version of the transformed FontBBox.
-
-/inflate % <num> inflate <num>
- { dup 0 gt { ceiling } { floor } ifelse
- } def
-/ixbbox % - ixbbox <llx> <lly> <urx> <ury>
- { /FontBBox load aload pop % might be executable or literal
- 4 2 roll transform exch truncate cvi exch truncate cvi
- 4 2 roll transform exch inflate cvi exch inflate cvi
- } def
-
- % Determine the original font of a possibly transformed font.
- % Since some badly behaved PostScript files construct transformed
- % fonts "by hand", we can't just rely on the OrigFont pointers.
- % Instead, if a font with the given name exists, and if its
- % entries for FontType and UniqueID match those of the font we
- % obtain by following the OrigFont chain, we use that font.
-
-/origfont
- { { dup /OrigFont known not { exit } if /OrigFont get } loop
- FontDirectory 1 index /FontName get .knownget
- { % Stack: origfont namedfont
- 1 index /FontType get 1 index /FontType get eq
- { 1 index /UniqueID .knownget
- { 1 index /UniqueID .knownget
- { eq { exch } if }
- { pop }
- ifelse
- }
- if
- }
- if pop
- }
- if
- } def
-
-
- % Determine the bounding box of the current device's image.
- % Free variables: row, zerow.
-
-/devbbox % <rw> <rh> devbbox <ymin> <ymax1> <xmin> <xmax1>
- { % Find top and bottom whitespace.
- dup
- { dup 0 eq { exit } if 1 sub
- dup currentdevice exch row copyscanlines
- zerow ne { 1 add exit } if
- }
- loop % ymax1
- 0
- { 2 copy eq { exit } if
- dup currentdevice exch row copyscanlines
- zerow ne { exit } if
- 1 add
- }
- loop % ymin
- exch
- % Find left and right whitespace.
- 3 index 0
- % Stack: rw rh ymin ymax1 xmin xmax1
- 3 index 1 4 index 1 sub
- { currentdevice exch row copyscanlines .findzeros
- exch 4 1 roll .max 3 1 roll .min exch
- }
- for % xmin xmax1
- % Special check: xmin > xmax1 if height = 0
- 2 copy gt { exch pop dup } if
- 6 -2 roll pop pop
-
- } def
-
- % Write values on outfile.
-
- /w1 { 255 and outfile exch write } def
- /w2 { dup -8 bitshift w1 w1 } def
- /wbyte % <byte> <label> wbyte
- { VDEBUG { print ( =byte= ) print dup == flush } { pop } ifelse w1
- } def
- /wword % <word16> <label> wword
- { VDEBUG { print ( =word= ) print dup == flush } { pop } ifelse w2
- } def
- /wdword % <word32> <label> wdword
- { VDEBUG { print ( =dword= ) print dup == flush } { pop } ifelse
- dup -16 bitshift w2 w2
- } def
-
-/style.posture.keys
- [ { (Italic) } { (Oblique) }
- { }
- ] def
-/style.posture.values <010100> def
-
-/style.appearance.width.keys
- [ { (Ultra) (Compressed) }
- { (Extra) (Compressed) }
- { (Extra) (Condensed) }
- { (Extra) (Extended) }
- { (Extra) (Expanded) }
- { (Compressed) }
- { (Condensed) }
- { (Extended) }
- { (Expanded) }
- { }
- ] def
-/style.appearance.width.values <04030207070201060600> def
-
-/width.type.keys
- [ { (Ultra) (Compressed) }
- { (Extra) (Compressed) }
- { (Extra) (Condensed) }
- { (Extra) (Expanded) }
- { (Compressed) }
- { (Condensed) }
- { (Expanded) }
- { }
- ] def
-/width.type.values <fbfcfd03fdfe0200> def
-
-/stroke.weight.keys
- [ { (Ultra) (Thin) }
- { (Ultra) (Black) }
- { (Extra) (Thin) }
- { (Extra) (Light) }
- { (Extra) (Bold) }
- { (Extra) (Black) }
- { (Demi) (Light) }
- { (Demi) (Bold) }
- { (Semi) (Light) }
- { (Semi) (Bold) }
- { (Thin) }
- { (Light) }
- { (Bold) }
- { (Black) }
- { }
- ] def
-/stroke.weight.values <f907fafc0406fe02ff01fbfd030500> def
-
-/vendor.keys
- [ { (Agfa) }
- { (Bitstream) }
- { (Linotype) }
- { (Monotype) }
- { (Adobe) }
- { }
- ] def
-/vendor.default.index 4 def % might as well be Adobe
-/old.vendor.values <020406080a00> def
-/new.vendor.values <010203040500> def
-/vendor.initials (CBLMA\000) def
-
-currentdict readonly end pop % pcldict
-
-
-% Convert and write a PCL font for the current font and transformation.
-
-% Write the font header. We split this off only to avoid overflowing
-% the limit on the maximum size of a procedure.
-% Free variables: outfile uury u0y rw rh orientation uh ully
-/writefontheader
- { outfile (\033\)s) writestring
- outfile 64 WriteResolution? { 4 add } if
- Copyright length add write==only
- outfile (W) writestring
- WriteResolution? { 20 68 } { 0 64 } ifelse
- (Font Descriptor Size) wword
- (Header Format) wbyte
- 1 (Font Type) wbyte
- FullName style.posture.keys keysearch style.posture.values exch get
- FullName style.appearance.width.keys keysearch
- style.appearance.width.values exch get 4 mul add
- PaintType 2 eq { 32 add } if
- /style exch def
- style -8 bitshift (Style MSB) wbyte
- 0 (Reserved) wbyte
- /baseline uury 1 sub u0y sub def
- baseline (Baseline Position) wword
- rw (Cell Width) wword
- rh (Cell Height) wword
- orientation (Orientation) wbyte
- FontInfo /isFixedPitch .knownget not { false } if
- { 0 } { 1 } ifelse (Spacing) wbyte
- % Use loop/exit to fake a multiple-exit block.
- { Encoding StandardEncoding eq { 10 (J) exit } if
- Encoding ISOLatin1Encoding eq { 11 (J) exit } if
- Encoding SymbolEncoding eq { 19 (M) exit } if
- Encoding DingbatsEncoding eq { 10 (L) exit } if
-% (Warning: unknown Encoding, using ISOLatin1.\n) print flush
- 11 (J) exit
- }
- loop
- 0 get 64 sub exch 32 mul add (Symbol Set) wword
- ( ) stringwidth pop 0 dtransform add abs 4 mul
- /pitch exch def
- pitch cvi (Pitch) wword
- uh 4 mul (Height) wword % Height
- (x) charheight (x-Height) wword
- FullName width.type.keys keysearch
- width.type.values exch get (Width Type) wbyte
- style 255 and (Style LSB) wbyte
- FullName stroke.weight.keys keysearch
- stroke.weight.values exch get (Stroke Weight) wbyte
- FullName vendor.keys keysearch
- dup vendor.initials exch get 0 eq
- { % No vendor in FullName, try Notice
- pop Copyright vendor.keys keysearch
- dup vendor.initials exch get 0 eq { pop vendor.default.index } if
- }
- if
- /vendor.index exch def
- 0 (Typeface LSB) wbyte % punt
- 0 (Typeface MSB) wbyte % punt
- 0 (Serif Style) wbyte % punt
- 2 (Quality) wbyte
- 0 (Placement) wbyte
- gsave FontMatrix concat rot neg rotate
- /ulwidth
- FontInfo /UnderlineThickness .knownget
- { 0 exch dtransform exch pop abs }
- { resolution 100 div }
- ifelse def
- FontInfo /UnderlinePosition .knownget
- { 0 exch transform exch pop negY ulwidth 2 div add }
- { ully ulwidth add }
- ifelse u0y sub
- round cvi 1 .max 255 .min (Underline Position) wbyte
- ulwidth round cvi 1 .max 255 .min (Underline Thickness) wbyte
- grestore
- uh 1.2 mul 4 mul cvi (Text Height) wword
- (average lowercase character) dup stringwidth
- pop 0 dtransform add abs
- exch length div 4 mul cvi (Text Width) wword
- 0
- { dup Encoding exch get /.notdef ne { exit } if
- 1 add
- }
- loop (First Code) wword
- 255
- { dup Encoding exch get /.notdef ne { exit } if
- 1 sub
- }
- loop (Last Code) wword
- pitch dup cvi sub 256 mul cvi (Pitch Extended) wbyte
- 0 (Height Extended) wbyte
- 0 (Cap Height) wword % (default)
- currentfont /UniqueID known { UniqueID } { 0 } ifelse
- 16#c1000000 add (Font Number (Adobe UniqueID)) wdword
- FontName length 16 .max string
- dup FontName exch cvs pop
- outfile exch 0 16 getinterval writestring % Font Name
- WriteResolution?
- { resolution dup (X Resolution) wword (Y Resolution) wword
- }
- if
- outfile Copyright writestring % Copyright
- } def
-
-/writePCL % <fontfile> <resolution> writePCL -
- {
- save
- currentfont begin
- pcldict begin
- 80 dict begin % allow for recursion
- /saved exch def
- /resolution exch def
- /outfile exch def
- matrix currentmatrix dup 4 0 put dup 5 0 put setmatrix
-
- % Supply some default values so we don't have to check later.
-
- currentfont /FontInfo known not { /FontInfo 1 dict def } if
- currentfont /FontName known not { /FontName () def } if
- /Copyright FontInfo /Notice .knownget not { () } if def
- /FullName
- FontInfo /FullName .knownget not
- { FontName dup length string cvs }
- if def
-
- % Determine the original font, and its relationship to this one.
-
- /OrigFont currentfont origfont def
- /OrigMatrix OrigFont /FontMatrix get def
- /OrigMatrixInverse OrigMatrix matrix invertmatrix def
- /ScaleMatrix matrix currentfont OrigFont ne
- { FontMatrix exch OrigMatrixInverse exch concatmatrix
- } if
- def
- /CurrentScaleMatrix
- matrix currentmatrix
- matrix defaultmatrix
- dup 0 get 1 index 3 get mul 0 lt
- 1 index dup 1 get exch 2 get mul 0 gt or
- /flipY exch def
- dup invertmatrix
- dup concatmatrix
- def
- /negY flipY { {neg} } { {} } ifelse def
-
- % Print debugging information.
-
- /CDEBUG where { pop } { /CDEBUG false def } ifelse
- /VDEBUG where { pop } { /VDEBUG false def } ifelse
- CDEBUG { /VDEBUG true def } if
- DEBUG
- { (currentmatrix: ) print matrix currentmatrix ==
- (defaultmatrix: ) print matrix defaultmatrix ==
- (flipY: ) print flipY ==
- (scaling matrix: ) print CurrentScaleMatrix ==
- (FontMatrix: ) print FontMatrix ==
- (FontBBox: ) print /FontBBox load ==
- currentfont OrigFont ne
- { OrigFont /FontName .knownget { (orig FontName: ) print == } if
- (orig FontMatrix: ) print OrigMatrix ==
- } if
- currentfont /ScaleMatrix .knownget { (ScaleMatrix: ) print == } if
- gsave
- FontMatrix concat
- (combined matrix: ) print matrix currentmatrix ==
- grestore
- flush
- } if
-
- % Determine the orientation.
-
- ScaleMatrix matrix currentmatrix dup concatmatrix
- 0 1 3
- { 1 index 1 get 0 eq 2 index 2 get 0 eq and 2 index 0 get 0 gt and
- { exit } if
- pop -90 matrix rotate exch dup concatmatrix
- }
- for
- dup type /integertype ne
- { (Only rotations by multiples of 90 degrees are supported:\n) print
- == flush
- saved end end end restore stop
- }
- if
- /orientation exch def
- /rot orientation 90 mul def
- DEBUG { (orientation: ) print orientation == flush } if
-
- dup dup 0 get exch 3 get negY sub abs 0.5 ge
- { (Only identical scaling in X and Y is supported:\n) print
- exch flipY 3 array astore ==
- currentdevice .devicename ==
- matrix defaultmatrix == flush
- saved end end end restore stop
- }
- if pop
-
- % Determine the font metrics, in the PCL character coordinate system,
- % which has +Y going towards the top of the page.
-
- gsave
- FontMatrix concat
- 0 0 transform
- negY round cvi /r0y exch def
- round cvi /r0x exch def
- ixbbox
- negY /rury exch def /rurx exch def
- negY /rlly exch def /rllx exch def
- /rminx rllx rurx .min def
- /rminy rlly negY rury negY .min def
- /rw rurx rllx sub abs def
- /rh rury rlly sub abs def
- gsave rot neg rotate
- 0 0 transform
- negY round cvi /u0y exch def
- round cvi /u0x exch def
- ixbbox
- negY /uury exch def /uurx exch def
- negY /ully exch def /ullx exch def
- /uw uurx ullx sub def
- /uh uury ully sub def
- grestore
- DEBUG
- { (rmatrix: ) print matrix currentmatrix ==
- (rFontBBox: ) print [rllx rlly rurx rury] ==
- (uFontBBox: ) print [ullx ully uurx uury] ==
- flush
- } if
- grestore
-
- % Disable the character cache, to avoid excessive allocation
- % and memory sandbars.
-
- mark cachestatus /upper exch def
- cleartomark 0 setcachelimit
-
- % Write the font header.
-
- writefontheader
-
- % Establish an image device for rasterizing characters.
-
- matrix currentmatrix
- dup 4 rminx neg put
- dup 5 rminy neg put
- % Round the width up to a multiple of 8
- % so we don't get garbage bits in the last byte of each row.
- rw 7 add -8 and rh <ff 00> makeimagedevice
- /cdevice exch def
- nulldevice % prevent page device switching
- cdevice setdevice
-
- % Rasterize each character in turn.
-
- /raster rw 7 add 8 idiv def
- /row raster string def
- /zerow row length string def
- 0 1 Encoding length 1 sub
- { /cindex exch def
- Encoding cindex get /.notdef ne
- { VDEBUG { Encoding cindex get == flush } if
- erasepage initgraphics
- 0 0 moveto currentpoint transform add
- ( ) dup 0 cindex put show
- currentpoint transform add exch sub round cvi
- /cwidth exch abs def
- rw rh devbbox
- VDEBUG
- { (image bbox: ) print 4 copy 4 2 roll 4 array astore == flush
- } if
- % Save the device bounding box.
- % Note that this is in current device coordinates,
- % not PCL (right-handed) coordinates.
- /bqx exch def /bpx exch def /bqy exch def /bpy exch def
- % Re-render with the character justified to (0,0).
- % This may be either the lower left or the upper left corner.
- bpx neg bpy neg idtransform moveto
- erasepage
- VDEBUG { (show point: ) print [ currentpoint transform ] == flush } if
- ( ) dup 0 cindex put show
- % Find the bounding box. Note that xmin and ymin are now 0,
- % xmax1 = xw, and ymax1 = yh.
- rw rh devbbox
- /xw exch def
- % xmin or ymin can be non-zero only if the character is blank.
- xw 0 eq
- { pop }
- { dup 0 ne { (Non-zero xmin! ) print = } { pop } ifelse }
- ifelse
- /yh exch def
- yh 0 eq
- { pop }
- { dup 0 ne { (Non-zero ymin! ) print = } { pop } ifelse }
- ifelse
-
- /xbw xw 7 add 8 idiv def
- /xright raster 8 mul xw sub def
- % Write the Character Code command.
- outfile (\033*c) writestring
- outfile cindex write==only
- outfile (E) writestring
- % Write the Character Definition command.
- outfile (\033\(s) writestring
- yh xbw mul 16 add
- outfile exch write=only
- % Record the character position for the .PCM file.
- /cfpos outfile fileposition 1 add def
- outfile (W\004\000\016\001) writestring
- orientation (Orientation) wbyte 0 (Reserved) wbyte
- rminx bpx add r0x sub (Left Offset) wword
- flipY { rminy bpy add neg } { rminy bqy add } ifelse r0y sub
- (Top Offset) wword
- xw (Character Width) wword
- yh (Character Height) wword
- cwidth orientation 2 ge { neg } if 4 mul (Delta X) wword
- % Write the character data.
- flipY { 0 1 yh 1 sub } { yh 1 sub -1 0 } ifelse
- { cdevice exch row copyscanlines
- 0 xbw getinterval
- CDEBUG
- { dup
- { 8
- { dup 128 ge { (+) } { (.) } ifelse print
- 127 and 1 bitshift
- }
- repeat pop
- }
- forall (\n) print
- }
- if
- outfile exch writestring
- }
- for
- }
- { /bpx 0 def /bpy 0 def /bqx 0 def /bqy 0 def
- /cwidth 0 def
- /cfpos 0 def
- }
- ifelse
-
- }
- for
-
- % Wrap up.
-
- upper setcachelimit
- outfile closefile
-
- nulldevice % prevent page device switching
- saved end end end restore
-
- } def
-
-% Provide definitions for testing with older or non-custom interpreters.
-
-/.findzeros where { pop (%END) .skipeof } if
-/.findzeros
- { userdict begin /zs exch def /zl zs length def
- 0 { dup zl ge { exit } if dup zs exch get 0 ne { exit } if 1 add } loop
- zl { dup 0 eq { exit } if dup 1 sub zs exch get 0 ne { exit } if 1 sub } loop
- exch 3 bitshift exch 3 bitshift
- 2 copy lt
- { exch zs 1 index -3 bitshift get
- { dup 16#80 and 0 ne { exit } if exch 1 add exch 1 bitshift } loop pop
- exch zs 1 index -3 bitshift 1 sub get
- { dup 1 and 0 ne { exit } if exch 1 sub exch -1 bitshift } loop pop
- }
- if end
- } bind def
-%END
-
-/write=only where { pop (%END) .skipeof } if
-/w=s 128 string def
-/write=only
- { w=s cvs writestring
- } bind def
-%END
-
-%**************** Test
-/PCLTEST where {
- pop
- /DEBUG true def
- /CDEBUG true def
- /VDEBUG true def
- /Times-Roman findfont 10 scalefont setfont
- (t.pcf) (w) file
- 300 72 div dup scale
- 300 writePCL
- flush quit
-} if
+% Copyright (C) 1993, 1994, 1995, 1997 Aladdin Enterprises. All rights reserved. +% +% This software is provided AS-IS with no warranty, either express or +% implied. +% +% This software is distributed under license and may not be copied, +% modified or distributed except as expressly authorized under the terms +% of the license contained in the file LICENSE in this distribution. +% +% For more information about licensing, please refer to +% http://www.ghostscript.com/licensing/. For information on +% commercial licensing, go to http://www.artifex.com/licensing/ or +% contact Artifex Software, Inc., 101 Lucas Valley Road #110, +% San Rafael, CA 94903, U.S.A., +1(415)492-9861. + +% $Id: font2pcl.ps 6300 2005-12-28 19:56:24Z giles $ +% font2pcl.ps +% Write out a font as a PCL bitmap font. + +/pcldict 60 dict def + +% Write out the current font as a PCL bitmap font. +% The current transformation matrix defines the font size and orientation. + +/WriteResolution? false def % true=use "resolution bound font" format, + % false=use older format + +/LJ4 false def % true=use LJ4 Typeface code + % false=use LJIIP/IID/IIIx Typeface code + +pcldict begin % internal procedures + +/findstring % <string> <substring> findstring <bool> + { search { pop pop pop true } { pop false } ifelse + } def + + % Determine which set of keywords is present in a string. + % The last keyword set must be empty. + +/keysearch % <string> <array of arrays of keywords> keysearch <index> + { 0 1 2 index length 1 sub + { 2 copy get true exch + { % Stack: <string> <a.a.k.> <index> <bool> <keyword> + 4 index exch findstring and + } + forall + { 0 exch getinterval exit + } + if pop + } + for + exch pop length % invalid index if missing + } def + + % Determine the device height of a string in quarter-dots. + +/charheight % <string> charheight <int> + { gsave newpath 0 0 moveto false charpath + pathbbox exch pop exch sub exch pop 0 exch grestore + dtransform add abs 4 mul cvi + } def + + % Compute an integer version of the transformed FontBBox. + +/inflate % <num> inflate <num> + { dup 0 gt { ceiling } { floor } ifelse + } def +/ixbbox % - ixbbox <llx> <lly> <urx> <ury> + { /FontBBox load aload pop % might be executable or literal + 4 2 roll transform exch truncate cvi exch truncate cvi + 4 2 roll transform exch inflate cvi exch inflate cvi + } def + + % Determine the original font of a possibly transformed font. + % Since some badly behaved PostScript files construct transformed + % fonts "by hand", we can't just rely on the OrigFont pointers. + % Instead, if a font with the given name exists, and if its + % entries for FontType and UniqueID match those of the font we + % obtain by following the OrigFont chain, we use that font. + +/origfont + { { dup /OrigFont known not { exit } if /OrigFont get } loop + FontDirectory 1 index /FontName get .knownget + { % Stack: origfont namedfont + 1 index /FontType get 1 index /FontType get eq + { 1 index /UniqueID .knownget + { 1 index /UniqueID .knownget + { eq { exch } if } + { pop } + ifelse + } + if + } + if pop + } + if + } def + + + % Determine the bounding box of the current device's image. + % Free variables: row, zerow. + +/devbbox % <rw> <rh> devbbox <ymin> <ymax1> <xmin> <xmax1> + { % Find top and bottom whitespace. + dup + { dup 0 eq { exit } if 1 sub + dup currentdevice exch row copyscanlines + zerow ne { 1 add exit } if + } + loop % ymax1 + 0 + { 2 copy eq { exit } if + dup currentdevice exch row copyscanlines + zerow ne { exit } if + 1 add + } + loop % ymin + exch + % Find left and right whitespace. + 3 index 0 + % Stack: rw rh ymin ymax1 xmin xmax1 + 3 index 1 4 index 1 sub + { currentdevice exch row copyscanlines .findzeros + exch 4 1 roll .max 3 1 roll .min exch + } + for % xmin xmax1 + % Special check: xmin > xmax1 if height = 0 + 2 copy gt { exch pop dup } if + 6 -2 roll pop pop + + } def + + % Write values on outfile. + + /w1 { 255 and outfile exch write } def + /w2 { dup -8 bitshift w1 w1 } def + /wbyte % <byte> <label> wbyte + { VDEBUG { print ( =byte= ) print dup == flush } { pop } ifelse w1 + } def + /wword % <word16> <label> wword + { VDEBUG { print ( =word= ) print dup == flush } { pop } ifelse w2 + } def + /wdword % <word32> <label> wdword + { VDEBUG { print ( =dword= ) print dup == flush } { pop } ifelse + dup -16 bitshift w2 w2 + } def + +/style.posture.keys + [ { (Italic) } { (Oblique) } + { } + ] def +/style.posture.values <010100> def + +/style.appearance.width.keys + [ { (Ultra) (Compressed) } + { (Extra) (Compressed) } + { (Extra) (Condensed) } + { (Extra) (Extended) } + { (Extra) (Expanded) } + { (Compressed) } + { (Condensed) } + { (Extended) } + { (Expanded) } + { } + ] def +/style.appearance.width.values <04030207070201060600> def + +/width.type.keys + [ { (Ultra) (Compressed) } + { (Extra) (Compressed) } + { (Extra) (Condensed) } + { (Extra) (Expanded) } + { (Compressed) } + { (Condensed) } + { (Expanded) } + { } + ] def +/width.type.values <fbfcfd03fdfe0200> def + +/stroke.weight.keys + [ { (Ultra) (Thin) } + { (Ultra) (Black) } + { (Extra) (Thin) } + { (Extra) (Light) } + { (Extra) (Bold) } + { (Extra) (Black) } + { (Demi) (Light) } + { (Demi) (Bold) } + { (Semi) (Light) } + { (Semi) (Bold) } + { (Thin) } + { (Light) } + { (Bold) } + { (Black) } + { } + ] def +/stroke.weight.values <f907fafc0406fe02ff01fbfd030500> def + +/vendor.keys + [ { (Agfa) } + { (Bitstream) } + { (Linotype) } + { (Monotype) } + { (Adobe) } + { } + ] def +/vendor.default.index 4 def % might as well be Adobe +/old.vendor.values <020406080a00> def +/new.vendor.values <010203040500> def +/vendor.initials (CBLMA\000) def + +currentdict readonly end pop % pcldict + + +% Convert and write a PCL font for the current font and transformation. + +% Write the font header. We split this off only to avoid overflowing +% the limit on the maximum size of a procedure. +% Free variables: outfile uury u0y rw rh orientation uh ully +/writefontheader + { outfile (\033\)s) writestring + outfile 64 WriteResolution? { 4 add } if + Copyright length add write==only + outfile (W) writestring + WriteResolution? { 20 68 } { 0 64 } ifelse + (Font Descriptor Size) wword + (Header Format) wbyte + 1 (Font Type) wbyte + FullName style.posture.keys keysearch style.posture.values exch get + FullName style.appearance.width.keys keysearch + style.appearance.width.values exch get 4 mul add + PaintType 2 eq { 32 add } if + /style exch def + style -8 bitshift (Style MSB) wbyte + 0 (Reserved) wbyte + /baseline uury 1 sub u0y sub def + baseline (Baseline Position) wword + rw (Cell Width) wword + rh (Cell Height) wword + orientation (Orientation) wbyte + FontInfo /isFixedPitch .knownget not { false } if + { 0 } { 1 } ifelse (Spacing) wbyte + % Use loop/exit to fake a multiple-exit block. + { Encoding StandardEncoding eq { 10 (J) exit } if + Encoding ISOLatin1Encoding eq { 11 (J) exit } if + Encoding SymbolEncoding eq { 19 (M) exit } if + Encoding DingbatsEncoding eq { 10 (L) exit } if +% (Warning: unknown Encoding, using ISOLatin1.\n) print flush + 11 (J) exit + } + loop + 0 get 64 sub exch 32 mul add (Symbol Set) wword + ( ) stringwidth pop 0 dtransform add abs 4 mul + /pitch exch def + pitch cvi (Pitch) wword + uh 4 mul (Height) wword % Height + (x) charheight (x-Height) wword + FullName width.type.keys keysearch + width.type.values exch get (Width Type) wbyte + style 255 and (Style LSB) wbyte + FullName stroke.weight.keys keysearch + stroke.weight.values exch get (Stroke Weight) wbyte + FullName vendor.keys keysearch + dup vendor.initials exch get 0 eq + { % No vendor in FullName, try Notice + pop Copyright vendor.keys keysearch + dup vendor.initials exch get 0 eq { pop vendor.default.index } if + } + if + /vendor.index exch def + 0 (Typeface LSB) wbyte % punt + 0 (Typeface MSB) wbyte % punt + 0 (Serif Style) wbyte % punt + 2 (Quality) wbyte + 0 (Placement) wbyte + gsave FontMatrix concat rot neg rotate + /ulwidth + FontInfo /UnderlineThickness .knownget + { 0 exch dtransform exch pop abs } + { resolution 100 div } + ifelse def + FontInfo /UnderlinePosition .knownget + { 0 exch transform exch pop negY ulwidth 2 div add } + { ully ulwidth add } + ifelse u0y sub + round cvi 1 .max 255 .min (Underline Position) wbyte + ulwidth round cvi 1 .max 255 .min (Underline Thickness) wbyte + grestore + uh 1.2 mul 4 mul cvi (Text Height) wword + (average lowercase character) dup stringwidth + pop 0 dtransform add abs + exch length div 4 mul cvi (Text Width) wword + 0 + { dup Encoding exch get /.notdef ne { exit } if + 1 add + } + loop (First Code) wword + 255 + { dup Encoding exch get /.notdef ne { exit } if + 1 sub + } + loop (Last Code) wword + pitch dup cvi sub 256 mul cvi (Pitch Extended) wbyte + 0 (Height Extended) wbyte + 0 (Cap Height) wword % (default) + currentfont /UniqueID known { UniqueID } { 0 } ifelse + 16#c1000000 add (Font Number (Adobe UniqueID)) wdword + FontName length 16 .max string + dup FontName exch cvs pop + outfile exch 0 16 getinterval writestring % Font Name + WriteResolution? + { resolution dup (X Resolution) wword (Y Resolution) wword + } + if + outfile Copyright writestring % Copyright + } def + +/writePCL % <fontfile> <resolution> writePCL - + { + save + currentfont begin + pcldict begin + 80 dict begin % allow for recursion + /saved exch def + /resolution exch def + /outfile exch def + matrix currentmatrix dup 4 0 put dup 5 0 put setmatrix + + % Supply some default values so we don't have to check later. + + currentfont /FontInfo known not { /FontInfo 1 dict def } if + currentfont /FontName known not { /FontName () def } if + /Copyright FontInfo /Notice .knownget not { () } if def + /FullName + FontInfo /FullName .knownget not + { FontName dup length string cvs } + if def + + % Determine the original font, and its relationship to this one. + + /OrigFont currentfont origfont def + /OrigMatrix OrigFont /FontMatrix get def + /OrigMatrixInverse OrigMatrix matrix invertmatrix def + /ScaleMatrix matrix currentfont OrigFont ne + { FontMatrix exch OrigMatrixInverse exch concatmatrix + } if + def + /CurrentScaleMatrix + matrix currentmatrix + matrix defaultmatrix + dup 0 get 1 index 3 get mul 0 lt + 1 index dup 1 get exch 2 get mul 0 gt or + /flipY exch def + dup invertmatrix + dup concatmatrix + def + /negY flipY { {neg} } { {} } ifelse def + + % Print debugging information. + + /CDEBUG where { pop } { /CDEBUG false def } ifelse + /VDEBUG where { pop } { /VDEBUG false def } ifelse + CDEBUG { /VDEBUG true def } if + DEBUG + { (currentmatrix: ) print matrix currentmatrix == + (defaultmatrix: ) print matrix defaultmatrix == + (flipY: ) print flipY == + (scaling matrix: ) print CurrentScaleMatrix == + (FontMatrix: ) print FontMatrix == + (FontBBox: ) print /FontBBox load == + currentfont OrigFont ne + { OrigFont /FontName .knownget { (orig FontName: ) print == } if + (orig FontMatrix: ) print OrigMatrix == + } if + currentfont /ScaleMatrix .knownget { (ScaleMatrix: ) print == } if + gsave + FontMatrix concat + (combined matrix: ) print matrix currentmatrix == + grestore + flush + } if + + % Determine the orientation. + + ScaleMatrix matrix currentmatrix dup concatmatrix + 0 1 3 + { 1 index 1 get 0 eq 2 index 2 get 0 eq and 2 index 0 get 0 gt and + { exit } if + pop -90 matrix rotate exch dup concatmatrix + } + for + dup type /integertype ne + { (Only rotations by multiples of 90 degrees are supported:\n) print + == flush + saved end end end restore stop + } + if + /orientation exch def + /rot orientation 90 mul def + DEBUG { (orientation: ) print orientation == flush } if + + dup dup 0 get exch 3 get negY sub abs 0.5 ge + { (Only identical scaling in X and Y is supported:\n) print + exch flipY 3 array astore == + currentdevice .devicename == + matrix defaultmatrix == flush + saved end end end restore stop + } + if pop + + % Determine the font metrics, in the PCL character coordinate system, + % which has +Y going towards the top of the page. + + gsave + FontMatrix concat + 0 0 transform + negY round cvi /r0y exch def + round cvi /r0x exch def + ixbbox + negY /rury exch def /rurx exch def + negY /rlly exch def /rllx exch def + /rminx rllx rurx .min def + /rminy rlly negY rury negY .min def + /rw rurx rllx sub abs def + /rh rury rlly sub abs def + gsave rot neg rotate + 0 0 transform + negY round cvi /u0y exch def + round cvi /u0x exch def + ixbbox + negY /uury exch def /uurx exch def + negY /ully exch def /ullx exch def + /uw uurx ullx sub def + /uh uury ully sub def + grestore + DEBUG + { (rmatrix: ) print matrix currentmatrix == + (rFontBBox: ) print [rllx rlly rurx rury] == + (uFontBBox: ) print [ullx ully uurx uury] == + flush + } if + grestore + + % Disable the character cache, to avoid excessive allocation + % and memory sandbars. + + mark cachestatus /upper exch def + cleartomark 0 setcachelimit + + % Write the font header. + + writefontheader + + % Establish an image device for rasterizing characters. + + matrix currentmatrix + dup 4 rminx neg put + dup 5 rminy neg put + % Round the width up to a multiple of 8 + % so we don't get garbage bits in the last byte of each row. + rw 7 add -8 and rh <ff 00> makeimagedevice + /cdevice exch def + nulldevice % prevent page device switching + cdevice setdevice + + % Rasterize each character in turn. + + /raster rw 7 add 8 idiv def + /row raster string def + /zerow row length string def + 0 1 Encoding length 1 sub + { /cindex exch def + Encoding cindex get /.notdef ne + { VDEBUG { Encoding cindex get == flush } if + erasepage initgraphics + 0 0 moveto currentpoint transform add + ( ) dup 0 cindex put show + currentpoint transform add exch sub round cvi + /cwidth exch abs def + rw rh devbbox + VDEBUG + { (image bbox: ) print 4 copy 4 2 roll 4 array astore == flush + } if + % Save the device bounding box. + % Note that this is in current device coordinates, + % not PCL (right-handed) coordinates. + /bqx exch def /bpx exch def /bqy exch def /bpy exch def + % Re-render with the character justified to (0,0). + % This may be either the lower left or the upper left corner. + bpx neg bpy neg idtransform moveto + erasepage + VDEBUG { (show point: ) print [ currentpoint transform ] == flush } if + ( ) dup 0 cindex put show + % Find the bounding box. Note that xmin and ymin are now 0, + % xmax1 = xw, and ymax1 = yh. + rw rh devbbox + /xw exch def + % xmin or ymin can be non-zero only if the character is blank. + xw 0 eq + { pop } + { dup 0 ne { (Non-zero xmin! ) print = } { pop } ifelse } + ifelse + /yh exch def + yh 0 eq + { pop } + { dup 0 ne { (Non-zero ymin! ) print = } { pop } ifelse } + ifelse + + /xbw xw 7 add 8 idiv def + /xright raster 8 mul xw sub def + % Write the Character Code command. + outfile (\033*c) writestring + outfile cindex write==only + outfile (E) writestring + % Write the Character Definition command. + outfile (\033\(s) writestring + yh xbw mul 16 add + outfile exch write=only + % Record the character position for the .PCM file. + /cfpos outfile fileposition 1 add def + outfile (W\004\000\016\001) writestring + orientation (Orientation) wbyte 0 (Reserved) wbyte + rminx bpx add r0x sub (Left Offset) wword + flipY { rminy bpy add neg } { rminy bqy add } ifelse r0y sub + (Top Offset) wword + xw (Character Width) wword + yh (Character Height) wword + cwidth orientation 2 ge { neg } if 4 mul (Delta X) wword + % Write the character data. + flipY { 0 1 yh 1 sub } { yh 1 sub -1 0 } ifelse + { cdevice exch row copyscanlines + 0 xbw getinterval + CDEBUG + { dup + { 8 + { dup 128 ge { (+) } { (.) } ifelse print + 127 and 1 bitshift + } + repeat pop + } + forall (\n) print + } + if + outfile exch writestring + } + for + } + { /bpx 0 def /bpy 0 def /bqx 0 def /bqy 0 def + /cwidth 0 def + /cfpos 0 def + } + ifelse + + } + for + + % Wrap up. + + upper setcachelimit + outfile closefile + + nulldevice % prevent page device switching + saved end end end restore + + } def + +% Provide definitions for testing with older or non-custom interpreters. + +/.findzeros where { pop (%END) .skipeof } if +/.findzeros + { userdict begin /zs exch def /zl zs length def + 0 { dup zl ge { exit } if dup zs exch get 0 ne { exit } if 1 add } loop + zl { dup 0 eq { exit } if dup 1 sub zs exch get 0 ne { exit } if 1 sub } loop + exch 3 bitshift exch 3 bitshift + 2 copy lt + { exch zs 1 index -3 bitshift get + { dup 16#80 and 0 ne { exit } if exch 1 add exch 1 bitshift } loop pop + exch zs 1 index -3 bitshift 1 sub get + { dup 1 and 0 ne { exit } if exch 1 sub exch -1 bitshift } loop pop + } + if end + } bind def +%END + +/write=only where { pop (%END) .skipeof } if +/w=s 128 string def +/write=only + { w=s cvs writestring + } bind def +%END + +%**************** Test +/PCLTEST where { + pop + /DEBUG true def + /CDEBUG true def + /VDEBUG true def + /Times-Roman findfont 10 scalefont setfont + (t.pcf) (w) file + 300 72 div dup scale + 300 writePCL + flush quit +} if |