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