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--Master/tlpkg/tlgs/lib/bdftops.ps795
1 files changed, 795 insertions, 0 deletions
diff --git a/Master/tlpkg/tlgs/lib/bdftops.ps b/Master/tlpkg/tlgs/lib/bdftops.ps
new file mode 100644
index 00000000000..3b620d0eb59
--- /dev/null
+++ b/Master/tlpkg/tlgs/lib/bdftops.ps
@@ -0,0 +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