home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / sharewar / dos / inne / gs300ini / bdftops.ps < prev    next >
Encoding:
Text File  |  1994-08-02  |  23.3 KB  |  779 lines
  1. %    Copyright (C) 1990, 1991, 1993, 1994 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % bdftops.ps
  19. % Convert a BDF file (possibly with (an) associated AFM file(s))
  20. % to a PostScript Type 1 font (without eexec encryption).
  21. % The resulting font will work with any PostScript language interpreter,
  22. % but not with ATM or other font rasterizers lacking a complete interpreter.
  23.  
  24. /envBDF 120 dict def
  25. envBDF begin
  26.  
  27. % "Import" the image-to-path package.
  28. % This also brings in the Type 1 opcodes (type1ops.ps).
  29.    (impath.ps) run
  30.  
  31. % "Import" the font-writing package.
  32.    (wrfont.ps) run
  33.    wrfont_dict begin
  34.      /binary_CharStrings false def
  35.      /binary_tokens false def
  36.      /encrypt_CharStrings true def
  37.      /standard_only true def
  38.    end
  39.    /lenIV 0 def
  40.  
  41. % Invert the StandardEncoding vector.
  42.    256 dict dup begin
  43.    0 1 255 { dup StandardEncoding exch get exch def } for
  44.    end /StandardDecoding exch def
  45.  
  46. % Define the properties copied to FontInfo.
  47.    mark
  48.      (COPYRIGHT) /Notice
  49.      (FAMILY_NAME) /FamilyName
  50.      (FULL_NAME) /FullName
  51.      (WEIGHT_NAME) /Weight
  52.    .dicttomark /properties exch def
  53.  
  54. % Define the character sequences for synthesizing missing composite
  55. % characters in the standard encoding.
  56.    mark
  57.      /AE [/A /E]
  58.      /OE [/O /E]
  59.      /ae [/a /e]
  60.      /ellipsis [/period /period /period]
  61.      /emdash [/hyphen /hyphen /hyphen]
  62.      /endash [/hyphen /hyphen]
  63.      /fi [/f /i]
  64.      /fl [/f /l]
  65.      /germandbls [/s /s]
  66.      /guillemotleft [/less /less]
  67.      /guillemotright [/greater /greater]
  68.      /oe [/o /e]
  69.      /quotedblbase [/comma /comma]
  70.    .dicttomark /composites exch def
  71.  
  72. % Define the procedure for synthesizing composites.
  73. % This must not be bound.
  74.    /compose
  75.     { exch pop
  76.       FontMatrix Private /composematrix get invertmatrix concat
  77.       0 0 moveto
  78.       dup gsave false charpath pathbbox currentpoint grestore
  79.       6 2 roll setcachedevice show
  80.     } def
  81. % Define the CharString procedure that calls compose, with the string
  82. % on the stack.  This too must remain unbound.
  83.    /compose_proc
  84.     { Private /compose get exec
  85.     } def
  86.  
  87. % Define aliases for missing characters similarly.
  88.    mark
  89.      /acute /quoteright
  90.      /bullet /asterisk
  91.      /cedilla /comma
  92.      /circumflex /asciicircum
  93.      /dieresis /quotedbl
  94.      /dotlessi /i
  95.      /exclamdown /exclam
  96.      /florin /f
  97.      /fraction /slash
  98.      /grave /quoteleft
  99.      /guilsinglleft /less
  100.      /guilsinglright /greater
  101.      /hungarumlaut /quotedbl
  102.      /periodcentered /asterisk
  103.      /questiondown /question
  104.      /quotedblleft /quotedbl
  105.      /quotedblright /quotedbl
  106.      /quotesinglbase /comma
  107.      /quotesingle /quoteright
  108.      /tilde /asciitilde
  109.    .dicttomark /aliases exch def
  110.  
  111. % Define overstruck characters that can be synthesized with seac.
  112.    mark
  113.     [ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
  114.       /Ccedilla
  115.       /Eacute /Ecircumflex /Edieresis /Egrave
  116.       /Iacute /Icircumflex /Idieresis /Igrave
  117.       /Lslash
  118.       /Ntilde
  119.       /Oacute /Ocircumflex /Odieresis /Ograve /Otilde
  120.       /Scaron
  121.       /Uacute /Ucircumflex /Udieresis /Ugrave
  122.       /Yacute /Ydieresis
  123.       /Zcaron
  124.       /aacute /acircumflex /adieresis /agrave /aring /atilde
  125.       /ccedilla
  126.       /eacute /ecircumflex /edieresis /egrave
  127.       /iacute /icircumflex /idieresis /igrave
  128.       /lslash
  129.       /ntilde
  130.       /oacute /ocircumflex /odieresis /ograve /otilde
  131.       /scaron
  132.       /uacute /ucircumflex /udieresis /ugrave
  133.       /yacute /ydieresis
  134.       /zcaron
  135.     ]
  136.     { dup =string cvs
  137.       [ exch dup 0 1 getinterval cvn
  138.     exch dup length 1 sub 1 exch getinterval cvn
  139.       ]
  140.     } forall
  141.      /cent [/c /slash]
  142.      /daggerdbl [/bar /equal]
  143.      /divide [/colon /hyphen]
  144.      /sterling [/L /hyphen]
  145.      /yen [/Y /equal]
  146.    .dicttomark /accentedchars exch def
  147.  
  148. % ------ Output utilities ------ %
  149.  
  150.    /ws {psfile exch writestring} bind def
  151.    /wl {ws (\n) ws} bind def
  152.    /wt {=string cvs ws ( ) ws} bind def
  153.  
  154. % ------ BDF file parsing utilities ------ %
  155.  
  156. % Define a buffer for reading the BDF file.
  157.    /buffer 400 string def
  158.  
  159. % Read a line from the BDF file into the buffer.
  160. % Define /keyword as the first word on the line.
  161. % Define /args as the remainder of the line.
  162. % If the keyword is equal to commentword, skip the line.
  163. % (If commentword is equal to a space, never skip.)
  164.    /nextline
  165.     { bdfile buffer readline not
  166.        { (Premature EOF\n) print stop } if
  167.       ( ) search
  168.        { /keyword exch def pop }
  169.        { /keyword exch def () }
  170.       ifelse
  171.       /args exch def
  172.       keyword commentword eq { nextline } if
  173.     } bind def
  174.  
  175. % Get a word argument from args.  We do *not* copy the string.
  176.    /warg        % warg -> string
  177.     { args ( ) search
  178.        { exch pop exch }
  179.        { () }
  180.       ifelse  /args exch def
  181.     } bind def
  182.  
  183. % Get an integer argument from args.
  184.    /iarg        % iarg -> int
  185.     { warg cvi
  186.     } bind def
  187.  
  188. % Get a numeric argument from args.
  189.    /narg        % narg -> int|real
  190.     { warg cvr
  191.       dup dup cvi eq { cvi } if
  192.     } bind def
  193.  
  194. % Convert the remainder of args into a string.
  195.    /remarg        % remarg -> string
  196.     { args copystring
  197.     } bind def
  198.  
  199. % Get a string argument that occupies the remainder of args.
  200.    /sarg        % sarg -> string
  201.     { args (") anchorsearch
  202.        { pop /args exch def } { pop } ifelse
  203.       args args length 1 sub get (") 0 get eq
  204.        { args 0 args length 1 sub getinterval /args exch def } if
  205.       args copystring
  206.     } bind def
  207.  
  208. % Check that the keyword is the expected one.
  209.    /checkline        % (EXPECTED-KEYWORD) checkline ->
  210.     { dup keyword ne
  211.        { (Expected ) print =
  212.          (Line=) print keyword print ( ) print args print (\n) print stop
  213.        } if
  214.       pop
  215.     } bind def
  216.  
  217. % Read a line and check its keyword.
  218.    /getline        % (EXPECTED-KEYWORD) getline ->
  219.     { nextline checkline
  220.     } bind def
  221.  
  222. % Find the first/last non-zero bit of a non-zero byte.
  223.    /fnzb
  224.     { 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
  225.       loop
  226.     } bind def
  227.    /lnzb
  228.     { 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
  229.       loop
  230.     } bind def
  231.  
  232. % ------ Type 1 encoding utilities ------ %
  233.  
  234. % Parse the side bearing and width information that begins a CharString.
  235. % Arguments: charstring.  Result: sbx sby wx wy substring.
  236.    /parsesbw
  237.     { mark exch lenIV
  238.        {        % stack: mark ... string dropcount
  239.          dup 2 index length exch sub getinterval
  240.      dup 0 get dup 32 lt { pop exit } if
  241.      dup 246 le
  242.       { 139 sub exch 1 }
  243.       { dup 250 le
  244.          { 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
  245.          { dup 254 le
  246.         { 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
  247.         { pop dup 1 get 128 xor 128 sub
  248.           8 bitshift 1 index 2 get add
  249.           8 bitshift 1 index 3 get add
  250.           8 bitshift 1 index 4 get add exch 5
  251.         } ifelse
  252.          } ifelse
  253.       } ifelse
  254.        } loop
  255.       counttomark 3 eq { 0 3 1 roll 0 exch } if
  256.       6 -1 roll pop
  257.     } bind def 
  258.  
  259. % Find the side bearing and width information that begins a CharString.
  260. % Arguments: charstring.  Result: charstring sizethroughsbw.
  261.    /findsbw
  262.     { dup parsesbw 4 { exch pop } repeat skipsbw
  263.     } bind def
  264.    /skipsbw        % charstring sbwprefix -> sizethroughsbw
  265.     { length 1 index length exch sub
  266.       2 copy get 12 eq { 2 } { 1 } ifelse add
  267.     } bind def
  268.  
  269. % Encode a number, and append it to a string.
  270. % Arguments: str num.  Result: newstr.
  271.    /concatnum
  272.     { dup dup -107 ge exch 107 le and
  273.        { 139 add 1 string dup 0 3 index put }
  274.        { dup dup -1131 ge exch 1131 le and
  275.           { dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
  276.         2 string dup 0 3 index -8 bitshift put
  277.         dup 1 3 index 255 and put
  278.       }
  279.       { 5 string dup 0 255 put exch
  280.         2 copy 1 exch -24 bitshift 255 and put
  281.         2 copy 2 exch -16 bitshift 255 and put
  282.         2 copy 3 exch -8 bitshift 255 and put
  283.         2 copy 4 exch 255 and put
  284.         exch
  285.       }
  286.      ifelse
  287.        }
  288.       ifelse exch pop concatstrings
  289.     } bind def
  290.  
  291. % ------ Point arithmetic utilities ------ %
  292.  
  293.    /ptadd { exch 4 -1 roll add 3 1 roll add } bind def
  294.    /ptexch { 4 2 roll } bind def
  295.    /ptneg { neg exch neg exch } bind def
  296.    /ptpop { pop pop } bind def
  297.    /ptsub { ptneg ptadd } bind def
  298.  
  299. % ------ The main program ------ %
  300.  
  301.    /readBDF        % <infilename> <outfilename> <fontname>
  302.             %   <encodingname> <uniqueID> <xuid> readBDF -> <font>
  303.     { /xuid exch def        % may be null
  304.       /uniqueID exch def    % may be -1
  305.       /encodingname exch def
  306.     /encoding encodingname cvx exec def
  307.       /fontname exch def
  308.       /psname exch def
  309.       /bdfname exch def
  310.       gsave        % so we can set the CTM to the font matrix
  311.  
  312. %  Open the input files.  We don't open the output file until
  313. %  we've done a minimal validity check on the input.
  314.       bdfname (r) file /bdfile exch def
  315.       /commentword ( ) def
  316.  
  317. %  Check for the STARTFONT.
  318.       (STARTFONT) getline
  319.       args (2.1) ne { (Not version 2.1\n) print stop } if
  320.  
  321. %  Initialize the font.
  322.       /Font 20 dict def
  323.       Font begin
  324.       /FontName fontname def
  325.       /PaintType 0 def
  326.       /FontType 1 def
  327.       uniqueID 0 gt { /UniqueID uniqueID def } if
  328.       xuid null ne { /XUID xuid def } if
  329.       /Encoding encoding def
  330.       /FontInfo 20 dict def
  331.       /Private 20 dict def
  332.       currentdict end currentdict end
  333.       exch begin begin        % insert font above environment
  334.  
  335. %  Initialize the Private dictionary in the font.
  336.       Private begin
  337.       /-! {string currentfile exch readhexstring pop} readonly def
  338.       /-| {string currentfile exch readstring pop} readonly def
  339.       /|- {readonly def} readonly def
  340.       /| {readonly put} readonly def
  341.       /BlueValues [] def
  342.       /lenIV lenIV def
  343.       /MinFeature {16 16} def
  344.       /password 5839 def
  345.       /UniqueID uniqueID def
  346.       end        % Private
  347.  
  348. %  Invert the Encoding, for synthesizing composite characters.
  349.       /decoding encoding length dict def
  350.       0 1 encoding length 1 sub
  351.        { dup encoding exch get exch decoding 3 1 roll put }
  352.       for
  353.  
  354. %  Now open the output file.
  355.       psname (w) file /psfile exch def
  356.  
  357. %  Put out a header compatible with the Adobe "standard".
  358.       (%!FontType1-1.0: ) ws fontname wt (000.000) wl
  359.       (% This is a font description converted from ) ws
  360.     bdfname wl
  361.       (%   by bdftops running on ) ws
  362.       statusdict /product get ws ( revision ) ws
  363.       revision =string cvs ws (.) wl
  364.  
  365. %  Copy the initial comments, up to FONT.
  366.       true
  367.        { nextline
  368.      keyword (COMMENT) ne {exit} if
  369.       { (% Here are the initial comments from the BDF file:\n%) wl
  370.       } if false
  371.      (%) ws remarg wl
  372.        } loop pop
  373.       () wl
  374.       /commentword (COMMENT) def    % do skip comments from now on
  375.  
  376. %  Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
  377.       % If we cared about FONT, we'd use it here.  If the BDF files
  378.       % from MIT had PostScript names rather than X names, we would
  379.       % care; but what's there is unusable, so we discard FONT.
  380.       % The FONTBOUNDINGBOX may not be reliable, so we discard it too.
  381.       (FONT) checkline
  382.       (SIZE) getline
  383.     /pointsize iarg def   /xres iarg def   /yres iarg def
  384.       (FONTBOUNDINGBOX) getline
  385.       nextline
  386.  
  387. %  Initialize the font bounding box bookeeping.
  388.       /fbbxo 1000 def
  389.       /fbbyo 1000 def
  390.       /fbbxe -1000 def
  391.       /fbbye -1000 def
  392.  
  393. %  Read and process the properties.  We only care about a few of them.
  394.       keyword (STARTPROPERTIES) eq
  395.        { iarg
  396.           { nextline
  397.         properties keyword known
  398.          { FontInfo properties keyword get sarg readonly put
  399.          } if
  400.       } repeat
  401.          (ENDPROPERTIES) getline
  402.      nextline
  403.        } if
  404.  
  405. %  Compute and set the FontMatrix.
  406.       Font /FontMatrix
  407.        [ 0.001 0 0 0.001 xres mul yres div 0 0 ] readonly
  408.       dup setmatrix put
  409.  
  410. %  Read and process the header for the bitmaps.
  411.       (CHARS) checkline
  412.     /ccount iarg def
  413.  
  414. %  Initialize the CharStrings dictionary.
  415.       /charstrings ccount
  416.     composites length add
  417.     aliases length add
  418.     accentedchars length add
  419.     1 add dict def        % 1 add for .notdef
  420.       /isfixedwidth true def
  421.       /fixedwidth null def
  422.       /subrcount 0 def
  423.       /subrs [] def
  424.  
  425. %  Read the bitmap data.  This reads the remainder of the file.
  426. %  We do this before processing the bitmaps so that we can compute
  427. %  the correct FontBBox first.
  428.       /chardata ccount dict def
  429.       ccount -1 1
  430.        { (STARTCHAR) getline
  431.            /charname remarg def
  432.      (/) print charname print
  433.        10 mod 1 eq { (\n) print flush } if
  434.      (ENCODING) getline        % Ignore, assume StandardEncoding
  435.      (SWIDTH) getline
  436.        /swx iarg pointsize mul 1000 div xres mul 72 div def
  437.        /swy iarg pointsize mul 1000 div xres mul 72 div def
  438.      (DWIDTH) getline        % Ignore, use SWIDTH instead
  439.      (BBX) getline
  440.        /bbw iarg def  /bbh iarg def  /bbox iarg def  /bboy iarg def
  441.      nextline
  442.      keyword (ATTRIBUTES) eq
  443.       { nextline
  444.       } if
  445.      (BITMAP) checkline
  446.  
  447. % Update the font bounding box.
  448.      /fbbxo fbbxo bbox min def
  449.      /fbbyo fbbyo bboy min def
  450.      /fbbxe fbbxe bbox bbw add max def
  451.      /fbbye fbbye bboy bbh add max def
  452.  
  453. % Read the bits for this character.
  454.      /raster bbw 7 add 8 idiv def
  455.      /cbits raster bbh mul string def
  456.      0 raster cbits length raster sub
  457.       { cbits exch raster getinterval
  458.         bdfile buffer readline not
  459.          { (EOF in bitmap\n) print stop } if
  460.         % stack has <cbits.interval> <buffer.interval>
  461.         0 () /SubFileDecode filter
  462.         exch 2 copy readhexstring pop pop pop closefile
  463.       } for
  464.      (ENDCHAR) getline
  465.  
  466. % Save the character data.
  467.      chardata charname [swx swy bbw bbh bbox bboy cbits] put
  468.        } for
  469.  
  470.       (ENDFONT) getline
  471.  
  472. % Allocate the buffers for the bitmap and the outline,
  473. % according to the font bounding box.
  474.       /fbbw fbbxe fbbxo sub def
  475.       /fbbh fbbye fbbyo sub def
  476.       /fraster fbbw 7 add 8 idiv def
  477.       /bits fraster fbbh mul 200 max 65535 min string def
  478.       /outline bits length 6 mul 65535 min string def
  479.  
  480. %  Process the characters.
  481.       chardata
  482.        { exch /charname exch def  aload pop
  483.      /cbits exch def
  484.      /bboy exch def   /bbox exch def
  485.      /bbh exch def   /bbw exch def
  486.      /swy exch def   /swx exch def
  487.  
  488. % The bitmap handed to type1imagepath must have the correct height,
  489. % because type1imagepath uses this to compute the scale factor,
  490. % so we have to clear the unused parts of it.
  491.      /raster bbw 7 add 8 idiv def
  492.      bits dup 0 1 raster fbbh mul 1 sub
  493.       { 0 put dup } for
  494.      pop pop
  495.      bits raster fbbh bbh sub mul cbits putinterval
  496.  
  497. %  Compute the font entry, converting the bitmap to an outline.
  498.      bits 0 raster fbbh mul getinterval    % the bitmap image
  499.      bbw   fbbh                % bitmap width & height
  500.      swx   swy                % width x & y
  501.      bbox neg   bboy neg            % origin x & y
  502.          % Account for lenIV when converting the outline.
  503.      outline  lenIV  outline length lenIV sub  getinterval
  504.      type1imagepath
  505.      length lenIV add
  506.      outline exch 0 exch getinterval
  507.  
  508. % Check for a fixed width font.
  509.      isfixedwidth
  510.       { fixedwidth null eq
  511.          { /fixedwidth swx def }
  512.          { fixedwidth swx ne { /isfixedwidth false def } if }
  513.         ifelse
  514.       } if
  515.  
  516. % Finish up the character.
  517.      copystring
  518.      charname exch charstrings 3 1 roll put
  519.        } forall
  520.  
  521. %  Add CharStrings entries for aliases.
  522.       aliases
  523.        { charstrings 2 index known not charstrings 2 index known and
  524.           { charstrings exch get charstrings 3 1 roll put
  525.       }
  526.       { pop pop
  527.       }
  528.      ifelse
  529.        }
  530.       forall
  531.  
  532. %  If this is not a fixed-width font, synthesize missing characters
  533. %  out of available ones.
  534.       isfixedwidth not
  535.        { false composites
  536.       { 1 index charstrings exch known not
  537.         1 index { decoding exch known and } forall
  538.          { ( /) print 1 index bits cvs print
  539.            /combine exch def
  540.            0 1 combine length 1 sub
  541.         { dup combine exch get decoding exch get
  542.           bits 3 1 roll put
  543.         } for
  544.            bits 0 combine length getinterval copystring
  545.            [ exch /compose_proc load aload pop ] cvx
  546.            charstrings 3 1 roll put
  547.            pop true
  548.          }
  549.          { pop pop }
  550.         ifelse
  551.       }
  552.      forall flush
  553.       { Private /composematrix matrix put
  554.         Private /compose /compose load put
  555.       }
  556.      if
  557.        }
  558.       if
  559.  
  560. %  Synthesize accented characters with seac if needed and possible.
  561.       accentedchars
  562.        { aload pop /accent exch def /base exch def
  563.          buffer cvs /accented exch def
  564.      charstrings accented known not
  565.      charstrings base known and
  566.      charstrings accent known and
  567.      StandardDecoding base known and
  568.      StandardDecoding accent known and
  569.      encoding StandardDecoding base get get base eq and
  570.      encoding StandardDecoding accent get get accent eq and
  571.       { ( /) print accented print
  572.         charstrings base get findsbw 0 exch getinterval
  573.         /acstring exch def        % start with sbw of base
  574.         charstrings accent get parsesbw
  575.         4 { pop } repeat        % just leave sbx
  576.         acstring exch concatnum
  577.         0 concatnum 0 concatnum        % adx ady
  578.         decoding base get concatnum        % bchar
  579.         decoding accent get concatnum    % achar
  580.         s_seac concatstrings
  581.         charstrings exch accented copystring exch put
  582.       } if
  583.        } forall
  584.  
  585. %  Make a CharStrings entry for .notdef.
  586.       outline lenIV <8b8b0d0e> putinterval    % 0 0 hsbw endchar
  587.       charstrings /.notdef outline 0 lenIV 4 add getinterval copystring put
  588.  
  589. %  Encrypt the CharStrings and Subrs (in place).
  590.       charstrings
  591.        {    % Be careful not to encrypt aliased characters twice,
  592.         % since they share their CharString.
  593.      aliases 2 index known
  594.       { charstrings aliases 3 index get .knownget
  595.          { 1 index ne }
  596.          { true }
  597.         ifelse
  598.       }
  599.       { true
  600.       }
  601.      ifelse
  602.      1 index type /stringtype eq and
  603.           { 4330 exch dup .type1encrypt exch pop
  604.         readonly charstrings 3 1 roll put
  605.       }
  606.       { pop pop
  607.       }
  608.      ifelse
  609.        }
  610.       forall
  611.       0 1 subrcount 1 sub
  612.        { dup subrs exch get
  613.      4330 exch dup .type1encrypt exch pop
  614.      subrs 3 1 roll put
  615.        }
  616.       for
  617.  
  618. %  Make most of the remaining entries in the font dictionaries.
  619.  
  620. % The Type 1 font machinery really only works with a 1000 unit
  621. % character coordinate system.  Set this up here, by computing the factor
  622. % to make the X entry in the FontMatrix come out at exactly 0.001.
  623.       /fontscale 1000 fbbh div yres mul xres div def
  624.       Font /FontBBox
  625.        [ fbbxo fontscale mul
  626.      fbbyo fontscale mul
  627.      fbbxe fontscale mul
  628.      fbbye fontscale mul
  629.        ] cvx readonly put
  630.       Font /CharStrings charstrings readonly put
  631.       FontInfo /FullName known not
  632.        { % Some programs insist on FullName being present.
  633.          FontInfo /FullName FontName dup length string cvs put
  634.        }
  635.       if
  636.       FontInfo /isFixedPitch isfixedwidth put
  637.       subrcount 0 gt
  638.        { Private /Subrs subrs 0 subrcount getinterval readonly put
  639.        } if
  640.  
  641. %  Determine the italic angle and underline position
  642. %  by actually installing the font.
  643.       save
  644.       /_temp_ Font definefont setfont
  645.       [1000 0 0 1000 0 0] setmatrix        % mitigate rounding problems
  646. % The italic angle is the multiple of -5 degrees
  647. % that minimizes the width of the 'I'.
  648.       0 9999 0 5 85
  649.        { dup rotate
  650.          newpath 0 0 moveto (I) false charpath
  651.      dup neg rotate
  652.          pathbbox pop exch pop exch sub
  653.      dup 3 index lt { 4 -2 roll } if
  654.      pop pop
  655.        }
  656.       for pop
  657. % The underline position is halfway between the bottom of the 'A'
  658. % and the bottom of the FontBBox.
  659.       newpath 0 0 moveto (A) false charpath
  660.       FontMatrix concat
  661.       pathbbox pop pop exch pop
  662. %  Put the values in FontInfo.
  663.       3 -1 roll
  664.       restore
  665.       Font /FontBBox get 1 get add 2 div cvi
  666.       dup FontInfo /UnderlinePosition 3 -1 roll put
  667.       2 div abs FontInfo /UnderlineThickness 3 -1 roll put
  668.       FontInfo /ItalicAngle 3 -1 roll put
  669.  
  670. %  Clean up and finish.
  671.       grestore
  672.       bdfile closefile
  673.       Font currentdict end end begin        % remove font from dict stack
  674.       (\n) print flush
  675.  
  676.     } bind def
  677.  
  678. % ------ Reader for AFM files ------ %
  679.  
  680. % Dictionary for looking up character keywords
  681.    /cmdict 6 dict dup begin
  682.       /C { /c iarg def } def
  683.       /N { /n warg copystring def } def
  684.       /WX { /w narg def } def
  685.       /W0X /WX load def
  686.       /W /WX load def
  687.       /W0 /WX load def
  688.    end def
  689.  
  690.    /readAFM        % fontdict afmfilename readAFM -> fontdict
  691.     { (r) file /bdfile exch def
  692.       /Font exch def
  693.       /commentword (Comment) def
  694.  
  695. %  Check for the StartFontMetrics.
  696.       (StartFontMetrics) getline
  697.       args cvr 2.0 lt { (Not version 2.0 or greater\n) print stop } if
  698.  
  699. %  Look for StartCharMetrics, then parse the character metrics.
  700. %  The only information we care about is the X width.
  701.       /metrics 0 dict def
  702.        { nextline
  703.          keyword (EndFontMetrics) eq { exit } if
  704.      keyword (StartCharMetrics) eq
  705.       { iarg dup dict /metrics exch def
  706.          { /c -1 def /n null def /w null def
  707.            nextline buffer
  708.         { token not { exit } if
  709.           dup cmdict exch known
  710.            { exch /args exch def   cmdict exch get exec   args }
  711.            { pop }
  712.           ifelse
  713.         } loop
  714.            c 0 ge n null ne or w null ne and
  715.         { n null eq { /n Font /Encoding get c get def } if
  716.           metrics n w put
  717.         }
  718.            if
  719.          }
  720.         repeat
  721.         (EndCharMetrics) getline
  722.       } if
  723.        } loop
  724.  
  725. %  Insert the metrics in the font.
  726.        metrics length 0 ne
  727.     { Font /Metrics metrics readonly put
  728.     } if
  729.       Font
  730.     } bind def
  731.  
  732. end        % envBDF
  733.  
  734. % Enter the main program in the current dictionary.
  735. /bdfafmtops        % infilename afmfilename* outfilename fontname
  736.             %   encodingname uniqueID xuid
  737.  { envBDF begin
  738.      7 -2 roll exch 7 2 roll    % afm* in out fontname encodingname uniqueID xuid
  739.      readBDF        % afm* font
  740.      exch { readAFM } forall
  741.      save exch
  742.      dup /FontName get exch definefont
  743.      setfont
  744.      psfile writefont
  745.      restore
  746.      psfile closefile
  747.    end
  748.  } bind def
  749.  
  750. % If the program was invoked from the command line, run it now.
  751. [ shellarguments
  752.  { counttomark 4 ge
  753.     { dup 0 get
  754.       dup 48 ge exch 57 le and        % last arg starts with a digit?
  755.        { /StandardEncoding }        % no encodingname
  756.        { cvn }                % have encodingname
  757.       ifelse
  758.       exch (.) search            % next-to-last arg has . in it?
  759.        { mark 4 1 roll            % have xuid
  760.           { cvi exch pop exch (.) search not { exit } if }
  761.      loop cvi ]
  762.      3 -1 roll cvi exch
  763.        }
  764.        { cvi null            % no xuid
  765.        }
  766.       ifelse
  767.       counttomark 5 roll
  768.       counttomark 6 sub array astore
  769.       7 -2 roll cvn 7 -3 roll        % make sure fontname is a name
  770.       bdfafmtops
  771.     }
  772.     { cleartomark
  773.       (Usage:\n  bdftops xx.bdf [yy1.afm ...] zz.gsf fontname uniqueID [xuid] [encodingname]\n) print flush
  774.       mark
  775.     }
  776.    ifelse
  777.  }
  778. if pop
  779.