sys/lib/ghostscript/bdftops.ps

   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.7 2003/08/06 17:05:09 alexcher 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