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