% Copyright (C) 1993, 1994, 1995, 1997 Aladdin Enterprises. All rights reserved. % % This program is free software; you can redistribute it and/or modify it % under the terms of the GNU General Public License as published by the % Free Software Foundation; either version 2 of the License, or (at your % option) any later version. % % This program is distributed in the hope that it will be useful, but % WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General % Public License for more details. % % You should have received a copy of the GNU General Public License along % with this program; if not, write to the Free Software Foundation, Inc., % 59 Temple Place, Suite 330, Boston, MA, 02111-1307. % $Id: font2pcl.ps,v 1.2.6.2.2.1 2003/04/12 14:02:38 giles Exp $ % 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 % findstring { 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 % keysearch { 0 1 2 index length 1 sub { 2 copy get true exch { % Stack: 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 % charheight { 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 % inflate { dup 0 gt { ceiling } { floor } ifelse } def /ixbbox % - ixbbox { /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 % devbbox { % 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 %