795 lines
23 KiB
PostScript
795 lines
23 KiB
PostScript
% Copyright (C) 1990, 1995, 1996 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: bdftops.ps,v 1.7 2003/08/06 17:05:09 alexcher Exp $
|
|
% bdftops.ps
|
|
% Convert a BDF file (possibly with (an) associated AFM file(s))
|
|
% to a PostScript Type 1 font (without eexec encryption).
|
|
% The resulting font will work with any PostScript language interpreter,
|
|
% but not with ATM or other font rasterizers lacking a complete interpreter.
|
|
|
|
/envBDF 120 dict def
|
|
envBDF begin
|
|
|
|
% "Import" the image-to-path package.
|
|
% This also brings in the Type 1 opcodes (type1ops.ps).
|
|
(impath.ps) runlibfile
|
|
|
|
% "Import" the font-writing package.
|
|
(wrfont.ps) runlibfile
|
|
wrfont_dict begin
|
|
/binary_CharStrings false def
|
|
/binary_tokens false def
|
|
/encrypt_CharStrings true def
|
|
/standard_only true def
|
|
end
|
|
/lenIV 0 def
|
|
|
|
% Invert the StandardEncoding vector.
|
|
256 dict dup begin
|
|
0 1 255 { dup StandardEncoding exch get exch def } for
|
|
end /StandardDecoding exch def
|
|
|
|
% Define the properties copied to FontInfo.
|
|
mark
|
|
(COPYRIGHT) /Notice
|
|
(FAMILY_NAME) /FamilyName
|
|
(FULL_NAME) /FullName
|
|
(WEIGHT_NAME) /Weight
|
|
.dicttomark /properties exch def
|
|
|
|
% Define the character sequences for synthesizing missing composite
|
|
% characters in the standard encoding.
|
|
mark
|
|
/AE [/A /E]
|
|
/OE [/O /E]
|
|
/ae [/a /e]
|
|
/ellipsis [/period /period /period]
|
|
/emdash [/hyphen /hyphen /hyphen]
|
|
/endash [/hyphen /hyphen]
|
|
/fi [/f /i]
|
|
/fl [/f /l]
|
|
/germandbls [/s /s]
|
|
/guillemotleft [/less /less]
|
|
/guillemotright [/greater /greater]
|
|
/oe [/o /e]
|
|
/quotedblbase [/comma /comma]
|
|
.dicttomark /composites exch def
|
|
|
|
% Define the procedure for synthesizing composites.
|
|
% This must not be bound.
|
|
/compose
|
|
{ exch pop
|
|
FontMatrix Private /composematrix get invertmatrix concat
|
|
0 0 moveto
|
|
dup gsave false charpath pathbbox currentpoint grestore
|
|
6 2 roll setcachedevice show
|
|
} def
|
|
% Define the CharString procedure that calls compose, with the string
|
|
% on the stack. This too must remain unbound.
|
|
/compose_proc
|
|
{ Private /compose get exec
|
|
} def
|
|
|
|
% Define aliases for missing characters similarly.
|
|
mark
|
|
/acute /quoteright
|
|
/bullet /asterisk
|
|
/cedilla /comma
|
|
/circumflex /asciicircum
|
|
/dieresis /quotedbl
|
|
/dotlessi /i
|
|
/exclamdown /exclam
|
|
/florin /f
|
|
/fraction /slash
|
|
/grave /quoteleft
|
|
/guilsinglleft /less
|
|
/guilsinglright /greater
|
|
/hungarumlaut /quotedbl
|
|
/periodcentered /asterisk
|
|
/questiondown /question
|
|
/quotedblleft /quotedbl
|
|
/quotedblright /quotedbl
|
|
/quotesinglbase /comma
|
|
/quotesingle /quoteright
|
|
/tilde /asciitilde
|
|
.dicttomark /aliases exch def
|
|
|
|
% Define overstruck characters that can be synthesized with seac.
|
|
mark
|
|
[ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
|
|
/Ccedilla
|
|
/Eacute /Ecircumflex /Edieresis /Egrave
|
|
/Iacute /Icircumflex /Idieresis /Igrave
|
|
/Lslash
|
|
/Ntilde
|
|
/Oacute /Ocircumflex /Odieresis /Ograve /Otilde
|
|
/Scaron
|
|
/Uacute /Ucircumflex /Udieresis /Ugrave
|
|
/Yacute /Ydieresis
|
|
/Zcaron
|
|
/aacute /acircumflex /adieresis /agrave /aring /atilde
|
|
/ccedilla
|
|
/eacute /ecircumflex /edieresis /egrave
|
|
/iacute /icircumflex /idieresis /igrave
|
|
/lslash
|
|
/ntilde
|
|
/oacute /ocircumflex /odieresis /ograve /otilde
|
|
/scaron
|
|
/uacute /ucircumflex /udieresis /ugrave
|
|
/yacute /ydieresis
|
|
/zcaron
|
|
]
|
|
{ dup =string cvs
|
|
[ exch dup 0 1 getinterval cvn
|
|
exch dup length 1 sub 1 exch getinterval cvn
|
|
]
|
|
} forall
|
|
/cent [/c /slash]
|
|
/daggerdbl [/bar /equal]
|
|
/divide [/colon /hyphen]
|
|
/sterling [/L /hyphen]
|
|
/yen [/Y /equal]
|
|
.dicttomark /accentedchars exch def
|
|
|
|
% ------ Output utilities ------ %
|
|
|
|
/ws {psfile exch writestring} bind def
|
|
/wl {ws (\n) ws} bind def
|
|
/wt {=string cvs ws ( ) ws} bind def
|
|
|
|
% ------ BDF file parsing utilities ------ %
|
|
|
|
% Define a buffer for reading the BDF file.
|
|
/buffer 400 string def
|
|
|
|
% Read a line from the BDF file into the buffer.
|
|
% Ignore empty (zero-length) lines.
|
|
% Define /keyword as the first word on the line.
|
|
% Define /args as the remainder of the line.
|
|
% If the keyword is equal to commentword, skip the line.
|
|
% (If commentword is equal to a space, never skip.)
|
|
/nextline
|
|
{ { bdfile buffer readline not
|
|
{ (Premature EOF\n) print stop } if
|
|
dup length 0 ne { exit } if pop
|
|
}
|
|
loop
|
|
( ) search
|
|
{ /keyword exch def pop }
|
|
{ /keyword exch def () }
|
|
ifelse
|
|
/args exch def
|
|
keyword commentword eq { nextline } if
|
|
} bind def
|
|
|
|
% Get a word argument from args. We do *not* copy the string.
|
|
/warg % warg -> string
|
|
{ args ( ) search
|
|
{ exch pop exch }
|
|
{ () }
|
|
ifelse /args exch def
|
|
} bind def
|
|
|
|
% Get an integer argument from args.
|
|
/iarg % iarg -> int
|
|
{ warg cvi
|
|
} bind def
|
|
|
|
% Get a numeric argument from args.
|
|
/narg % narg -> int|real
|
|
{ warg cvr
|
|
dup dup cvi eq { cvi } if
|
|
} bind def
|
|
|
|
% Convert the remainder of args into a string.
|
|
/remarg % remarg -> string
|
|
{ args copystring
|
|
} bind def
|
|
|
|
% Get a string argument that occupies the remainder of args.
|
|
/sarg % sarg -> string
|
|
{ args (") anchorsearch
|
|
{ pop /args exch def } { pop } ifelse
|
|
args args length 1 sub get (") 0 get eq
|
|
{ args 0 args length 1 sub getinterval /args exch def } if
|
|
args copystring
|
|
} bind def
|
|
|
|
% Check that the keyword is the expected one.
|
|
/checkline % (EXPECTED-KEYWORD) checkline ->
|
|
{ dup keyword ne
|
|
{ (Expected ) print =
|
|
(Line=) print keyword print ( ) print args print (\n) print stop
|
|
} if
|
|
pop
|
|
} bind def
|
|
|
|
% Read a line and check its keyword.
|
|
/getline % (EXPECTED-KEYWORD) getline ->
|
|
{ nextline checkline
|
|
} bind def
|
|
|
|
% Find the first/last non-zero bit of a non-zero byte.
|
|
/fnzb
|
|
{ 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
|
|
loop
|
|
} bind def
|
|
/lnzb
|
|
{ 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
|
|
loop
|
|
} bind def
|
|
|
|
% ------ Type 1 encoding utilities ------ %
|
|
|
|
% Parse the side bearing and width information that begins a CharString.
|
|
% Arguments: charstring. Result: sbx sby wx wy substring.
|
|
/parsesbw
|
|
{ mark exch lenIV
|
|
{ % stack: mark ... string dropcount
|
|
dup 2 index length exch sub getinterval
|
|
dup 0 get dup 32 lt { pop exit } if
|
|
dup 246 le
|
|
{ 139 sub exch 1 }
|
|
{ dup 250 le
|
|
{ 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
|
|
{ dup 254 le
|
|
{ 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
|
|
{ pop dup 1 get 128 xor 128 sub
|
|
8 bitshift 1 index 2 get add
|
|
8 bitshift 1 index 3 get add
|
|
8 bitshift 1 index 4 get add exch 5
|
|
} ifelse
|
|
} ifelse
|
|
} ifelse
|
|
} loop
|
|
counttomark 3 eq { 0 3 1 roll 0 exch } if
|
|
6 -1 roll pop
|
|
} bind def
|
|
|
|
% Find the side bearing and width information that begins a CharString.
|
|
% Arguments: charstring. Result: charstring sizethroughsbw.
|
|
/findsbw
|
|
{ dup parsesbw 4 { exch pop } repeat skipsbw
|
|
} bind def
|
|
/skipsbw % charstring sbwprefix -> sizethroughsbw
|
|
{ length 1 index length exch sub
|
|
2 copy get 12 eq { 2 } { 1 } ifelse add
|
|
} bind def
|
|
|
|
% Encode a number, and append it to a string.
|
|
% Arguments: str num. Result: newstr.
|
|
/concatnum
|
|
{ dup dup -107 ge exch 107 le and
|
|
{ 139 add 1 string dup 0 3 index put }
|
|
{ dup dup -1131 ge exch 1131 le and
|
|
{ dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
|
|
2 string dup 0 3 index -8 bitshift put
|
|
dup 1 3 index 255 and put
|
|
}
|
|
{ 5 string dup 0 255 put exch
|
|
2 copy 1 exch -24 bitshift 255 and put
|
|
2 copy 2 exch -16 bitshift 255 and put
|
|
2 copy 3 exch -8 bitshift 255 and put
|
|
2 copy 4 exch 255 and put
|
|
exch
|
|
}
|
|
ifelse
|
|
}
|
|
ifelse exch pop concatstrings
|
|
} bind def
|
|
|
|
% ------ Point arithmetic utilities ------ %
|
|
|
|
/ptadd { exch 4 -1 roll add 3 1 roll add } bind def
|
|
/ptexch { 4 2 roll } bind def
|
|
/ptneg { neg exch neg exch } bind def
|
|
/ptpop { pop pop } bind def
|
|
/ptsub { ptneg ptadd } bind def
|
|
|
|
% ------ The main program ------ %
|
|
|
|
/readBDF % <infilename> <outfilename> <fontname>
|
|
% <encodingname> <uniqueID> <xuid> readBDF -> <font>
|
|
{ /xuid exch def % may be null
|
|
/uniqueID exch def % may be -1
|
|
/encodingname exch def
|
|
/encoding encodingname cvx exec def
|
|
/fontname exch def
|
|
/psname exch def
|
|
/bdfname exch def
|
|
gsave % so we can set the CTM to the font matrix
|
|
|
|
% Open the input files. We don't open the output file until
|
|
% we've done a minimal validity check on the input.
|
|
bdfname (r) file /bdfile exch def
|
|
/commentword ( ) def
|
|
|
|
% Check for the STARTFONT.
|
|
(STARTFONT) getline
|
|
args (2.1) ne { (Not version 2.1\n) print stop } if
|
|
|
|
% Initialize the font.
|
|
/Font 20 dict def
|
|
Font begin
|
|
/FontName fontname def
|
|
/PaintType 0 def
|
|
/FontType 1 def
|
|
uniqueID 0 gt { /UniqueID uniqueID def } if
|
|
xuid null ne { /XUID xuid def } if
|
|
/Encoding encoding def
|
|
/FontInfo 20 dict def
|
|
/Private 20 dict def
|
|
currentdict end currentdict end
|
|
exch begin begin % insert font above environment
|
|
|
|
% Initialize the Private dictionary in the font.
|
|
Private begin
|
|
/-! {string currentfile exch readhexstring pop} readonly def
|
|
/-| {string currentfile exch readstring pop} readonly def
|
|
/|- {readonly def} readonly def
|
|
/| {readonly put} readonly def
|
|
/BlueValues [] def
|
|
/lenIV lenIV def
|
|
/MinFeature {16 16} def
|
|
/password 5839 def
|
|
/UniqueID uniqueID def
|
|
end % Private
|
|
|
|
% Invert the Encoding, for synthesizing composite characters.
|
|
/decoding encoding length dict def
|
|
0 1 encoding length 1 sub
|
|
{ dup encoding exch get exch decoding 3 1 roll put }
|
|
for
|
|
|
|
% Now open the output file.
|
|
psname (w) file /psfile exch def
|
|
|
|
% Put out a header compatible with the Adobe "standard".
|
|
(%!FontType1-1.0: ) ws fontname wt (000.000) wl
|
|
(% This is a font description converted from ) ws
|
|
bdfname wl
|
|
(% by bdftops running on ) ws
|
|
statusdict /product get ws ( revision ) ws
|
|
revision =string cvs ws (.) wl
|
|
|
|
% Copy the initial comments, up to FONT.
|
|
true
|
|
{ nextline
|
|
keyword (COMMENT) ne {exit} if
|
|
{ (% Here are the initial comments from the BDF file:\n%) wl
|
|
} if false
|
|
(%) ws remarg wl
|
|
} loop pop
|
|
() wl
|
|
/commentword (COMMENT) def % do skip comments from now on
|
|
|
|
% Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
|
|
% If we cared about FONT, we'd use it here. If the BDF files
|
|
% from MIT had PostScript names rather than X names, we would
|
|
% care; but what's there is unusable, so we discard FONT.
|
|
% The FONTBOUNDINGBOX may not be reliable, so we discard it too.
|
|
(FONT) checkline
|
|
(SIZE) getline
|
|
/pointsize iarg def /xres iarg def /yres iarg def
|
|
(FONTBOUNDINGBOX) getline
|
|
nextline
|
|
|
|
% Initialize the font bounding box bookeeping.
|
|
/fbbxo 1000 def
|
|
/fbbyo 1000 def
|
|
/fbbxe -1000 def
|
|
/fbbye -1000 def
|
|
|
|
% Read and process the properties. We only care about a few of them.
|
|
keyword (STARTPROPERTIES) eq
|
|
{ iarg
|
|
{ nextline
|
|
properties keyword known
|
|
{ FontInfo properties keyword get sarg readonly put
|
|
} if
|
|
} repeat
|
|
(ENDPROPERTIES) getline
|
|
nextline
|
|
} if
|
|
|
|
% Compute and set the FontMatrix.
|
|
Font /FontMatrix
|
|
[ 0.001 0 0 0.001 xres mul yres div 0 0 ] readonly
|
|
dup setmatrix put
|
|
|
|
% Read and process the header for the bitmaps.
|
|
(CHARS) checkline
|
|
/ccount iarg def
|
|
|
|
% Initialize the CharStrings dictionary.
|
|
/charstrings ccount
|
|
composites length add
|
|
aliases length add
|
|
accentedchars length add
|
|
1 add dict def % 1 add for .notdef
|
|
/isfixedwidth true def
|
|
/fixedwidth null def
|
|
/subrcount 0 def
|
|
/subrs [] def
|
|
|
|
% Read the bitmap data. This reads the remainder of the file.
|
|
% We do this before processing the bitmaps so that we can compute
|
|
% the correct FontBBox first.
|
|
/chardata ccount dict def
|
|
ccount -1 1
|
|
{ (STARTCHAR) getline
|
|
/charname remarg def
|
|
(ENCODING) getline
|
|
/eindex iarg def
|
|
eindex dup 0 ge exch 255 le and
|
|
{ charname /charname StandardEncoding eindex get def
|
|
charname /.notdef eq eindex 0 gt and
|
|
{ /charname (A) eindex =string cvs concatstrings cvn def
|
|
}
|
|
if
|
|
(/) print charname =string cvs print (,) print print
|
|
}
|
|
{ (/) print charname print
|
|
}
|
|
ifelse
|
|
10 mod 1 eq { (\n) print flush } if
|
|
(SWIDTH) getline
|
|
/swx iarg pointsize mul 1000 div xres mul 72 div def
|
|
/swy iarg pointsize mul 1000 div xres mul 72 div def
|
|
(DWIDTH) getline % Ignore, use SWIDTH instead
|
|
(BBX) getline
|
|
/bbw iarg def /bbh iarg def /bbox iarg def /bboy iarg def
|
|
nextline
|
|
keyword (ATTRIBUTES) eq
|
|
{ nextline
|
|
} if
|
|
(BITMAP) checkline
|
|
|
|
% Update the font bounding box.
|
|
/fbbxo fbbxo bbox .min def
|
|
/fbbyo fbbyo bboy .min def
|
|
/fbbxe fbbxe bbox bbw add .max def
|
|
/fbbye fbbye bboy bbh add .max def
|
|
|
|
% Read the bits for this character.
|
|
/raster bbw 7 add 8 idiv def
|
|
/cbits raster bbh mul string def
|
|
cbits length 0 gt
|
|
{ 0 raster cbits length raster sub
|
|
{ cbits exch raster getinterval
|
|
bdfile buffer readline not
|
|
{ (EOF in bitmap\n) print stop } if
|
|
% stack has <cbits.interval> <buffer.interval>
|
|
0 () /SubFileDecode filter
|
|
exch 2 copy readhexstring pop pop pop closefile
|
|
} for
|
|
} if
|
|
|
|
(ENDCHAR) getline
|
|
|
|
% Save the character data.
|
|
chardata charname [swx swy bbw bbh bbox bboy cbits] put
|
|
} for
|
|
|
|
(ENDFONT) getline
|
|
|
|
% Allocate the buffers for the bitmap and the outline,
|
|
% according to the font bounding box.
|
|
/fbbw fbbxe fbbxo sub def
|
|
/fbbh fbbye fbbyo sub def
|
|
/fraster fbbw 7 add 8 idiv def
|
|
/bits fraster fbbh mul 200 .max 65535 .min string def
|
|
/outline bits length 16 mul 65535 .min string def
|
|
|
|
% Process the characters.
|
|
chardata
|
|
{ exch /charname exch def aload pop
|
|
/cbits exch def
|
|
/bboy exch def /bbox exch def
|
|
/bbh exch def /bbw exch def
|
|
/swy exch def /swx exch def
|
|
|
|
% The bitmap handed to type1imagepath must have the correct height,
|
|
% because type1imagepath uses this to compute the scale factor,
|
|
% so we have to clear the unused parts of it.
|
|
/raster bbw 7 add 8 idiv def
|
|
bits dup 0 1 raster fbbh mul 1 sub
|
|
{ 0 put dup } for
|
|
pop pop
|
|
bits raster fbbh bbh sub mul cbits putinterval
|
|
|
|
% Compute the font entry, converting the bitmap to an outline.
|
|
bits 0 raster fbbh mul getinterval % the bitmap image
|
|
bbw fbbh % bitmap width & height
|
|
swx swy % width x & y
|
|
bbox neg bboy neg % origin x & y
|
|
% Account for lenIV when converting the outline.
|
|
outline lenIV outline length lenIV sub getinterval
|
|
type1imagepath
|
|
length lenIV add
|
|
outline exch 0 exch getinterval
|
|
|
|
% Check for a fixed width font.
|
|
isfixedwidth
|
|
{ fixedwidth null eq
|
|
{ /fixedwidth swx def }
|
|
{ fixedwidth swx ne { /isfixedwidth false def } if }
|
|
ifelse
|
|
} if
|
|
|
|
% Finish up the character.
|
|
copystring
|
|
charname exch charstrings 3 1 roll put
|
|
} forall
|
|
|
|
% Add CharStrings entries for aliases.
|
|
aliases
|
|
{ charstrings 2 index known not charstrings 2 index known and
|
|
{ charstrings exch get charstrings 3 1 roll put
|
|
}
|
|
{ pop pop
|
|
}
|
|
ifelse
|
|
}
|
|
forall
|
|
|
|
% If this is not a fixed-width font, synthesize missing characters
|
|
% out of available ones.
|
|
isfixedwidth not
|
|
{ false composites
|
|
{ 1 index charstrings exch known not
|
|
1 index { decoding exch known and } forall
|
|
{ ( /) print 1 index bits cvs print
|
|
/combine exch def
|
|
0 1 combine length 1 sub
|
|
{ dup combine exch get decoding exch get
|
|
bits 3 1 roll put
|
|
} for
|
|
bits 0 combine length getinterval copystring
|
|
[ exch /compose_proc load aload pop ] cvx
|
|
charstrings 3 1 roll put
|
|
pop true
|
|
}
|
|
{ pop pop }
|
|
ifelse
|
|
}
|
|
forall flush
|
|
{ Private /composematrix matrix put
|
|
Private /compose /compose load put
|
|
}
|
|
if
|
|
}
|
|
if
|
|
|
|
% Synthesize accented characters with seac if needed and possible.
|
|
accentedchars
|
|
{ aload pop /accent exch def /base exch def
|
|
buffer cvs /accented exch def
|
|
charstrings accented known not
|
|
charstrings base known and
|
|
charstrings accent known and
|
|
StandardDecoding base known and
|
|
StandardDecoding accent known and
|
|
encoding StandardDecoding base get get base eq and
|
|
encoding StandardDecoding accent get get accent eq and
|
|
{ ( /) print accented print
|
|
charstrings base get findsbw 0 exch getinterval
|
|
/acstring exch def % start with sbw of base
|
|
charstrings accent get parsesbw
|
|
4 { pop } repeat % just leave sbx
|
|
acstring exch concatnum
|
|
0 concatnum 0 concatnum % adx ady
|
|
decoding base get concatnum % bchar
|
|
decoding accent get concatnum % achar
|
|
s_seac concatstrings
|
|
charstrings exch accented copystring exch put
|
|
} if
|
|
} forall
|
|
|
|
% Make a CharStrings entry for .notdef.
|
|
outline lenIV <8b8b0d0e> putinterval % 0 0 hsbw endchar
|
|
charstrings /.notdef outline 0 lenIV 4 add getinterval copystring put
|
|
|
|
% Encrypt the CharStrings and Subrs (in place).
|
|
charstrings
|
|
{ % Be careful not to encrypt aliased characters twice,
|
|
% since they share their CharString.
|
|
aliases 2 index known
|
|
{ charstrings aliases 3 index get .knownget
|
|
{ 1 index ne }
|
|
{ true }
|
|
ifelse
|
|
}
|
|
{ true
|
|
}
|
|
ifelse
|
|
1 index type /stringtype eq and
|
|
{ 4330 exch dup .type1encrypt exch pop
|
|
readonly charstrings 3 1 roll put
|
|
}
|
|
{ pop pop
|
|
}
|
|
ifelse
|
|
}
|
|
forall
|
|
0 1 subrcount 1 sub
|
|
{ dup subrs exch get
|
|
4330 exch dup .type1encrypt exch pop
|
|
subrs 3 1 roll put
|
|
}
|
|
for
|
|
|
|
% Make most of the remaining entries in the font dictionaries.
|
|
|
|
% The Type 1 font machinery really only works with a 1000 unit
|
|
% character coordinate system. Set this up here, by computing the factor
|
|
% to make the X entry in the FontMatrix come out at exactly 0.001.
|
|
/fontscale 1000 fbbh div yres mul xres div def
|
|
Font /FontBBox
|
|
[ fbbxo fontscale mul
|
|
fbbyo fontscale mul
|
|
fbbxe fontscale mul
|
|
fbbye fontscale mul
|
|
] cvx readonly put
|
|
Font /CharStrings charstrings readonly put
|
|
FontInfo /FullName known not
|
|
{ % Some programs insist on FullName being present.
|
|
FontInfo /FullName FontName dup length string cvs put
|
|
}
|
|
if
|
|
FontInfo /isFixedPitch isfixedwidth put
|
|
subrcount 0 gt
|
|
{ Private /Subrs subrs 0 subrcount getinterval readonly put
|
|
} if
|
|
|
|
% Determine the italic angle and underline position
|
|
% by actually installing the font.
|
|
save
|
|
/_temp_ Font definefont setfont
|
|
[1000 0 0 1000 0 0] setmatrix % mitigate rounding problems
|
|
% The italic angle is the multiple of -5 degrees
|
|
% that minimizes the width of the 'I'.
|
|
0 9999 0 5 85
|
|
{ dup rotate
|
|
newpath 0 0 moveto (I) false charpath
|
|
dup neg rotate
|
|
pathbbox pop exch pop exch sub
|
|
dup 3 index lt { 4 -2 roll } if
|
|
pop pop
|
|
}
|
|
for pop
|
|
% The underline position is halfway between the bottom of the 'A'
|
|
% and the bottom of the FontBBox.
|
|
newpath 0 0 moveto (A) false charpath
|
|
FontMatrix concat
|
|
pathbbox pop pop exch pop
|
|
% Put the values in FontInfo.
|
|
3 -1 roll
|
|
restore
|
|
Font /FontBBox get 1 get add 2 div cvi
|
|
dup FontInfo /UnderlinePosition 3 -1 roll put
|
|
2 div abs FontInfo /UnderlineThickness 3 -1 roll put
|
|
FontInfo /ItalicAngle 3 -1 roll put
|
|
|
|
% Clean up and finish.
|
|
grestore
|
|
bdfile closefile
|
|
Font currentdict end end begin % remove font from dict stack
|
|
(\n) print flush
|
|
|
|
} bind def
|
|
|
|
% ------ Reader for AFM files ------ %
|
|
|
|
% Dictionary for looking up character keywords
|
|
/cmdict 6 dict dup begin
|
|
/C { /c iarg def } def
|
|
/N { /n warg copystring def } def
|
|
/WX { /w narg def } def
|
|
/W0X /WX load def
|
|
/W /WX load def
|
|
/W0 /WX load def
|
|
end def
|
|
|
|
/readAFM % fontdict afmfilename readAFM -> fontdict
|
|
{ (r) file /bdfile exch def
|
|
/Font exch def
|
|
/commentword (Comment) def
|
|
|
|
% Check for the StartFontMetrics.
|
|
(StartFontMetrics) getline
|
|
args cvr 2.0 lt { (Not version 2.0 or greater\n) print stop } if
|
|
|
|
% Look for StartCharMetrics, then parse the character metrics.
|
|
% The only information we care about is the X width.
|
|
/metrics 0 dict def
|
|
{ nextline
|
|
keyword (EndFontMetrics) eq { exit } if
|
|
keyword (StartCharMetrics) eq
|
|
{ iarg dup dict /metrics exch def
|
|
{ /c -1 def /n null def /w null def
|
|
nextline buffer
|
|
{ token not { exit } if
|
|
dup cmdict exch known
|
|
{ exch /args exch def cmdict exch get exec args }
|
|
{ pop }
|
|
ifelse
|
|
} loop
|
|
c 0 ge n null ne or w null ne and
|
|
{ n null eq { /n Font /Encoding get c get def } if
|
|
metrics n w put
|
|
}
|
|
if
|
|
}
|
|
repeat
|
|
(EndCharMetrics) getline
|
|
} if
|
|
} loop
|
|
|
|
% Insert the metrics in the font.
|
|
metrics length 0 ne
|
|
{ Font /Metrics metrics readonly put
|
|
} if
|
|
Font
|
|
} bind def
|
|
|
|
end % envBDF
|
|
|
|
% Enter the main program in the current dictionary.
|
|
/bdfafmtops % infilename afmfilename* outfilename fontname
|
|
% encodingname uniqueID xuid
|
|
{ envBDF begin
|
|
7 -2 roll exch 7 2 roll % afm* in out fontname encodingname uniqueID xuid
|
|
readBDF % afm* font
|
|
exch { readAFM } forall
|
|
save exch
|
|
dup /FontName get exch definefont
|
|
setfont
|
|
psfile writefont
|
|
restore
|
|
psfile closefile
|
|
end
|
|
} bind def
|
|
|
|
% If the program was invoked from the command line, run it now.
|
|
[ shellarguments
|
|
{ counttomark 4 ge
|
|
{ dup 0 get
|
|
dup 48 ge exch 57 le and % last arg starts with a digit?
|
|
{ /StandardEncoding } % no encodingname
|
|
{ cvn } % have encodingname
|
|
ifelse
|
|
exch (.) search % next-to-last arg has . in it?
|
|
{ mark 4 1 roll % have xuid
|
|
{ cvi exch pop exch (.) search not { exit } if }
|
|
loop cvi ]
|
|
3 -1 roll cvi exch
|
|
}
|
|
{ cvi null % no xuid
|
|
}
|
|
ifelse
|
|
counttomark 5 roll
|
|
counttomark 6 sub array astore
|
|
7 -2 roll cvn 7 -3 roll % make sure fontname is a name
|
|
bdfafmtops
|
|
}
|
|
{ cleartomark
|
|
(Usage:\n bdftops xx.bdf [yy1.afm ...] zz.gsf fontname uniqueID [xuid] [encodingname]\n) print flush
|
|
mark
|
|
}
|
|
ifelse
|
|
}
|
|
if pop
|