buildscripts/mf2pt1.pl

   1 #! /usr/bin/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.3";   # 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 = grep /^$filebase.*\.\d+$/, readdir(CURDIR);
 433     close CURDIR;
 434     @fontbbox = (1000000, 1000000, -1000000, -1000000);
 435     foreach my $psfile (@charfiles) {
 436         # Read the character number from the output file's extension.
 437         $psfile =~ /\.(\d+)$/;
 438         my $charnum = $1;
 439
 440         # Process in turn each line of the current PostScript file.
 441         my $havebbox = 0;
 442         open (PSFILE, "<$psfile") || die "${progname}: $! ($psfile)\n";
 443         while (<PSFILE>) {
 444             my @tokens = split " ";
 445             if ($tokens[0] eq "%%BoundingBox:") {
 446                 # Store the MetaPost-produced bounding box, just in case
 447                 # the given font doesn't use beginchar.
 448                 @tokens = ("%", "MF2PT1:", "glyph_dimensions", @tokens[1..4]);
 449                 $havebbox--;
 450             }
 451             next if $#tokens<1 || $tokens[1] ne "MF2PT1:";
 452
 453             # Process a "special" inserted into the generated PostScript.
 454           MF2PT1_CMD:
 455             {
 456                 # glyph_dimensions llx lly urx ury -- specified glyph dimensions
 457                 $tokens[2] eq "glyph_dimensions" && do {
 458                     my @bbox = @tokens[3..6];
 459                     $fontbbox[0]=$bbox[0] if $bbox[0]<$fontbbox[0];
 460                     $fontbbox[1]=$bbox[1] if $bbox[1]<$fontbbox[1];
 461                     $fontbbox[2]=$bbox[2] if $bbox[2]>$fontbbox[2];
 462                     $fontbbox[3]=$bbox[3] if $bbox[3]>$fontbbox[3];
 463                     $charbbox[$charnum] = \@bbox;
 464                     $havebbox++;
 465                     last MF2PT1_CMD;
 466                 };
 467
 468                 # If all we want is the bounding box, exit the loop now.
 469                 last MF2PT1_CMD if !$_[0];
 470
 471                 # glyph_name name -- glyph name
 472                 $tokens[2] eq "glyph_name" && do {
 473                     $glyphname[$charnum] = $tokens[3];
 474                     last MF2PT1_CMD;
 475                 };
 476
 477                 # charwd wd -- character width as in TFM
 478                 $tokens[2] eq "charwd" && do {
 479                     $charwd[$charnum] = $tokens[3];
 480                     last MF2PT1_CMD;
 481                 };
 482
 483                 # font_identifier name -- full font name
 484                 $tokens[2] eq "font_identifier" && do {
 485                     $fullname = $tokens[3];
 486                     last MF2PT1_CMD;
 487                 };
 488
 489                 # font_size number -- font design size (pt, not bp)
 490                 $tokens[2] eq "font_size" && $tokens[3] && do {
 491                     $designsize = $tokens[3] * 72 / 72.27;
 492                     last MF2PT1_CMD;
 493                 };
 494
 495                 # font_slant number -- italic amount
 496                 $tokens[2] eq "font_slant" && do {
 497                     $italicangle = 0 + rad2deg (atan(-$tokens[3]));
 498                     last MF2PT1_CMD;
 499                 };
 500
 501                 # font_coding_scheme string -- font encoding
 502                 $tokens[2] eq "font_coding_scheme" && do {
 503                     $encoding = $tokens[3];
 504                     last MF2PT1_CMD;
 505                 };
 506
 507                 # font_version string -- font version number (xxx.yyy)
 508                 $tokens[2] eq "font_version" && do {
 509                     $fontversion = $tokens[3];
 510                     last MF2PT1_CMD;
 511                 };
 512
 513                 # font_comment string -- font comment notice
 514                 $tokens[2] eq "font_comment" && do {
 515                     $comment = join (" ", @tokens[3..$#tokens]);
 516                     last MF2PT1_CMD;
 517                 };
 518
 519                 # font_family string -- font family name
 520                 $tokens[2] eq "font_family" && do {
 521                     $familyname = $tokens[3];
 522                     last MF2PT1_CMD;
 523                 };
 524
 525                 # font_weight string -- font weight (e.g., "Book" or "Heavy")
 526                 $tokens[2] eq "font_weight" && do {
 527                     $weight = $tokens[3];
 528                     last MF2PT1_CMD;
 529                 };
 530
 531                 # font_fixed_pitch number -- fixed width font (0=false, 1=true)
 532                 $tokens[2] eq "font_fixed_pitch" && do {
 533                     $fixedpitch = $tokens[3];
 534                     last MF2PT1_CMD;
 535                 };
 536
 537                 # font_underline_position number -- vertical underline position
 538                 $tokens[2] eq "font_underline_position" && do {
 539                     # We store $underlinepos in points and later
 540                     # scale it by 1000/$designsize.
 541                     $underlinepos = $tokens[3];
 542                     last MF2PT1_CMD;
 543                 };
 544
 545                 # font_underline_thickness number -- thickness of underline
 546                 $tokens[2] eq "font_underline_thickness" && do {
 547                     # We store $underlinethick in points and later
 548                     # scale it by 1000/$designsize.
 549                     $underlinethick = $tokens[3];
 550                     last MF2PT1_CMD;
 551                 };
 552
 553                 # font_name string -- font name
 554                 $tokens[2] eq "font_name" && do {
 555                     $fontname = $tokens[3];
 556                     last MF2PT1_CMD;
 557                 };
 558
 559                 # font_unique_id number (as string) -- globally unique font ID
 560                 $tokens[2] eq "font_unique_id" && do {
 561                     $uniqueID = 0+$tokens[3];
 562                     last MF2PT1_CMD;
 563                 };
 564             }
 565         }
 566         close PSFILE;
 567         if (!$havebbox) {
 568             warn "${progname}: No beginchar in character $charnum; glyph dimensions are probably incorrect\n";
 569         }
 570     }
 571 }
 572
 573
 574 # Convert ordinary, MetaPost-produced PostScript files into Type 1
 575 # font programs.
 576 sub output_font_programs ()
 577 {
 578     # Iterate over all the characters.  We convert each one, line by
 579     # line and token by token.
 580     print "Converting PostScript graphics to Type 1 font programs...\n";
 581     foreach my $psfile (@charfiles) {
 582         # Initialize the font program.
 583         $psfile =~ /\.(\d+)$/;
 584         my $charnum = $1;
 585         my $gname = $glyphname[$charnum] || $encoding->[$charnum];
 586         my @fontprog;
 587         push @fontprog, ("/$gname {",
 588                          frac_string (frac_approx ($charbbox[$charnum]->[0]),
 589                                       frac_approx ($charwd[$charnum] * $mag))
 590                          . "hsbw");
 591         my ($cpx, $cpy) =
 592             ($charbbox[$charnum]->[0], 0);  # Current point (PostScript)
 593
 594         # Iterate over every line in the current file.
 595         open (PSFILE, "<$psfile") || die "${progname}: $! ($psfile)\n";
 596         while (my $oneline=<PSFILE>) {
 597             next if $oneline=~/^\%/;
 598             next if $oneline=~/set/;   # Fortunately, "set" never occurs on "good" lines.
 599             my @arglist;   # Arguments to current PostScript function
 600
 601             # Iterate over every token in the current line.
 602           TOKENLOOP:
 603             foreach my $token (split " ", $oneline) {
 604                 # Number: Round and push on the argument list.
 605                 $token =~ /^[-.\d]+$/ && do {
 606                     push @arglist, prec ($&);
 607                     next TOKENLOOP;
 608                 };
 609
 610                 # curveto: Convert to vhcurveto, hvcurveto, or rrcurveto.
 611                 $token eq "curveto" && do {
 612                     my ($dx1, $dy1) = ($arglist[0] - $cpx,
 613                                        $arglist[1] - $cpy);
 614                     my ($dx1n, $dx1d) = frac_approx ($dx1);
 615                     my ($dy1n, $dy1d) = frac_approx ($dy1);
 616                     $cpx += $dx1n / $dx1d;
 617                     $cpy += $dy1n / $dy1d;
 618
 619                     my ($dx2, $dy2) = ($arglist[2] - $cpx,
 620                                        $arglist[3] - $cpy);
 621                     my ($dx2n, $dx2d) = frac_approx ($dx2);
 622                     my ($dy2n, $dy2d) = frac_approx ($dy2);
 623                     $cpx += $dx2n / $dx2d;
 624                     $cpy += $dy2n / $dy2d;
 625
 626                     my ($dx3, $dy3) = ($arglist[4] - $cpx,
 627                                        $arglist[5] - $cpy);
 628                     my ($dx3n, $dx3d) = frac_approx ($dx3);
 629                     my ($dy3n, $dy3d) = frac_approx ($dy3);
 630                     $cpx += $dx3n / $dx3d;
 631                     $cpy += $dy3n / $dy3d;
 632
 633                     if (!$dx1n && !$dy3n) {
 634                         push @fontprog, frac_string ($dy1n, $dy1d,
 635                                                      $dx2n, $dx2d,
 636                                                      $dy2n, $dy2d,
 637                                                      $dx3n, $dx3d)
 638                                         . "vhcurveto";
 639                     }
 640                     elsif (!$dy1n && !$dx3n) {
 641                         push @fontprog, frac_string ($dx1n, $dx1d,
 642                                                      $dx2n, $dx2d,
 643                                                      $dy2n, $dy2d,
 644                                                      $dy3n, $dy3d)
 645                                         . "hvcurveto";
 646                     }
 647                     else {
 648                         push @fontprog, frac_string ($dx1n, $dx1d,
 649                                                      $dy1n, $dy1d,
 650                                                      $dx2n, $dx2d,
 651                                                      $dy2n, $dy2d,
 652                                                      $dx3n, $dx3d,
 653                                                      $dy3n, $dy3d)
 654                                         . "rrcurveto";
 655                     }
 656                     next TOKENLOOP;
 657                 };
 658
 659                 # lineto: Convert to vlineto, hlineto, or rlineto.
 660                 $token eq "lineto" && do {
 661                     my ($dx, $dy) = ($arglist[0] - $cpx,
 662                                      $arglist[1] - $cpy);
 663                     my ($dxn, $dxd) = frac_approx ($dx);
 664                     my ($dyn, $dyd) = frac_approx ($dy);
 665                     $cpx += $dxn / $dxd;
 666                     $cpy += $dyn / $dyd;
 667
 668                     if (!$dxn) {
 669                         push @fontprog, frac_string ($dyn, $dyd)
 670                                         . "vlineto" if $dyn;
 671                     }
 672                     elsif (!$dyn) {
 673                         push @fontprog, frac_string ($dxn, $dxd)
 674                                         . "hlineto";
 675                     }
 676                     else {
 677                         push @fontprog, frac_string ($dxn, $dxd, $dyn, $dyd)
 678                                         . "rlineto";
 679                     }
 680                     next TOKENLOOP;
 681                 };
 682
 683                 # moveto: Convert to vmoveto, hmoveto, or rmoveto.
 684                 $token eq "moveto" && do {
 685                     my ($dx, $dy) = ($arglist[0] - $cpx,
 686                                      $arglist[1] - $cpy);
 687                     my ($dxn, $dxd) = frac_approx ($dx);
 688                     my ($dyn, $dyd) = frac_approx ($dy);
 689                     $cpx += $dxn / $dxd;
 690                     $cpy += $dyn / $dyd;
 691
 692                     if (!$dxn) {
 693                         push @fontprog, frac_string ($dyn, $dyd)
 694                                         . "vmoveto";
 695                     }
 696                     elsif (!$dyn) {
 697                         push @fontprog, frac_string ($dxn, $dxd)
 698                                         . "hmoveto";
 699                     }
 700                     else {
 701                         push @fontprog, frac_string ($dxn, $dxd, $dyn, $dyd)
 702                                         . "rmoveto";
 703                     }
 704                     next TOKENLOOP;
 705                 };
 706
 707                 # closepath: Output as is.
 708                 $token eq "closepath" && do {
 709                     push @fontprog, $token;
 710                     next TOKENLOOP;
 711                 };
 712             }
 713         }
 714         close PSFILE;
 715         push @fontprog, ("endchar",
 716                          "} ND");
 717         print OUTFILE join ("\n\t", @fontprog), "\n";
 718     }
 719 }
 720
 721
 722 # Output the final set of code for the Type 1 font.
 723 sub output_trailer ()
 724 {
 725     print OUTFILE <<"ENDTRAILER";
 726 /.notdef {
 727         0 @{[$fontbbox[2]-$fontbbox[0]]} hsbw
 728         endchar
 729         } ND
 730 end
 731 end
 732 readonly put
 733 noaccess put
 734 dup/FontName get exch definefont pop
 735 mark currentfile closefile
 736 cleartomark
 737 ENDTRAILER
 738 }
 739
 740 ######################################################################
 741
 742 # Parse the command line.  Asterisks in the following represents
 743 # commands also defined by Plain Metafont.
 744 my %opthash = ();
 745 GetOptions (\%opthash,
 746             "fontversion=s",       # font_version
 747             "comment=s",           # font_comment
 748             "family=s",            # font_family
 749             "weight=s",            # font_weight
 750             "fullname=s",          # font_identifier (*)
 751             "fixedpitch!",         # font_fixed_pitch
 752             "italicangle=f",       # font_slant (*)
 753             "underpos=f",          # font_underline_position
 754             "underthick=f",        # font_underline_thickness
 755             "name=s",              # font_name
 756             "uniqueid=i",          # font_unique_id
 757             "designsize=f",        # font_size (*)
 758             "encoding=s",          # font_coding_scheme (*)
 759             "rounding=f",
 760             "bpppix=f",
 761             "ffscript=s",
 762             "h|help",
 763             "V|version") || pod2usage(2);
 764 if (defined $opthash{"h"}) {
 765     pod2usage(-verbose => 1,
 766               -output  => \*STDOUT,    # Bug workaround for Pod::Usage
 767               -exitval => "NOEXIT");
 768     print "Please e-mail bug reports to scott+mf\@pakin.org.\n";
 769     exit 1;
 770 }
 771 do {print $versionmsg; exit 1} if defined $opthash{"V"};
 772 pod2usage(2) if $#ARGV != 0;
 773
 774 # Extract the filename from the command line.
 775 $mffile = $ARGV[0];
 776 my @fileparts = fileparse $mffile, ".mf";
 777 $filebase = $fileparts[0];
 778 $filedir = $fileparts[1];
 779 $filenoext = File::Spec->catfile ($filedir, $filebase);
 780 $pt1file = $filebase . ".pt1";
 781 $pfbfile = $filebase . ".pfb";
 782
 783 assign_default $bpppix, $opthash{bpppix}, 0.02;
 784
 785 # Make our first pass through the input, to set values for various options.
 786 $mag = 100;           # Get a more precise bounding box.
 787 get_bboxes(1);        # This might set $designsize.
 788
 789 # Sanity-check the specified precision.
 790 assign_default $rounding, $opthash{rounding}, 1;
 791 if ($rounding<=0.0 || $rounding>1.0) {
 792     die sprintf "%s: Invalid rounding amount \"%g\"; value must be a positive number no greater than 1.0\n", $progname, $rounding;
 793 }
 794
 795 # Ensure that every user-definable parameter is assigned a value.
 796 assign_default $fontversion, $opthash{fontversion}, "001.000";
 797 assign_default $creationdate, scalar localtime;
 798 assign_default $comment, $opthash{comment}, "Font converted to Type 1 by mf2pt1, written by Scott Pakin.";
 799 assign_default $weight, $opthash{weight}, "Medium";
 800 assign_default $fixedpitch, $opthash{fixedpitch}, 0;
 801 assign_default $uniqueID, $opthash{uniqueid}, int(rand(1000000)) + 4000000;
 802 assign_default $designsize, $opthash{designsize};
 803 die "${progname}: a design size must be specified in $mffile or on the command line\n" if !defined $designsize;
 804 die "${progname}: the design size must be a positive number\n" if $designsize<=0.0;
 805 assign_default $underlinepos, $opthash{underpos}, -1;
 806 $underlinepos = round(1000*$underlinepos/$designsize);
 807 assign_default $underlinethick, $opthash{underthick}, 0.5;
 808 $underlinethick = round(1000*$underlinethick/$designsize);
 809 assign_default $fullname, $opthash{fullname}, $filebase;
 810 assign_default $familyname, $opthash{family}, $fullname;
 811 assign_default $italicangle, $opthash{italicangle}, 0;
 812 assign_default $fontname, $opthash{name}, "$familyname-$weight";
 813 $fontname =~ s/\s//g;
 814 assign_default $encoding, $opthash{encoding}, "standard";
 815 my $encoding_name = $encoding;
 816 ENCODING:
 817 {
 818     if (-e $encoding) {
 819         # Filenames take precedence over built-in encodings.
 820         my @enc_array;
 821         open (ENCFILE, "<$encoding") || die "${progname}: $! ($encoding)\n";
 822         while (my $oneline = <ENCFILE>) {
 823             $oneline =~ s/\%.*$//;
 824             foreach my $word (split " ", $oneline) {
 825                 push @enc_array, substr($word, 1) if substr($word, 0, 1) eq "/";
 826             }
 827         }
 828         close ENCFILE;
 829         $encoding_name = substr (shift @enc_array, 1);
 830         $encoding = \@enc_array;
 831         last ENCODING;
 832     }
 833     $encoding=\@standardencoding,  last ENCODING  if $encoding eq "standard";
 834     $encoding=\@isolatin1encoding, last ENCODING  if $encoding eq "isolatin1";
 835     $encoding=\@ot1encoding,       last ENCODING  if $encoding eq "ot1";
 836     $encoding=\@t1encoding,        last ENCODING  if $encoding eq "t1";
 837     $encoding=\@glyphname,         last ENCODING  if $encoding eq "asis";
 838     warn "${progname}: Unknown encoding \"$encoding\"; using standard Adobe encoding\n";
 839     $encoding=\@standardencoding;     # Default to standard encoding
 840 }
 841 assign_default $fixedpitch, $opthash{fixedpitch}, 0;
 842 $fixedpitch = $fixedpitch ? "true" : "false";
 843 assign_default $ffscript, $opthash{ffscript};
 844
 845 # Output the final values of all of our parameters.
 846 print "\n";
 847 print <<"PARAMVALUES";
 848 mf2pt1 is using the following font parameters:
 849     font_version:              $fontversion
 850     font_comment:              $comment
 851     font_family:               $familyname
 852     font_weight:               $weight
 853     font_identifier:           $fullname
 854     font_fixed_pitch:          $fixedpitch
 855     font_slant:                $italicangle
 856     font_underline_position:   $underlinepos
 857     font_underline_thickness:  $underlinethick
 858     font_name:                 $fontname
 859     font_unique_id:            $uniqueID
 860     font_size:                 $designsize (bp)
 861     font_coding_scheme:        $encoding_name
 862 PARAMVALUES
 863     ;
 864 print "\n";
 865
 866 # Scale by a factor of 1000/design size.
 867 $mag = 1000.0 / $designsize;
 868 get_bboxes(0);
 869 print "\n";
 870
 871 # Output the font in disassembled format.
 872 open (OUTFILE, ">$pt1file") || die "${progname}: $! ($pt1file)\n";
 873 output_header();
 874 printf OUTFILE "2 index /CharStrings %d dict dup begin\n",
 875                1+scalar(grep {defined($_)} @charbbox);
 876 output_font_programs();
 877 output_trailer();
 878 close OUTFILE;
 879 unlink @charfiles;
 880 print "\n";
 881
 882 # Convert from the disassembled font format to Type 1 binary format.
 883 if (!execute_command 0, ("t1asm", $pt1file, $pfbfile)) {
 884     die "${progname}: You'll need either to install t1utils and rerun $progname or find another way to convert $pt1file to $pfbfile\n";
 885     exit 1;
 886 }
 887 print "\n";
 888 unlink $pt1file;
 889
 890 # Use FontForge to autohint the result.
 891 my $user_script = 0;   # 1=script file was provided by the user; 0=created here
 892 if (defined $ffscript) {
 893     # The user provided his own script.
 894     $user_script = 1;
 895 }
 896 else {
 897     # Create a FontForge script file.
 898     $ffscript = $filebase . ".pe";
 899     open (FFSCRIPT, ">$ffscript") || die "${progname}: $! ($ffscript)\n";
 900     print FFSCRIPT <<'AUTOHINT';
 901 Open($1);
 902 SelectAll();
 903 RemoveOverlap();
 904 AddExtrema();
 905 Simplify(0, 2);
 906 CorrectDirection();
 907 Simplify(0, 2);
 908 RoundToInt();
 909 AutoHint();
 910 Generate($1);
 911 Quit(0);
 912 AUTOHINT
 913     ;
 914     close FFSCRIPT;
 915 }
 916 if (!execute_command 0, ("fontforge", "-script", $ffscript, $pfbfile)) {
 917     warn "${progname}: You'll need to install FontForge if you want $pfbfile autohinted (not required, but strongly recommended)\n";
 918 }
 919 unlink $ffscript if !$user_script;
 920 print "\n";
 921
 922 # Finish up.
 923 print "*** Successfully generated $pfbfile! ***\n";
 924 exit 0;
 925
 926 ######################################################################
 927
 928 __END__
 929
 930 =head1 NAME
 931
 932 mf2pt1 - produce a PostScript Type 1 font program from a Metafont source
 933
 934
 935 =head1 SYNOPSIS
 936
 937 mf2pt1
 938 [B<--help>]
 939 [B<--version>]
 940 [B<--comment>=I<string>]
 941 [B<--designsize>=I<number>]
 942 [B<--encoding>=I<encoding>]
 943 [B<--family>=I<name>]
 944 [B<-->[B<no>]B<fixedpitch>]
 945 [B<--fontversion>=I<MMM.mmm>]
 946 [B<--fullname>=I<name>]
 947 [B<--italicangle>=I<number>]
 948 [B<--name>=I<name>]
 949 [B<--underpos>=I<number>]
 950 [B<--underthick>=I<number>]
 951 [B<--uniqueid>=I<number>]
 952 [B<--weight>=I<weight>]
 953 [B<--rounding>=I<number>]
 954 [B<--bpppix>=I<number>]
 955 [B<--ffscript>=I<file.pe>]
 956 I<infile>.mf
 957
 958
 959 =head1 WARNING
 960
 961 The B<mf2pt1> Info file is the main source of documentation for
 962 B<mf2pt1>.  This man page is merely a brief summary.
 963
 964
 965 =head1 DESCRIPTION
 966
 967 B<mf2pt1> facilitates producing PostScript Type 1 fonts from a
 968 Metafont source file.  It is I<not>, as the name may imply, an
 969 automatic converter of arbitrary Metafont fonts to Type 1 format.
 970 B<mf2pt1> imposes a number of restrictions on the Metafont input.  If
 971 these restrictions are met, B<mf2pt1> will produce valid Type 1
 972 output.  (Actually, it produces "disassembled" Type 1; the B<t1asm>
 973 program from the B<t1utils> suite will convert this to a true Type 1
 974 font.)
 975
 976 =head2 Usage
 977
 978     mf2pt1 myfont.mf
 979
 980 =head1 OPTIONS
 981
 982 Font parameters are best specified within a Metafont program.  If
 983 necessary, though, command-line options can override any of these
 984 parameters.  The B<mf2pt1> Info page, the primary source of B<mf2pt1>
 985 documentation, describes the following in greater detail.
 986
 987 =over 4
 988
 989 =item B<--help>
 990
 991 Provide help on B<mf2pt1>'s command-line options.
 992
 993 =item B<--version>
 994
 995 Output the B<mf2pt1> version number, copyright, and license.
 996
 997 =item B<--comment>=I<string>
 998
 999 Include a font comment, usually a copyright notice.
1000
1001 =item B<--designsize>=I<number>
1002
1003 Specify the font design size in points.
1004
1005 =item B<--encoding>=I<encoding>
1006
1007 Designate the font encoding, either the name of a---typically
1008 F<.enc>---file which contains a PostScript font-encoding vector or one
1009 of C<standard> (the default), C<ot1>, C<t1>, or C<isolatin1>.
1010
1011 =item B<--family>=I<name>
1012
1013 Specify the font family.
1014
1015 =item B<--fixedpitch>, B<--nofixedpitch>
1016
1017 Assert that the font uses either monospaced (B<--fixedpitch>) or
1018 proportional (B<--nofixedpitch>) character widths.
1019
1020 =item B<--fontversion>=I<MMM.mmm>
1021
1022 Specify the font's major and minor version number.
1023
1024 =item B<--fullname>=I<name>
1025
1026 Designate the full font name (family plus modifiers).
1027
1028 =item B<--italicangle>=I<number>
1029
1030 Designate the italic angle in degrees counterclockwise from vertical.
1031
1032 =item B<--name>=I<name>
1033
1034 Provide the font name.
1035
1036 =item B<--underpos>=I<number>
1037
1038 Specify the vertical position of the underline in thousandths of the
1039 font height.
1040
1041 =item B<--underthick>=I<number>
1042
1043 Specify the thickness of the underline in thousandths of the font
1044 height.
1045
1046 =item B<--uniqueid>=I<number>
1047
1048 Specify a globally unique font identifier.
1049
1050 =item B<--weight>=I<weight>
1051
1052 Provide a description of the font weight (e.g., ``Heavy'').
1053
1054 =item B<--rounding>=I<number>
1055
1056 Specify the fraction of a font unit (0.0 < I<number> <= 1.0) to which
1057 to round coordinate values [default: 1.0].
1058
1059 =item B<--bpppix>=I<number>
1060
1061 Redefine the number of big points per pixel from 0.02 to I<number>.
1062
1063 =item B<--ffscript>=I<file.pe>
1064
1065 Name a script to pass to FontForge.
1066
1067 =back
1068
1069
1070 =head1 FILES
1071
1072 F<mf2pt1.mem> (which is generated from F<mf2pt1.mp> and F<mfplain.mp>)
1073
1074
1075 =head1 NOTES
1076
1077 As stated in L</"WARNING">, the complete source of documentation for
1078 B<mf2pt1> is the Info page, not this man page.
1079
1080
1081 =head1 SEE ALSO
1082
1083 mf(1), mpost(1), t1asm(1), fontforge(1)
1084
1085
1086 =head1 AUTHOR
1087
1088 Scott Pakin, I<scott+mf@pakin.org>