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