1################################################## 2# Convert stylized Metafont to PostScript Type 1 # 3# By Scott Pakin <scott+mf@pakin.org> # 4################################################## 5 6######################################################################## 7# mf2pt1 # 8# Copyright (C) 2005-2020 Scott Pakin # 9# # 10# This program may be distributed and/or modified under the conditions # 11# of the LaTeX Project Public License, either version 1.3c of this # 12# license or (at your option) any later version. # 13# # 14# The latest version of this license is in: # 15# # 16# http://www.latex-project.org/lppl.txt # 17# # 18# and version 1.3c or later is part of all distributions of LaTeX # 19# version 2006/05/20 or later. # 20######################################################################## 21 22our $VERSION = "2.6"; # mf2pt1 version number 23require 5.6.1; # I haven't tested mf2pt1 with older Perl versions 24 25use File::Basename; 26use File::Spec; 27use Getopt::Long; 28use Pod::Usage; 29use Math::Trig; 30use warnings; 31use strict; 32 33# Define some common encoding vectors. 34my @standardencoding = 35 ((map {"_a$_"} (0..31)), 36 qw (space exclam quotedbl numbersign dollar percent ampersand 37 quoteright parenleft parenright asterisk plus comma hyphen 38 period slash zero one two three four five six seven eight 39 nine colon semicolon less equal greater question at A B C D E 40 F G H I J K L M N O P Q R S T U V W X Y Z bracketleft 41 backslash bracketright asciicircum underscore quoteleft a b c 42 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 43 braceright asciitilde), 44 (map {"_a$_"} (127..160)), 45 qw (exclamdown cent sterling fraction yen florin section currency 46 quotesingle quotedblleft guillemotleft guilsinglleft 47 guilsinglright fi fl _a176 endash dagger daggerdbl 48 periodcentered _a181 paragraph bullet quotesinglbase 49 quotedblbase quotedblright guillemotright ellipsis 50 perthousand _a190 questiondown _a192 grave acute circumflex 51 tilde macron breve dotaccent dieresis _a201 ring cedilla 52 _a204 hungarumlaut ogonek caron emdash), 53 (map {"_a$_"} (209..224)), 54 qw (AE _a226 ordfeminine _a228 _a229 _a230 _a231 Lslash Oslash OE 55 ordmasculine _a236 _a237 _a238 _a239 _a240 ae _a242 _a243 56 _a244 dotlessi _a246 _a247 lslash oslash oe germandbls _a252 57 _a253 _a254 _a255)); 58my @isolatin1encoding = 59 ((map {"_a$_"} (0..31)), 60 qw (space exclam quotedbl numbersign dollar percent ampersand 61 quoteright parenleft parenright asterisk plus comma minus 62 period slash zero one two three four five six seven eight 63 nine colon semicolon less equal greater question at A B C D E 64 F G H I J K L M N O P Q R S T U V W X Y Z bracketleft 65 backslash bracketright asciicircum underscore quoteleft a b c 66 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 67 braceright asciitilde), 68 (map {"_a$_"} (128..143)), 69 qw (dotlessi grave acute circumflex tilde macron breve dotaccent 70 dieresis _a153 ring cedilla _a156 hungarumlaut ogonek 71 caron space exclamdown cent sterling currency yen brokenbar 72 section dieresis copyright ordfeminine guillemotleft 73 logicalnot hyphen registered macron degree plusminus 74 twosuperior threesuperior acute mu paragraph periodcentered 75 cedilla onesuperior ordmasculine guillemotright onequarter 76 onehalf threequarters questiondown Agrave Aacute Acircumflex 77 Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex 78 Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde 79 Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash 80 Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls 81 agrave aacute acircumflex atilde adieresis aring ae ccedilla 82 egrave eacute ecircumflex edieresis igrave iacute icircumflex 83 idieresis eth ntilde ograve oacute ocircumflex otilde 84 odieresis divide oslash ugrave uacute ucircumflex udieresis 85 yacute thorn ydieresis)); 86my @ot1encoding = 87 qw (Gamma Delta Theta Lambda Xi Pi Sigma Upsilon Phi 88 Psi Omega ff fi fl ffi ffl dotlessi dotlessj grave acute caron 89 breve macron ring cedilla germandbls ae oe oslash AE OE Oslash 90 suppress exclam quotedblright numbersign dollar percent 91 ampersand quoteright parenleft parenright asterisk plus comma 92 hyphen period slash zero one two three four five six seven 93 eight nine colon semicolon exclamdown equal questiondown 94 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 95 Z bracketleft quotedblleft bracketright circumflex dotaccent 96 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 97 endash emdash hungarumlaut tilde dieresis); 98my @t1encoding = 99 qw (grave acute circumflex tilde dieresis hungarumlaut ring caron 100 breve macron dotaccent cedilla ogonek quotesinglbase 101 guilsinglleft guilsinglright quotedblleft quotedblright 102 quotedblbase guillemotleft guillemotright endash emdash cwm 103 perthousand dotlessi dotlessj ff fi fl ffi ffl space exclam 104 quotedbl numbersign dollar percent ampersand quoteright 105 parenleft parenright asterisk plus comma hyphen period slash 106 zero one two three four five six seven eight nine colon 107 semicolon less equal greater question at A B C D E F G H I J K L 108 M N O P Q R S T U V W X Y Z bracketleft backslash bracketright 109 asciicircum underscore quoteleft a b c d e f g h i j k l m n o p 110 q r s t u v w x y z braceleft bar braceright asciitilde 111 sfthyphen Abreve Aogonek Cacute Ccaron Dcaron Ecaron Eogonek 112 Gbreve Lacute Lcaron Lslash Nacute Ncaron Eng Ohungarumlaut 113 Racute Rcaron Sacute Scaron Scedilla Tcaron Tcedilla 114 Uhungarumlaut Uring Ydieresis Zacute Zcaron Zdotaccent IJ 115 Idotaccent dcroat section abreve aogonek cacute ccaron dcaron 116 ecaron eogonek gbreve lacute lcaron lslash nacute ncaron eng 117 ohungarumlaut racute rcaron sacute scaron scedilla tcaron 118 tcedilla uhungarumlaut uring ydieresis zacute zcaron zdotaccent 119 ij exclamdown questiondown sterling Agrave Aacute Acircumflex 120 Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex 121 Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve 122 Oacute Ocircumflex Otilde Odieresis OE Oslash Ugrave Uacute 123 Ucircumflex Udieresis Yacute Thorn SS agrave aacute acircumflex 124 atilde adieresis aring ae ccedilla egrave eacute ecircumflex 125 edieresis igrave iacute icircumflex idieresis eth ntilde ograve 126 oacute ocircumflex otilde odieresis oe oslash ugrave uacute 127 ucircumflex udieresis yacute thorn germandbls); 128 129# Define font parameters that the user can override. 130my $fontversion; 131my $creationdate; 132my $comment; 133my $familyname; 134my $weight; 135my $fullname; 136my $fixedpitch; 137my $italicangle; 138my $underlinepos; 139my $underlinethick; 140my $fontname; 141my $uniqueID; 142my $designsize; 143my ($mffile, $pt1file, $pfbfile, $ffscript); 144my $encoding; 145my $rounding; 146my $bpppix; 147 148# Define all of our other global variables. 149my $progname = basename $0, ".pl"; 150my $mag; 151my @fontbbox; 152my @charbbox; 153my @charwd; 154my @glyphname; 155my @charfiles; 156my $filebase; 157my $filedir; 158my $filenoext; 159my $versionmsg = "mf2pt1 version $VERSION 160 161Copyright (C) 2005-2020 Scott Pakin 162 163This program may be distributed and/or modified under the conditions 164of the LaTeX Project Public License, either version 1.3c of this 165license or (at your option) any later version. 166 167The latest version of this license is in: 168 169 http://www.latex-project.org/lppl.txt 170 171and version 1.3c or later is part of all distributions of LaTeX 172version 2006/05/20 or later. 173"; 174 175 176###################################################################### 177 178# The routines to compute the fractional approximation of a real number 179# are heavily based on code posted by Ben Tilly 180# <http://www.perlmonks.org/?node_id=26179> on Nov 16th, 2000, to the 181# PerlMonks list. See <http://www.perlmonks.org/index.pl?node_id=41961>. 182 183 184# Takes numerator/denominator pairs. 185# Returns a PS fraction string representation (with a trailing space). 186sub frac_string (@) 187{ 188 my $res = ""; 189 190 while (@_) { 191 my $n = shift; 192 my $d = shift; 193 $res .= $n . " "; 194 $res .= $d . " div " if $d > 1; 195 } 196 197 return $res; 198} 199 200 201# Takes a number. 202# Returns a numerator and denominator with the smallest denominator 203# so that the difference of the resulting fraction to the number is 204# smaller or equal to $rounding. 205sub frac_approx ($) 206{ 207 my $num = shift; 208 my $f = ret_frac_iter ($num); 209 210 while (1) { 211 my ($n, $m) = $f->(); 212 my $approx = $n / $m; 213 my $delta = abs ($num - $approx); 214 return ($n, $m) if ($delta <= $rounding); 215 } 216} 217 218 219# Takes a number, returns the best integer approximation and (in list 220# context) the error. 221sub best_int ($) 222{ 223 my $x = shift; 224 my $approx = sprintf '%.0f', $x; 225 if (wantarray) { 226 return ($approx, $x - $approx); 227 } 228 else { 229 return $approx; 230 } 231} 232 233 234# Takes a numerator and denominator, in scalar context returns 235# the best fraction describing them, in list the numerator and 236# denominator. 237sub frac_standard ($$) 238{ 239 my $n = best_int(shift); 240 my $m = best_int(shift); 241 my $k = gcd($n, $m); 242 $n /= $k; 243 $m /= $k; 244 if ($m < 0) { 245 $n *= -1; 246 $m *= -1; 247 } 248 if (wantarray) { 249 return ($n, $m); 250 } 251 else { 252 return "$n/$m"; 253 } 254} 255 256 257# Euclidean algorithm for calculating a GCD. 258# Takes two integers, returns the greatest common divisor. 259sub gcd ($$) 260{ 261 my ($n, $m) = @_; 262 while ($m) { 263 my $k = $n % $m; 264 ($n, $m) = ($m, $k); 265 } 266 return $n; 267} 268 269 270# Takes a list of terms in a continued fraction, and converts it 271# into a fraction. 272sub ints_to_frac (@) 273{ 274 my ($n, $m) = (0, 1); # Start with 0 275 while (@_) { 276 my $k = pop; 277 if ($n) { 278 # Want frac for $k + 1/($n/$m) 279 ($n, $m) = frac_standard($k*$n + $m, $n); 280 } 281 else { 282 # Want $k 283 ($n, $m) = frac_standard($k, 1); 284 } 285 } 286 return frac_standard($n, $m); 287} 288 289 290# Takes a number, returns an anon sub which iterates through a set of 291# fractional approximations that converges very quickly to the number. 292sub ret_frac_iter ($) 293{ 294 my $x = shift; 295 my $term_iter = ret_next_term_iter($x); 296 my @ints; 297 return sub { 298 push @ints, $term_iter->(); 299 return ints_to_frac(@ints); 300 } 301} 302 303 304# Terms of a continued fraction converging on that number. 305sub ret_next_term_iter ($) 306{ 307 my $x = shift; 308 return sub { 309 (my $n, $x) = best_int($x); 310 if (0 != $x) { 311 $x = 1/$x; 312 } 313 return $n; 314 } 315} 316 317###################################################################### 318 319# Round a number to the nearest integer. 320sub round ($) 321{ 322 return int($_[0] + 0.5*($_[0] <=> 0)); 323} 324 325 326# Round a number to a given precision. 327sub prec ($) 328{ 329 return round ($_[0] / $rounding) * $rounding; 330} 331 332 333# Set a variable's value to the first defined value in the given list. 334# If the variable was not previously defined and no value in the list 335# is defined, do nothing. 336sub assign_default (\$@) 337{ 338 my $varptr = shift; # Pointer to variable to define 339 return if defined $$varptr && $$varptr ne "UNSPECIFIED"; 340 foreach my $val (@_) { 341 next if !defined $val; 342 $$varptr = $val; 343 return; 344 } 345} 346 347 348# Print and execute a shell command. An environment variable with the 349# same name as the command overrides the command name. Return 1 on 350# success, 0 on failure. Optionally abort if the command fails, based 351# on the first argument to execute_command. 352sub execute_command ($@) 353{ 354 my $abort_on_failure = shift; 355 my @command = @_; 356 $command[0] = $ENV{uc $command[0]} || $command[0]; 357 my $prettyargs = join (" ", map {/[\\ ]/ ? "'$_'" : $_} @command); 358 print "Invoking \"$prettyargs\"...\n"; 359 my $result = system @command; 360 die "${progname}: \"$prettyargs\" failed ($!)\n" if $result && $abort_on_failure; 361 return !$result; 362} 363 364 365# Output the font header. 366sub output_header () 367{ 368 # Show the initial boilerplate. 369 print OUTFILE <<"ENDHEADER"; 370%!FontType1-1.0: $fontname $fontversion 371%%CreationDate: $creationdate 372% Font converted to Type 1 by mf2pt1, written by Scott Pakin. 37311 dict begin 374/FontInfo 11 dict dup begin 375/version ($fontversion) readonly def 376/Notice ($comment) readonly def 377/FullName ($fullname) readonly def 378/FamilyName ($familyname) readonly def 379/Weight ($weight) readonly def 380/ItalicAngle $italicangle def 381/isFixedPitch $fixedpitch def 382/UnderlinePosition $underlinepos def 383/UnderlineThickness $underlinethick def 384end readonly def 385/FontName /$fontname def 386ENDHEADER 387 388 # If we're not using an encoding that PostScript knows about, then 389 # create an encoding vector. 390 if ($encoding==\@standardencoding) { 391 print OUTFILE "/Encoding StandardEncoding def\n"; 392 } 393 else { 394 print OUTFILE "/Encoding 256 array\n"; 395 print OUTFILE "0 1 255 {1 index exch /.notdef put} for\n"; 396 foreach my $charnum (0 .. $#{$encoding}) { 397 if ($encoding->[$charnum] && $encoding->[$charnum]!~/^_a\d+$/) { 398 print OUTFILE "dup $charnum /$encoding->[$charnum] put\n"; 399 } 400 } 401 print OUTFILE "readonly def\n"; 402 } 403 404 # Show the final boilerplate. 405 print OUTFILE "/UniqueID $uniqueID def\n" if defined $uniqueID; 406 print OUTFILE <<"ENDHEADER"; 407/PaintType 0 def 408/FontType 1 def 409/FontMatrix [0.001 0 0 0.001 0 0] readonly def 410/FontBBox{@fontbbox}readonly def 411currentdict end 412currentfile eexec 413dup /Private 5 dict dup begin 414/RD{string currentfile exch readstring pop}executeonly def 415/ND{noaccess def}executeonly def 416/NP{noaccess put}executeonly def 417ENDHEADER 418} 419 420 421# Use MetaPost to generate one PostScript file per character. We 422# calculate the font bounding box from these characters and store them 423# in @fontbbox. If the input parameter is 1, set other font 424# parameters, too. 425sub get_bboxes ($) 426{ 427 execute_command 1, ("mpost", "-mem=mf2pt1", "-recorder", "-progname=mpost", 428 "\\mode:=localfont; mag:=$mag; bpppix $bpppix; nonstopmode; input $mffile"); 429 opendir (CURDIR, ".") || die "${progname}: $! ($filedir)\n"; 430 @charfiles = sort 431 { ($a=~ /\.(\d+)$/)[0] <=> ($b=~ /\.(\d+)$/)[0] } 432 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. 576sub 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 ($charbbox[$charnum]->[2])) 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. 723sub output_trailer () 724{ 725 print OUTFILE <<"ENDTRAILER"; 726/.notdef { 727 0 @{[frac_string (frac_approx ($fontbbox[2] - $fontbbox[0]))]} hsbw 728 endchar 729 } ND 730end 731end 732readonly put 733noaccess put 734dup/FontName get exch definefont pop 735mark currentfile closefile 736cleartomark 737ENDTRAILER 738} 739 740###################################################################### 741 742# Parse the command line. Asterisks in the following represents 743# commands also defined by Plain Metafont. 744my %opthash = (); 745GetOptions (\%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); 764if (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} 771do {print $versionmsg; exit 1} if defined $opthash{"V"}; 772pod2usage(2) if $#ARGV != 0; 773 774# Extract the filename from the command line. 775$mffile = $ARGV[0]; 776my @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 783assign_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. 787get_bboxes(1); # This might set $designsize. 788 789# Sanity-check the specified precision. 790assign_default $rounding, $opthash{rounding}, 1; 791if ($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. The only 796# exception is the unique ID, as Adobe no longer recommends specifying one. 797assign_default $fontversion, $opthash{fontversion}, "001.000"; 798assign_default $creationdate, scalar localtime; 799assign_default $comment, $opthash{comment}, "Font converted to Type 1 by mf2pt1, written by Scott Pakin."; 800assign_default $weight, $opthash{weight}, "Medium"; 801assign_default $fixedpitch, $opthash{fixedpitch}, 0; 802assign_default $uniqueID, $opthash{uniqueid}; 803assign_default $designsize, $opthash{designsize}; 804die "${progname}: a design size must be specified in $mffile or on the command line\n" if !defined $designsize; 805die "${progname}: the design size must be a positive number\n" if $designsize<=0.0; 806assign_default $underlinepos, $opthash{underpos}, -1; 807$underlinepos = round(1000*$underlinepos/$designsize); 808assign_default $underlinethick, $opthash{underthick}, 0.5; 809$underlinethick = round(1000*$underlinethick/$designsize); 810assign_default $fullname, $opthash{fullname}, $filebase; 811assign_default $familyname, $opthash{family}, $fullname; 812assign_default $italicangle, $opthash{italicangle}, 0; 813assign_default $fontname, $opthash{name}, "$familyname-$weight"; 814$fontname =~ s/\s//g; 815assign_default $encoding, $opthash{encoding}, "standard"; 816my $encoding_name = $encoding; 817ENCODING: 818{ 819 if (-e $encoding) { 820 # Filenames take precedence over built-in encodings. 821 my @enc_array; 822 open (ENCFILE, "<$encoding") || die "${progname}: $! ($encoding)\n"; 823 while (my $oneline = <ENCFILE>) { 824 $oneline =~ s/\%.*$//; 825 foreach my $word (split " ", $oneline) { 826 push @enc_array, substr($word, 1) if substr($word, 0, 1) eq "/"; 827 } 828 } 829 close ENCFILE; 830 $encoding_name = substr (shift @enc_array, 1); 831 $encoding = \@enc_array; 832 last ENCODING; 833 } 834 $encoding=\@standardencoding, last ENCODING if $encoding eq "standard"; 835 $encoding=\@isolatin1encoding, last ENCODING if $encoding eq "isolatin1"; 836 $encoding=\@ot1encoding, last ENCODING if $encoding eq "ot1"; 837 $encoding=\@t1encoding, last ENCODING if $encoding eq "t1"; 838 $encoding=\@glyphname, last ENCODING if $encoding eq "asis"; 839 warn "${progname}: Unknown encoding \"$encoding\"; using standard Adobe encoding\n"; 840 $encoding=\@standardencoding; # Default to standard encoding 841} 842assign_default $fixedpitch, $opthash{fixedpitch}, 0; 843$fixedpitch = $fixedpitch ? "true" : "false"; 844assign_default $ffscript, $opthash{ffscript}; 845 846# Output the final values of all of our parameters. 847print "\n"; 848print <<"PARAMVALUES"; 849mf2pt1 is using the following font parameters: 850 font_version: $fontversion 851 font_comment: $comment 852 font_family: $familyname 853 font_weight: $weight 854 font_identifier: $fullname 855 font_fixed_pitch: $fixedpitch 856 font_slant: $italicangle 857 font_underline_position: $underlinepos 858 font_underline_thickness: $underlinethick 859 font_name: $fontname 860 font_size: $designsize (bp) 861 font_coding_scheme: $encoding_name 862PARAMVALUES 863 ; 864print " font_unique_id: $uniqueID\n" if defined $uniqueID; 865print "\n"; 866 867# Scale by a factor of 1000/design size. 868$mag = 1000.0 / $designsize; 869get_bboxes(0); 870print "\n"; 871 872# Output the font in disassembled format. 873open (OUTFILE, ">$pt1file") || die "${progname}: $! ($pt1file)\n"; 874output_header(); 875printf OUTFILE "2 index /CharStrings %d dict dup begin\n", 876 1+scalar(grep {defined($_)} @charbbox); 877output_font_programs(); 878output_trailer(); 879close OUTFILE; 880unlink @charfiles; 881print "\n"; 882 883# Convert from the disassembled font format to Type 1 binary format. 884if (!execute_command 0, ("t1asm", $pt1file, $pfbfile)) { 885 die "${progname}: You'll need either to install t1utils and rerun $progname or find another way to convert $pt1file to $pfbfile\n"; 886 exit 1; 887} 888print "\n"; 889unlink $pt1file; 890 891# Use FontForge to autohint the result. 892my $user_script = 0; # 1=script file was provided by the user; 0=created here 893if (defined $ffscript) { 894 # The user provided his own script. 895 $user_script = 1; 896} 897else { 898 # Create a FontForge script file. 899 $ffscript = $filebase . ".pe"; 900 open (FFSCRIPT, ">$ffscript") || die "${progname}: $! ($ffscript)\n"; 901 print FFSCRIPT <<'AUTOHINT'; 902Open($1); 903SelectAll(); 904RemoveOverlap(); 905AddExtrema(); 906Simplify(0, 2); 907CorrectDirection(); 908Simplify(0, 2); 909RoundToInt(); 910AutoHint(); 911Generate($1); 912Quit(0); 913AUTOHINT 914 ; 915 close FFSCRIPT; 916} 917if (!execute_command 0, ("fontforge", "-script", $ffscript, $pfbfile)) { 918 warn "${progname}: You'll need to install FontForge if you want $pfbfile autohinted (not required, but strongly recommended)\n"; 919} 920unlink $ffscript if !$user_script; 921print "\n"; 922 923# Finish up. 924print "*** Successfully generated $pfbfile! ***\n"; 925exit 0; 926 927###################################################################### 928 929__END__ 930 931=head1 NAME 932 933mf2pt1 - produce a PostScript Type 1 font program from a Metafont source 934 935 936=head1 SYNOPSIS 937 938mf2pt1 939[B<--help>] 940[B<--version>] 941[B<--comment>=I<string>] 942[B<--designsize>=I<number>] 943[B<--encoding>=I<encoding>] 944[B<--family>=I<name>] 945[B<-->[B<no>]B<fixedpitch>] 946[B<--fontversion>=I<MMM.mmm>] 947[B<--fullname>=I<name>] 948[B<--italicangle>=I<number>] 949[B<--name>=I<name>] 950[B<--underpos>=I<number>] 951[B<--underthick>=I<number>] 952[B<--uniqueid>=I<number>] 953[B<--weight>=I<weight>] 954[B<--rounding>=I<number>] 955[B<--bpppix>=I<number>] 956[B<--ffscript>=I<file.pe>] 957I<infile>.mf 958 959 960=head1 WARNING 961 962The B<mf2pt1> Info file is the main source of documentation for 963B<mf2pt1>. This man page is merely a brief summary. 964 965 966=head1 DESCRIPTION 967 968B<mf2pt1> facilitates producing PostScript Type 1 fonts from a 969Metafont source file. It is I<not>, as the name may imply, an 970automatic converter of arbitrary Metafont fonts to Type 1 format. 971B<mf2pt1> imposes a number of restrictions on the Metafont input. If 972these restrictions are met, B<mf2pt1> will produce valid Type 1 973output. (Actually, it produces "disassembled" Type 1; the B<t1asm> 974program from the B<t1utils> suite will convert this to a true Type 1 975font.) 976 977=head2 Usage 978 979 mf2pt1 myfont.mf 980 981=head1 OPTIONS 982 983Font parameters are best specified within a Metafont program. If 984necessary, though, command-line options can override any of these 985parameters. The B<mf2pt1> Info page, the primary source of B<mf2pt1> 986documentation, describes the following in greater detail. 987 988=over 4 989 990=item B<--help> 991 992Provide help on B<mf2pt1>'s command-line options. 993 994=item B<--version> 995 996Output the B<mf2pt1> version number, copyright, and license. 997 998=item B<--comment>=I<string> 999 1000Include a font comment, usually a copyright notice. 1001 1002=item B<--designsize>=I<number> 1003 1004Specify the font design size in points. 1005 1006=item B<--encoding>=I<encoding> 1007 1008Designate the font encoding, either the name of a---typically 1009F<.enc>---file which contains a PostScript font-encoding vector or one 1010of C<standard> (the default), C<ot1>, C<t1>, or C<isolatin1>. 1011 1012=item B<--family>=I<name> 1013 1014Specify the font family. 1015 1016=item B<--fixedpitch>, B<--nofixedpitch> 1017 1018Assert that the font uses either monospaced (B<--fixedpitch>) or 1019proportional (B<--nofixedpitch>) character widths. 1020 1021=item B<--fontversion>=I<MMM.mmm> 1022 1023Specify the font's major and minor version number. 1024 1025=item B<--fullname>=I<name> 1026 1027Designate the full font name (family plus modifiers). 1028 1029=item B<--italicangle>=I<number> 1030 1031Designate the italic angle in degrees counterclockwise from vertical. 1032 1033=item B<--name>=I<name> 1034 1035Provide the font name. 1036 1037=item B<--underpos>=I<number> 1038 1039Specify the vertical position of the underline in thousandths of the 1040font height. 1041 1042=item B<--underthick>=I<number> 1043 1044Specify the thickness of the underline in thousandths of the font 1045height. 1046 1047=item B<--uniqueid>=I<number> 1048 1049Specify a globally unique font identifier. 1050 1051=item B<--weight>=I<weight> 1052 1053Provide a description of the font weight (e.g., ``Heavy''). 1054 1055=item B<--rounding>=I<number> 1056 1057Specify the fraction of a font unit (0.0 < I<number> <= 1.0) to which 1058to round coordinate values [default: 1.0]. 1059 1060=item B<--bpppix>=I<number> 1061 1062Redefine the number of big points per pixel from 0.02 to I<number>. 1063 1064=item B<--ffscript>=I<file.pe> 1065 1066Name a script to pass to FontForge. 1067 1068=back 1069 1070 1071=head1 FILES 1072 1073F<mf2pt1.mem> (which is generated from F<mf2pt1.mp> and F<mfplain.mp>) 1074 1075 1076=head1 NOTES 1077 1078As stated in L</"WARNING">, the complete source of documentation for 1079B<mf2pt1> is the Info page, not this man page. 1080 1081 1082=head1 SEE ALSO 1083 1084mf(1), mpost(1), t1asm(1), fontforge(1) 1085 1086 1087=head1 AUTHOR 1088 1089Scott Pakin, I<scott+mf@pakin.org> 1090