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