scripts/build/mf2pt1.pl

   1 #!@PERL@
   2
   3 ##################################################
   4 # Convert stylized Metafont to PostScript Type 1 #
   5 # By Scott Pakin <scott+mf@pakin.org>            #
   6 ##################################################
   7
   8 ########################################################################
   9 # mf2pt1                                                               #
  10 # Copyright (C) 2008 Scott Pakin                                       #
  11 #                                                                      #
  12 # This program may be distributed and/or modified under the conditions #
  13 # of the LaTeX Project Public License, either version 1.3c of this     #
  14 # license or (at your option) any later version.                       #
  15 #                                                                      #
  16 # The latest version of this license is in:                            #
  17 #                                                                      #
  18 #    http://www.latex-project.org/lppl.txt                             #
  19 #                                                                      #
  20 # and version 1.3c or later is part of all distributions of LaTeX      #
  21 # version 2006/05/20 or later.                                         #
  22 ########################################################################
  23
  24 our $VERSION = "2.4.4";   # mf2pt1 version number
  25 require 5.6.1;            # I haven't tested mf2pt1 with older Perl versions
  26
  27 use File::Basename;
  28 use File::Spec;
  29 use Getopt::Long;
  30 use Pod::Usage;
  31 use Math::Trig;
  32 use warnings;
  33 use strict;
  34
  35 # Define some common encoding vectors.
  36 my @standardencoding =
  37     ((map {"_a$_"} (0..31)),
  38      qw (space exclam quotedbl numbersign dollar percent ampersand
  39          quoteright parenleft parenright asterisk plus comma hyphen
  40          period slash zero one two three four five six seven eight
  41          nine colon semicolon less equal greater question at A B C D E
  42          F G H I J K L M N O P Q R S T U V W X Y Z bracketleft
  43          backslash bracketright asciicircum underscore quoteleft a b c
  44          d e f g h i j k l m n o p q r s t u v w x y z braceleft bar
  45          braceright asciitilde),
  46      (map {"_a$_"} (127..160)),
  47      qw (exclamdown cent sterling fraction yen florin section currency
  48          quotesingle quotedblleft guillemotleft guilsinglleft
  49          guilsinglright fi fl _a176 endash dagger daggerdbl
  50          periodcentered _a181 paragraph bullet quotesinglbase
  51          quotedblbase quotedblright guillemotright ellipsis
  52          perthousand _a190 questiondown _a192 grave acute circumflex
  53          tilde macron breve dotaccent dieresis _a201 ring cedilla
  54          _a204 hungarumlaut ogonek caron emdash),
  55      (map {"_a$_"} (209..224)),
  56      qw (AE _a226 ordfeminine _a228 _a229 _a230 _a231 Lslash Oslash OE
  57          ordmasculine _a236 _a237 _a238 _a239 _a240 ae _a242 _a243
  58          _a244 dotlessi _a246 _a247 lslash oslash oe germandbls _a252
  59          _a253 _a254 _a255));
  60 my @isolatin1encoding =
  61     ((map {"_a$_"} (0..31)),
  62      qw (space exclam quotedbl numbersign dollar percent ampersand
  63          quoteright parenleft parenright asterisk plus comma minus
  64          period slash zero one two three four five six seven eight
  65          nine colon semicolon less equal greater question at A B C D E
  66          F G H I J K L M N O P Q R S T U V W X Y Z bracketleft
  67          backslash bracketright asciicircum underscore quoteleft a b c
  68          d e f g h i j k l m n o p q r s t u v w x y z braceleft bar
  69          braceright asciitilde),
  70      (map {"_a$_"} (128..143)),
  71      qw (dotlessi grave acute circumflex tilde macron breve dotaccent
  72          dieresis _a153 ring cedilla _a156 hungarumlaut ogonek
  73          caron space exclamdown cent sterling currency yen brokenbar
  74          section dieresis copyright ordfeminine guillemotleft
  75          logicalnot hyphen registered macron degree plusminus
  76          twosuperior threesuperior acute mu paragraph periodcentered
  77          cedilla onesuperior ordmasculine guillemotright onequarter
  78          onehalf threequarters questiondown Agrave Aacute Acircumflex
  79          Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex
  80          Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde
  81          Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash
  82          Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls
  83          agrave aacute acircumflex atilde adieresis aring ae ccedilla
  84          egrave eacute ecircumflex edieresis igrave iacute icircumflex
  85          idieresis eth ntilde ograve oacute ocircumflex otilde
  86          odieresis divide oslash ugrave uacute ucircumflex udieresis
  87          yacute thorn ydieresis));
  88 my @ot1encoding =
  89     qw (Gamma Delta Theta Lambda Xi Pi Sigma Upsilon Phi
  90         Psi Omega ff fi fl ffi ffl dotlessi dotlessj grave acute caron
  91         breve macron ring cedilla germandbls ae oe oslash AE OE Oslash
  92         suppress exclam quotedblright numbersign dollar percent
  93         ampersand quoteright parenleft parenright asterisk plus comma
  94         hyphen period slash zero one two three four five six seven
  95         eight nine colon semicolon exclamdown equal questiondown
  96         question at A B C D E F G H I J K L M N O P Q R S T U V W X Y
  97         Z bracketleft quotedblleft bracketright circumflex dotaccent
  98         quoteleft a b c d e f g h i j k l m n o p q r s t u v w x y z
  99         endash emdash hungarumlaut tilde dieresis);
 100 my @t1encoding =
 101     qw (grave acute circumflex tilde dieresis hungarumlaut ring caron
 102         breve macron dotaccent cedilla ogonek quotesinglbase
 103         guilsinglleft guilsinglright quotedblleft quotedblright
 104         quotedblbase guillemotleft guillemotright endash emdash cwm
 105         perthousand dotlessi dotlessj ff fi fl ffi ffl space exclam
 106         quotedbl numbersign dollar percent ampersand quoteright
 107         parenleft parenright asterisk plus comma hyphen period slash
 108         zero one two three four five six seven eight nine colon
 109         semicolon less equal greater question at A B C D E F G H I J K L
 110         M N O P Q R S T U V W X Y Z bracketleft backslash bracketright
 111         asciicircum underscore quoteleft a b c d e f g h i j k l m n o p
 112         q r s t u v w x y z braceleft bar braceright asciitilde
 113         sfthyphen Abreve Aogonek Cacute Ccaron Dcaron Ecaron Eogonek
 114         Gbreve Lacute Lcaron Lslash Nacute Ncaron Eng Ohungarumlaut
 115         Racute Rcaron Sacute Scaron Scedilla Tcaron Tcedilla
 116         Uhungarumlaut Uring Ydieresis Zacute Zcaron Zdotaccent IJ
 117         Idotaccent dcroat section abreve aogonek cacute ccaron dcaron
 118         ecaron eogonek gbreve lacute lcaron lslash nacute ncaron eng
 119         ohungarumlaut racute rcaron sacute scaron scedilla tcaron
 120         tcedilla uhungarumlaut uring ydieresis zacute zcaron zdotaccent
 121         ij exclamdown questiondown sterling Agrave Aacute Acircumflex
 122         Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex
 123         Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve
 124         Oacute Ocircumflex Otilde Odieresis OE Oslash Ugrave Uacute
 125         Ucircumflex Udieresis Yacute Thorn SS agrave aacute acircumflex
 126         atilde adieresis aring ae ccedilla egrave eacute ecircumflex
 127         edieresis igrave iacute icircumflex idieresis eth ntilde ograve
 128         oacute ocircumflex otilde odieresis oe oslash ugrave uacute
 129         ucircumflex udieresis yacute thorn germandbls);
 130
 131 # Define font parameters that the user can override.
 132 my $fontversion;
 133 my $creationdate;
 134 my $comment;
 135 my $familyname;
 136 my $weight;
 137 my $fullname;
 138 my $fixedpitch;
 139 my $italicangle;
 140 my $underlinepos;
 141 my $underlinethick;
 142 my $fontname;
 143 my $uniqueID;
 144 my $designsize;
 145 my ($mffile, $pt1file, $pfbfile, $ffscript);
 146 my $encoding;
 147 my $rounding;
 148 my $bpppix;
 149
 150 # Define all of our other global variables.
 151 my $progname = basename $0, ".pl";
 152 my $mag;
 153 my @fontbbox;
 154 my @charbbox;
 155 my @charwd;
 156 my @glyphname;
 157 my @charfiles;
 158 my $filebase;
 159 my $filedir;
 160 my $filenoext;
 161 my $versionmsg = "mf2pt1 version $VERSION
 162
 163 Copyright (C) 2008 Scott Pakin
 164
 165 This program may be distributed and/or modified under the conditions
 166 of the LaTeX Project Public License, either version 1.3c of this
 167 license or (at your option) any later version.
 168
 169 The latest version of this license is in:
 170
 171    http://www.latex-project.org/lppl.txt
 172
 173 and version 1.3c or later is part of all distributions of LaTeX
 174 version 2006/05/20 or later.
 175 ";
 176
 177
 178 ######################################################################
 179
 180 # The routines to compute the fractional approximation of a real number
 181 # are heavily based on code posted by Ben Tilly
 182 # <http://www.perlmonks.org/?node_id=26179> on Nov 16th, 2000, to the
 183 # PerlMonks list.  See <http://www.perlmonks.org/index.pl?node_id=41961>.
 184
 185
 186 # Takes numerator/denominator pairs.
 187 # Returns a PS fraction string representation (with a trailing space).
 188 sub frac_string (@)
 189 {
 190     my $res = "";
 191
 192     while (@_) {
 193         my $n = shift;
 194         my $d = shift;
 195         $res .= $n . " ";
 196         $res .= $d . " div " if $d > 1;
 197     }
 198
 199     return $res;
 200 }
 201
 202
 203 # Takes a number.
 204 # Returns a numerator and denominator with the smallest denominator
 205 # so that the difference of the resulting fraction to the number is
 206 # smaller or equal to $rounding.
 207 sub frac_approx ($)
 208 {
 209     my $num = shift;
 210     my $f = ret_frac_iter ($num);
 211
 212     while (1) {
 213         my ($n, $m) = $f->();
 214         my $approx = $n / $m;
 215         my $delta = abs ($num - $approx);
 216         return ($n, $m) if ($delta <= $rounding);
 217     }
 218 }
 219
 220
 221 # Takes a number, returns the best integer approximation and (in list
 222 # context) the error.
 223 sub best_int ($)
 224 {
 225     my $x = shift;
 226     my $approx = sprintf '%.0f', $x;
 227     if (wantarray) {
 228         return ($approx, $x - $approx);
 229     }
 230     else {
 231         return $approx;
 232     }
 233 }
 234
 235
 236 # Takes a numerator and denominator, in scalar context returns
 237 # the best fraction describing them, in list the numerator and
 238 # denominator.
 239 sub frac_standard ($$)
 240 {
 241     my $n = best_int(shift);
 242     my $m = best_int(shift);
 243     my $k = gcd($n, $m);
 244     $n /= $k;
 245     $m /= $k;
 246     if ($m < 0) {
 247         $n *= -1;
 248         $m *= -1;
 249     }
 250     if (wantarray) {
 251         return ($n, $m);
 252     }
 253     else {
 254         return "$n/$m";
 255     }
 256 }
 257
 258
 259 # Euclidean algorithm for calculating a GCD.
 260 # Takes two integers, returns the greatest common divisor.
 261 sub gcd ($$)
 262 {
 263     my ($n, $m) = @_;
 264     while ($m) {
 265         my $k = $n % $m;
 266         ($n, $m) = ($m, $k);
 267     }
 268     return $n;
 269 }
 270
 271
 272 # Takes a list of terms in a continued fraction, and converts it
 273 # into a fraction.
 274 sub ints_to_frac (@)
 275 {
 276     my ($n, $m) = (0, 1);     # Start with 0
 277     while (@_) {
 278         my $k = pop;
 279         if ($n) {
 280             # Want frac for $k + 1/($n/$m)
 281             ($n, $m) = frac_standard($k*$n + $m, $n);
 282         }
 283         else {
 284             # Want $k
 285             ($n, $m) = frac_standard($k, 1);
 286         }
 287     }
 288     return frac_standard($n, $m);
 289 }
 290
 291
 292 # Takes a number, returns an anon sub which iterates through a set of
 293 # fractional approximations that converges very quickly to the number.
 294 sub ret_frac_iter ($)
 295 {
 296     my $x = shift;
 297     my $term_iter = ret_next_term_iter($x);
 298     my @ints;
 299     return sub {
 300         push @ints, $term_iter->();
 301         return ints_to_frac(@ints);
 302     }
 303 }
 304
 305
 306 # Terms of a continued fraction converging on that number.
 307 sub ret_next_term_iter ($)
 308 {
 309     my $x = shift;
 310     return sub {
 311         (my $n, $x) = best_int($x);
 312         if (0 != $x) {
 313             $x = 1/$x;
 314         }
 315         return $n;
 316     }
 317 }
 318
 319 ######################################################################
 320
 321 # Round a number to the nearest integer.
 322 sub round ($)
 323 {
 324     return int($_[0] + 0.5*($_[0] <=> 0));
 325 }
 326
 327
 328 # Round a number to a given precision.
 329 sub prec ($)
 330 {
 331   return round ($_[0] / $rounding) * $rounding;
 332 }
 333
 334
 335 # Set a variable's value to the first defined value in the given list.
 336 # If the variable was not previously defined and no value in the list
 337 # is defined, do nothing.
 338 sub assign_default (\$@)
 339 {
 340     my $varptr = shift;        # Pointer to variable to define
 341     return if defined $$varptr && $$varptr ne "UNSPECIFIED";
 342     foreach my $val (@_) {
 343         next if !defined $val;
 344         $$varptr = $val;
 345         return;
 346     }
 347 }
 348
 349
 350 # Print and execute a shell command.  An environment variable with the
 351 # same name as the command overrides the command name.  Return 1 on
 352 # success, 0 on failure.  Optionally abort if the command fails, based
 353 # on the first argument to execute_command.
 354 sub execute_command ($@)
 355 {
 356     my $abort_on_failure = shift;
 357     my @command = @_;
 358     $command[0] = $ENV{uc $command[0]} || $command[0];
 359     my $prettyargs = join (" ", map {/[\\ ]/ ? "'$_'" : $_} @command);
 360     print "Invoking \"$prettyargs\"...\n";
 361     my $result = system @command;
 362     die "${progname}: \"$prettyargs\" failed ($!)\n" if $result && $abort_on_failure;
 363     return !$result;
 364 }
 365
 366
 367 # Output the font header.
 368 sub output_header ()
 369 {
 370     # Show the initial boilerplate.
 371     print OUTFILE <<"ENDHEADER";
 372 %!FontType1-1.0: $fontname $fontversion
 373 %%CreationDate: $creationdate
 374 % Font converted to Type 1 by mf2pt1, written by Scott Pakin.
 375 11 dict begin
 376 /FontInfo 11 dict dup begin
 377 /version ($fontversion) readonly def
 378 /Notice ($comment) readonly def
 379 /FullName ($fullname) readonly def
 380 /FamilyName ($familyname) readonly def
 381 /Weight ($weight) readonly def
 382 /ItalicAngle $italicangle def
 383 /isFixedPitch $fixedpitch def
 384 /UnderlinePosition $underlinepos def
 385 /UnderlineThickness $underlinethick def
 386 end readonly def
 387 /FontName /$fontname def
 388 ENDHEADER
 389
 390     # If we're not using an encoding that PostScript knows about, then
 391     # create an encoding vector.
 392     if ($encoding==\@standardencoding) {
 393         print OUTFILE "/Encoding StandardEncoding def\n";
 394     }
 395     else {
 396         print OUTFILE "/Encoding 256 array\n";
 397         print OUTFILE "0 1 255 {1 index exch /.notdef put} for\n";
 398         foreach my $charnum (0 .. $#{$encoding}) {
 399             if ($encoding->[$charnum] && $encoding->[$charnum]!~/^_a\d+$/) {
 400                 print OUTFILE "dup $charnum /$encoding->[$charnum] put\n";
 401             }
 402         }
 403         print OUTFILE "readonly def\n";
 404     }
 405
 406     # Show the final boilerplate.
 407     print OUTFILE <<"ENDHEADER";
 408 /PaintType 0 def
 409 /FontType 1 def
 410 /FontMatrix [0.001 0 0 0.001 0 0] readonly def
 411 /UniqueID $uniqueID def
 412 /FontBBox{@fontbbox}readonly def
 413 currentdict end
 414 currentfile eexec
 415 dup /Private 5 dict dup begin
 416 /RD{string currentfile exch readstring pop}executeonly def
 417 /ND{noaccess def}executeonly def
 418 /NP{noaccess put}executeonly def
 419 ENDHEADER
 420 }
 421
 422
 423 # Use MetaPost to generate one PostScript file per character.  We
 424 # calculate the font bounding box from these characters and store them
 425 # in @fontbbox.  If the input parameter is 1, set other font
 426 # parameters, too.
 427 sub get_bboxes ($)
 428 {
 429     execute_command 1, ("mpost", "-mem=mf2pt1", "-progname=mpost",
 430                         "\\mode:=localfont; mag:=$mag; bpppix $bpppix; input $mffile");
 431     opendir (CURDIR, ".") || die "${progname}: $! ($filedir)\n";
 432     @charfiles = sort
 433                    { ($a=~ /\.(\d+)$/)[0] <=> ($b=~ /\.(\d+)$/)[0] }
 434                    grep /^$filebase.*\.\d+$/, readdir(CURDIR);
 435     close CURDIR;
 436     @fontbbox = (1000000, 1000000, -1000000, -1000000);
 437     foreach my $psfile (@charfiles) {
 438         # Read the character number from the output file's extension.
 439         $psfile =~ /\.(\d+)$/;
 440         my $charnum = $1;
 441
 442         # Process in turn each line of the current PostScript file.
 443         my $havebbox = 0;
 444         open (PSFILE, "<$psfile") || die "${progname}: $! ($psfile)\n";
 445         while (<PSFILE>) {
 446             my @tokens = split " ";
 447             if ($tokens[0] eq "%%BoundingBox:") {
 448                 # Store the MetaPost-produced bounding box, just in case
 449                 # the given font doesn't use beginchar.
 450                 @tokens = ("%", "MF2PT1:", "glyph_dimensions", @tokens[1..4]);
 451                 $havebbox--;
 452             }
 453             next if $#tokens<1 || $tokens[1] ne "MF2PT1:";
 454
 455             # Process a "special" inserted into the generated PostScript.
 456           MF2PT1_CMD:
 457             {
 458                 # glyph_dimensions llx lly urx ury -- specified glyph dimensions
 459                 $tokens[2] eq "glyph_dimensions" && do {
 460                     my @bbox = @tokens[3..6];
 461                     $fontbbox[0]=$bbox[0] if $bbox[0]<$fontbbox[0];
 462                     $fontbbox[1]=$bbox[1] if $bbox[1]<$fontbbox[1];
 463                     $fontbbox[2]=$bbox[2] if $bbox[2]>$fontbbox[2];
 464                     $fontbbox[3]=$bbox[3] if $bbox[3]>$fontbbox[3];
 465                     $charbbox[$charnum] = \@bbox;
 466                     $havebbox++;
 467                     last MF2PT1_CMD;
 468                 };
 469
 470                 # If all we want is the bounding box, exit the loop now.
 471                 last MF2PT1_CMD if !$_[0];
 472
 473                 # glyph_name name -- glyph name
 474                 $tokens[2] eq "glyph_name" && do {
 475                     $glyphname[$charnum] = $tokens[3];
 476                     last MF2PT1_CMD;
 477                 };
 478
 479                 # charwd wd -- character width as in TFM
 480                 $tokens[2] eq "charwd" && do {
 481                     $charwd[$charnum] = $tokens[3];
 482                     last MF2PT1_CMD;
 483                 };
 484
 485                 # font_identifier name -- full font name
 486                 $tokens[2] eq "font_identifier" && do {
 487                     $fullname = $tokens[3];
 488                     last MF2PT1_CMD;
 489                 };
 490
 491                 # font_size number -- font design size (pt, not bp)
 492                 $tokens[2] eq "font_size" && $tokens[3] && do {
 493                     $designsize = $tokens[3] * 72 / 72.27;
 494                     last MF2PT1_CMD;
 495                 };
 496
 497                 # font_slant number -- italic amount
 498                 $tokens[2] eq "font_slant" && do {
 499                     $italicangle = 0 + rad2deg (atan(-$tokens[3]));
 500                     last MF2PT1_CMD;
 501                 };
 502
 503                 # font_coding_scheme string -- font encoding
 504                 $tokens[2] eq "font_coding_scheme" && do {
 505                     $encoding = $tokens[3];
 506                     last MF2PT1_CMD;
 507                 };
 508
 509                 # font_version string -- font version number (xxx.yyy)
 510                 $tokens[2] eq "font_version" && do {
 511                     $fontversion = $tokens[3];
 512                     last MF2PT1_CMD;
 513                 };
 514
 515                 # font_comment string -- font comment notice
 516                 $tokens[2] eq "font_comment" && do {
 517                     $comment = join (" ", @tokens[3..$#tokens]);
 518                     last MF2PT1_CMD;
 519                 };
 520
 521                 # font_family string -- font family name
 522                 $tokens[2] eq "font_family" && do {
 523                     $familyname = $tokens[3];
 524                     last MF2PT1_CMD;
 525                 };
 526
 527                 # font_weight string -- font weight (e.g., "Book" or "Heavy")
 528                 $tokens[2] eq "font_weight" && do {
 529                     $weight = $tokens[3];
 530                     last MF2PT1_CMD;
 531                 };
 532
 533                 # font_fixed_pitch number -- fixed width font (0=false, 1=true)
 534                 $tokens[2] eq "font_fixed_pitch" && do {
 535                     $fixedpitch = $tokens[3];
 536                     last MF2PT1_CMD;
 537                 };
 538
 539                 # font_underline_position number -- vertical underline position
 540                 $tokens[2] eq "font_underline_position" && do {
 541                     # We store $underlinepos in points and later
 542                     # scale it by 1000/$designsize.
 543                     $underlinepos = $tokens[3];
 544                     last MF2PT1_CMD;
 545                 };
 546
 547                 # font_underline_thickness number -- thickness of underline
 548                 $tokens[2] eq "font_underline_thickness" && do {
 549                     # We store $underlinethick in points and later
 550                     # scale it by 1000/$designsize.
 551                     $underlinethick = $tokens[3];
 552                     last MF2PT1_CMD;
 553                 };
 554
 555                 # font_name string -- font name
 556                 $tokens[2] eq "font_name" && do {
 557                     $fontname = $tokens[3];
 558                     last MF2PT1_CMD;
 559                 };
 560
 561                 # font_unique_id number (as string) -- globally unique font ID
 562                 $tokens[2] eq "font_unique_id" && do {
 563                     $uniqueID = 0+$tokens[3];
 564                     last MF2PT1_CMD;
 565                 };
 566             }
 567         }
 568         close PSFILE;
 569         if (!$havebbox) {
 570             warn "${progname}: No beginchar in character $charnum; glyph dimensions are probably incorrect\n";
 571         }
 572     }
 573 }
 574
 575
 576 # Convert ordinary, MetaPost-produced PostScript files into Type 1
 577 # font programs.
 578 sub output_font_programs ()
 579 {
 580     # Iterate over all the characters.  We convert each one, line by
 581     # line and token by token.
 582     print "Converting PostScript graphics to Type 1 font programs...\n";
 583     foreach my $psfile (@charfiles) {
 584         # Initialize the font program.
 585         $psfile =~ /\.(\d+)$/;
 586         my $charnum = $1;
 587         my $gname = $glyphname[$charnum] || $encoding->[$charnum];
 588         my @fontprog;
 589         push @fontprog, ("/$gname {",
 590                          frac_string (frac_approx ($charbbox[$charnum]->[0]),
 591                                       frac_approx ($charwd[$charnum] * $mag))
 592                          . "hsbw");
 593         my ($cpx, $cpy) =
 594             ($charbbox[$charnum]->[0], 0);  # Current point (PostScript)
 595
 596         # Iterate over every line in the current file.
 597         open (PSFILE, "<$psfile") || die "${progname}: $! ($psfile)\n";
 598         while (my $oneline=<PSFILE>) {
 599             next if $oneline=~/^\%/;
 600             next if $oneline=~/set/;   # Fortunately, "set" never occurs on "good" lines.
 601             my @arglist;   # Arguments to current PostScript function
 602
 603             # Iterate over every token in the current line.
 604           TOKENLOOP:
 605             foreach my $token (split " ", $oneline) {
 606                 # Number: Round and push on the argument list.
 607                 $token =~ /^[-.\d]+$/ && do {
 608                     push @arglist, prec ($&);
 609                     next TOKENLOOP;
 610                 };
 611
 612                 # curveto: Convert to vhcurveto, hvcurveto, or rrcurveto.
 613                 $token eq "curveto" && do {
 614                     my ($dx1, $dy1) = ($arglist[0] - $cpx,
 615                                        $arglist[1] - $cpy);
 616                     my ($dx1n, $dx1d) = frac_approx ($dx1);
 617                     my ($dy1n, $dy1d) = frac_approx ($dy1);
 618                     $cpx += $dx1n / $dx1d;
 619                     $cpy += $dy1n / $dy1d;
 620
 621                     my ($dx2, $dy2) = ($arglist[2] - $cpx,
 622                                        $arglist[3] - $cpy);
 623                     my ($dx2n, $dx2d) = frac_approx ($dx2);
 624                     my ($dy2n, $dy2d) = frac_approx ($dy2);
 625                     $cpx += $dx2n / $dx2d;
 626                     $cpy += $dy2n / $dy2d;
 627
 628                     my ($dx3, $dy3) = ($arglist[4] - $cpx,
 629                                        $arglist[5] - $cpy);
 630                     my ($dx3n, $dx3d) = frac_approx ($dx3);
 631                     my ($dy3n, $dy3d) = frac_approx ($dy3);
 632                     $cpx += $dx3n / $dx3d;
 633                     $cpy += $dy3n / $dy3d;
 634
 635                     if (!$dx1n && !$dy3n) {
 636                         push @fontprog, frac_string ($dy1n, $dy1d,
 637                                                      $dx2n, $dx2d,
 638                                                      $dy2n, $dy2d,
 639                                                      $dx3n, $dx3d)
 640                                         . "vhcurveto";
 641                     }
 642                     elsif (!$dy1n && !$dx3n) {
 643                         push @fontprog, frac_string ($dx1n, $dx1d,
 644                                                      $dx2n, $dx2d,
 645                                                      $dy2n, $dy2d,
 646                                                      $dy3n, $dy3d)
 647                                         . "hvcurveto";
 648                     }
 649                     else {
 650                         push @fontprog, frac_string ($dx1n, $dx1d,
 651                                                      $dy1n, $dy1d,
 652                                                      $dx2n, $dx2d,
 653                                                      $dy2n, $dy2d,
 654                                                      $dx3n, $dx3d,
 655                                                      $dy3n, $dy3d)
 656                                         . "rrcurveto";
 657                     }
 658                     next TOKENLOOP;
 659                 };
 660
 661                 # lineto: Convert to vlineto, hlineto, or rlineto.
 662                 $token eq "lineto" && do {
 663                     my ($dx, $dy) = ($arglist[0] - $cpx,
 664                                      $arglist[1] - $cpy);
 665                     my ($dxn, $dxd) = frac_approx ($dx);
 666                     my ($dyn, $dyd) = frac_approx ($dy);
 667                     $cpx += $dxn / $dxd;
 668                     $cpy += $dyn / $dyd;
 669
 670                     if (!$dxn) {
 671                         push @fontprog, frac_string ($dyn, $dyd)
 672                                         . "vlineto" if $dyn;
 673                     }
 674                     elsif (!$dyn) {
 675                         push @fontprog, frac_string ($dxn, $dxd)
 676                                         . "hlineto";
 677                     }
 678                     else {
 679                         push @fontprog, frac_string ($dxn, $dxd, $dyn, $dyd)
 680                                         . "rlineto";
 681                     }
 682                     next TOKENLOOP;
 683                 };
 684
 685                 # moveto: Convert to vmoveto, hmoveto, or rmoveto.
 686                 $token eq "moveto" && do {
 687                     my ($dx, $dy) = ($arglist[0] - $cpx,
 688                                      $arglist[1] - $cpy);
 689                     my ($dxn, $dxd) = frac_approx ($dx);
 690                     my ($dyn, $dyd) = frac_approx ($dy);
 691                     $cpx += $dxn / $dxd;
 692                     $cpy += $dyn / $dyd;
 693
 694                     if (!$dxn) {
 695                         push @fontprog, frac_string ($dyn, $dyd)
 696                                         . "vmoveto";
 697                     }
 698                     elsif (!$dyn) {
 699                         push @fontprog, frac_string ($dxn, $dxd)
 700                                         . "hmoveto";
 701                     }
 702                     else {
 703                         push @fontprog, frac_string ($dxn, $dxd, $dyn, $dyd)
 704                                         . "rmoveto";
 705                     }
 706                     next TOKENLOOP;
 707                 };
 708
 709                 # closepath: Output as is.
 710                 $token eq "closepath" && do {
 711                     push @fontprog, $token;
 712                     next TOKENLOOP;
 713                 };
 714             }
 715         }
 716         close PSFILE;
 717         push @fontprog, ("endchar",
 718                          "} ND");
 719         print OUTFILE join ("\n\t", @fontprog), "\n";
 720     }
 721 }
 722
 723
 724 # Output the final set of code for the Type 1 font.
 725 sub output_trailer ()
 726 {
 727     print OUTFILE <<"ENDTRAILER";
 728 /.notdef {
 729         0 @{[$fontbbox[2]-$fontbbox[0]]} hsbw
 730         endchar
 731         } ND
 732 end
 733 end
 734 readonly put
 735 noaccess put
 736 dup/FontName get exch definefont pop
 737 mark currentfile closefile
 738 cleartomark
 739 ENDTRAILER
 740 }
 741
 742 ######################################################################
 743
 744 # Parse the command line.  Asterisks in the following represents
 745 # commands also defined by Plain Metafont.
 746 my %opthash = ();
 747 GetOptions (\%opthash,
 748             "fontversion=s",       # font_version
 749             "comment=s",           # font_comment
 750             "family=s",            # font_family
 751             "weight=s",            # font_weight
 752             "fullname=s",          # font_identifier (*)
 753             "fixedpitch!",         # font_fixed_pitch
 754             "italicangle=f",       # font_slant (*)
 755             "underpos=f",          # font_underline_position
 756             "underthick=f",        # font_underline_thickness
 757             "name=s",              # font_name
 758             "uniqueid=i",          # font_unique_id
 759             "designsize=f",        # font_size (*)
 760             "encoding=s",          # font_coding_scheme (*)
 761             "rounding=f",
 762             "bpppix=f",
 763             "ffscript=s",
 764             "h|help",
 765             "V|version") || pod2usage(2);
 766 if (defined $opthash{"h"}) {
 767     pod2usage(-verbose => 1,
 768               -output  => \*STDOUT,    # Bug workaround for Pod::Usage
 769               -exitval => "NOEXIT");
 770     print "Please e-mail bug reports to scott+mf\@pakin.org.\n";
 771     exit 1;
 772 }
 773 do {print $versionmsg; exit 1} if defined $opthash{"V"};
 774 pod2usage(2) if $#ARGV != 0;
 775
 776 # Extract the filename from the command line.
 777 $mffile = $ARGV[0];
 778 my @fileparts = fileparse $mffile, ".mf";
 779 $filebase = $fileparts[0];
 780 $filedir = $fileparts[1];
 781 $filenoext = File::Spec->catfile ($filedir, $filebase);
 782 $pt1file = $filebase . ".pt1";
 783 $pfbfile = $filebase . ".pfb";
 784
 785 assign_default $bpppix, $opthash{bpppix}, 0.02;
 786
 787 # Make our first pass through the input, to set values for various options.
 788 $mag = 100;           # Get a more precise bounding box.
 789 get_bboxes(1);        # This might set $designsize.
 790
 791 # Sanity-check the specified precision.
 792 assign_default $rounding, $opthash{rounding}, 1;
 793 if ($rounding<=0.0 || $rounding>1.0) {
 794     die sprintf "%s: Invalid rounding amount \"%g\"; value must be a positive number no greater than 1.0\n", $progname, $rounding;
 795 }
 796
 797 # Ensure that every user-definable parameter is assigned a value.
 798 assign_default $fontversion, $opthash{fontversion}, "001.000";
 799 assign_default $creationdate, scalar localtime;
 800 assign_default $comment, $opthash{comment}, "Font converted to Type 1 by mf2pt1, written by Scott Pakin.";
 801 assign_default $weight, $opthash{weight}, "Medium";
 802 assign_default $fixedpitch, $opthash{fixedpitch}, 0;
 803 assign_default $uniqueID, $opthash{uniqueid}, int(rand(1000000)) + 4000000;
 804 assign_default $designsize, $opthash{designsize};
 805 die "${progname}: a design size must be specified in $mffile or on the command line\n" if !defined $designsize;
 806 die "${progname}: the design size must be a positive number\n" if $designsize<=0.0;
 807 assign_default $underlinepos, $opthash{underpos}, -1;
 808 $underlinepos = round(1000*$underlinepos/$designsize);
 809 assign_default $underlinethick, $opthash{underthick}, 0.5;
 810 $underlinethick = round(1000*$underlinethick/$designsize);
 811 assign_default $fullname, $opthash{fullname}, $filebase;
 812 assign_default $familyname, $opthash{family}, $fullname;
 813 assign_default $italicangle, $opthash{italicangle}, 0;
 814 assign_default $fontname, $opthash{name}, "$familyname-$weight";
 815 $fontname =~ s/\s//g;
 816 assign_default $encoding, $opthash{encoding}, "standard";
 817 my $encoding_name = $encoding;
 818 ENCODING:
 819 {
 820     if (-e $encoding) {
 821         # Filenames take precedence over built-in encodings.
 822         my @enc_array;
 823         open (ENCFILE, "<$encoding") || die "${progname}: $! ($encoding)\n";
 824         while (my $oneline = <ENCFILE>) {
 825             $oneline =~ s/\%.*$//;
 826             foreach my $word (split " ", $oneline) {
 827                 push @enc_array, substr($word, 1) if substr($word, 0, 1) eq "/";
 828             }
 829         }
 830         close ENCFILE;
 831         $encoding_name = substr (shift @enc_array, 1);
 832         $encoding = \@enc_array;
 833         last ENCODING;
 834     }
 835     $encoding=\@standardencoding,  last ENCODING  if $encoding eq "standard";
 836     $encoding=\@isolatin1encoding, last ENCODING  if $encoding eq "isolatin1";
 837     $encoding=\@ot1encoding,       last ENCODING  if $encoding eq "ot1";
 838     $encoding=\@t1encoding,        last ENCODING  if $encoding eq "t1";
 839     $encoding=\@glyphname,         last ENCODING  if $encoding eq "asis";
 840     warn "${progname}: Unknown encoding \"$encoding\"; using standard Adobe encoding\n";
 841     $encoding=\@standardencoding;     # Default to standard encoding
 842 }
 843 assign_default $fixedpitch, $opthash{fixedpitch}, 0;
 844 $fixedpitch = $fixedpitch ? "true" : "false";
 845 assign_default $ffscript, $opthash{ffscript};
 846
 847 # Output the final values of all of our parameters.
 848 print "\n";
 849 print <<"PARAMVALUES";
 850 mf2pt1 is using the following font parameters:
 851     font_version:              $fontversion
 852     font_comment:              $comment
 853     font_family:               $familyname
 854     font_weight:               $weight
 855     font_identifier:           $fullname
 856     font_fixed_pitch:          $fixedpitch
 857     font_slant:                $italicangle
 858     font_underline_position:   $underlinepos
 859     font_underline_thickness:  $underlinethick
 860     font_name:                 $fontname
 861     font_unique_id:            $uniqueID
 862     font_size:                 $designsize (bp)
 863     font_coding_scheme:        $encoding_name
 864 PARAMVALUES
 865     ;
 866 print "\n";
 867
 868 # Scale by a factor of 1000/design size.
 869 $mag = 1000.0 / $designsize;
 870 get_bboxes(0);
 871 print "\n";
 872
 873 # Output the font in disassembled format.
 874 open (OUTFILE, ">$pt1file") || die "${progname}: $! ($pt1file)\n";
 875 output_header();
 876 printf OUTFILE "2 index /CharStrings %d dict dup begin\n",
 877                1+scalar(grep {defined($_)} @charbbox);
 878 output_font_programs();
 879 output_trailer();
 880 close OUTFILE;
 881 unlink @charfiles;
 882 print "\n";
 883
 884 # Convert from the disassembled font format to Type 1 binary format.
 885 if (!execute_command 0, ("t1asm", $pt1file, $pfbfile)) {
 886     die "${progname}: You'll need either to install t1utils and rerun $progname or find another way to convert $pt1file to $pfbfile\n";
 887     exit 1;
 888 }
 889 print "\n";
 890 unlink $pt1file;
 891
 892 # Use FontForge to autohint the result.
 893 my $user_script = 0;   # 1=script file was provided by the user; 0=created here
 894 if (defined $ffscript) {
 895     # The user provided his own script.
 896     $user_script = 1;
 897 }
 898 else {
 899     # Create a FontForge script file.
 900     $ffscript = $filebase . ".pe";
 901     open (FFSCRIPT, ">$ffscript") || die "${progname}: $! ($ffscript)\n";
 902     print FFSCRIPT <<'AUTOHINT';
 903 Open($1);
 904 SelectAll();
 905 RemoveOverlap();
 906 AddExtrema();
 907 Simplify(0, 2);
 908 CorrectDirection();
 909 Simplify(0, 2);
 910 RoundToInt();
 911 AutoHint();
 912 Generate($1);
 913 Quit(0);
 914 AUTOHINT
 915     ;
 916     close FFSCRIPT;
 917 }
 918 if (!execute_command 0, ("fontforge", "-script", $ffscript, $pfbfile)) {
 919     warn "${progname}: You'll need to install FontForge if you want $pfbfile autohinted (not required, but strongly recommended)\n";
 920 }
 921 unlink $ffscript if !$user_script;
 922 print "\n";
 923
 924 # Finish up.
 925 print "*** Successfully generated $pfbfile! ***\n";
 926 exit 0;
 927
 928 ######################################################################
 929
 930 __END__
 931
 932 =head1 NAME
 933
 934 mf2pt1 - produce a PostScript Type 1 font program from a Metafont source
 935
 936
 937 =head1 SYNOPSIS
 938
 939 mf2pt1
 940 [B<--help>]
 941 [B<--version>]
 942 [B<--comment>=I<string>]
 943 [B<--designsize>=I<number>]
 944 [B<--encoding>=I<encoding>]
 945 [B<--family>=I<name>]
 946 [B<-->[B<no>]B<fixedpitch>]
 947 [B<--fontversion>=I<MMM.mmm>]
 948 [B<--fullname>=I<name>]
 949 [B<--italicangle>=I<number>]
 950 [B<--name>=I<name>]
 951 [B<--underpos>=I<number>]
 952 [B<--underthick>=I<number>]
 953 [B<--uniqueid>=I<number>]
 954 [B<--weight>=I<weight>]
 955 [B<--rounding>=I<number>]
 956 [B<--bpppix>=I<number>]
 957 [B<--ffscript>=I<file.pe>]
 958 I<infile>.mf
 959
 960
 961 =head1 WARNING
 962
 963 The B<mf2pt1> Info file is the main source of documentation for
 964 B<mf2pt1>.  This man page is merely a brief summary.
 965
 966
 967 =head1 DESCRIPTION
 968
 969 B<mf2pt1> facilitates producing PostScript Type 1 fonts from a
 970 Metafont source file.  It is I<not>, as the name may imply, an
 971 automatic converter of arbitrary Metafont fonts to Type 1 format.
 972 B<mf2pt1> imposes a number of restrictions on the Metafont input.  If
 973 these restrictions are met, B<mf2pt1> will produce valid Type 1
 974 output.  (Actually, it produces "disassembled" Type 1; the B<t1asm>
 975 program from the B<t1utils> suite will convert this to a true Type 1
 976 font.)
 977
 978 =head2 Usage
 979
 980     mf2pt1 myfont.mf
 981
 982 =head1 OPTIONS
 983
 984 Font parameters are best specified within a Metafont program.  If
 985 necessary, though, command-line options can override any of these
 986 parameters.  The B<mf2pt1> Info page, the primary source of B<mf2pt1>
 987 documentation, describes the following in greater detail.
 988
 989 =over 4
 990
 991 =item B<--help>
 992
 993 Provide help on B<mf2pt1>'s command-line options.
 994
 995 =item B<--version>
 996
 997 Output the B<mf2pt1> version number, copyright, and license.
 998
 999 =item B<--comment>=I<string>
1000
1001 Include a font comment, usually a copyright notice.
1002
1003 =item B<--designsize>=I<number>
1004
1005 Specify the font design size in points.
1006
1007 =item B<--encoding>=I<encoding>
1008
1009 Designate the font encoding, either the name of a---typically
1010 F<.enc>---file which contains a PostScript font-encoding vector or one
1011 of C<standard> (the default), C<ot1>, C<t1>, or C<isolatin1>.
1012
1013 =item B<--family>=I<name>
1014
1015 Specify the font family.
1016
1017 =item B<--fixedpitch>, B<--nofixedpitch>
1018
1019 Assert that the font uses either monospaced (B<--fixedpitch>) or
1020 proportional (B<--nofixedpitch>) character widths.
1021
1022 =item B<--fontversion>=I<MMM.mmm>
1023
1024 Specify the font's major and minor version number.
1025
1026 =item B<--fullname>=I<name>
1027
1028 Designate the full font name (family plus modifiers).
1029
1030 =item B<--italicangle>=I<number>
1031
1032 Designate the italic angle in degrees counterclockwise from vertical.
1033
1034 =item B<--name>=I<name>
1035
1036 Provide the font name.
1037
1038 =item B<--underpos>=I<number>
1039
1040 Specify the vertical position of the underline in thousandths of the
1041 font height.
1042
1043 =item B<--underthick>=I<number>
1044
1045 Specify the thickness of the underline in thousandths of the font
1046 height.
1047
1048 =item B<--uniqueid>=I<number>
1049
1050 Specify a globally unique font identifier.
1051
1052 =item B<--weight>=I<weight>
1053
1054 Provide a description of the font weight (e.g., ``Heavy'').
1055
1056 =item B<--rounding>=I<number>
1057
1058 Specify the fraction of a font unit (0.0 < I<number> <= 1.0) to which
1059 to round coordinate values [default: 1.0].
1060
1061 =item B<--bpppix>=I<number>
1062
1063 Redefine the number of big points per pixel from 0.02 to I<number>.
1064
1065 =item B<--ffscript>=I<file.pe>
1066
1067 Name a script to pass to FontForge.
1068
1069 =back
1070
1071
1072 =head1 FILES
1073
1074 F<mf2pt1.mem> (which is generated from F<mf2pt1.mp> and F<mfplain.mp>)
1075
1076
1077 =head1 NOTES
1078
1079 As stated in L</"WARNING">, the complete source of documentation for
1080 B<mf2pt1> is the Info page, not this man page.
1081
1082
1083 =head1 SEE ALSO
1084
1085 mf(1), mpost(1), t1asm(1), fontforge(1)
1086
1087
1088 =head1 AUTHOR
1089
1090 Scott Pakin, I<scott+mf@pakin.org>