Import sources from 2011-03-30 iso image - sys/lib

1 files changed, 795 insertions, 0 deletions

diff --git a/sys/lib/ghostscript/bdftops.ps b/sys/lib/ghostscript/bdftops.ps
new file mode 100755
index 000000000..026ba8970
--- /dev/null
+++ b/sys/lib/ghostscript/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,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