summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/lib/bdftops.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/lib/bdftops.ps')
-rw-r--r--[-rwxr-xr-x]Master/tlpkg/tlgs/lib/bdftops.ps1590
1 files changed, 795 insertions, 795 deletions
diff --git a/Master/tlpkg/tlgs/lib/bdftops.ps b/Master/tlpkg/tlgs/lib/bdftops.ps
index 3b620d0eb59..bf310c529de 100755..100644
--- a/Master/tlpkg/tlgs/lib/bdftops.ps
+++ b/Master/tlpkg/tlgs/lib/bdftops.ps
@@ -1,795 +1,795 @@
-% 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 6300 2005-12-28 19:56:24Z giles $
-% 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
+% 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 6300 2005-12-28 19:56:24Z giles $
+% 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