diff options
Diffstat (limited to 'Master/tlpkg/tlgs/lib/font2pcl.ps')
-rw-r--r-- | Master/tlpkg/tlgs/lib/font2pcl.ps | 604 |
1 files changed, 0 insertions, 604 deletions
diff --git a/Master/tlpkg/tlgs/lib/font2pcl.ps b/Master/tlpkg/tlgs/lib/font2pcl.ps deleted file mode 100644 index bf0c903d6b1..00000000000 --- a/Master/tlpkg/tlgs/lib/font2pcl.ps +++ /dev/null @@ -1,604 +0,0 @@ -% Copyright (C) 2001-2012 Artifex Software, Inc. -% 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. -% -% Refer to licensing information at http://www.artifex.com or contact -% Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134, San Rafael, -% CA 94903, U.S.A., +1(415)492-9861, for further information. -% - -% 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 == -% -% .devicename has been deprecated -% currentdevice .devicename == -% - currentpagedevice /Name get == - 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 |