1#!/usr/local/bin/perl 2# 3# You may need to change the above path. 4# 5#----------------------------------------------------------------------------- 6# 7# Copyright (C) 1996-1998 James Macnicol 8# 9# This program is free software; you can redistribute it and/or modify 10# it under the terms of the GNU General Public License as published by the 11# Free Software Foundation; either version 2, or (at your option) any later 12# version. 13# 14# This program is distributed in the hope that it will be useful, but 15# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTIBILITY 16# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17# for more details. 18# 19#----------------------------------------------------------------------------- 20# 21# type1inst : Generate a "fonts.scale" file for Type 1 fonts in PFB format 22# for use with your favourite X server. Also generate a "Fontmap" for use 23# with ghostscript. 24# 25# cd to the directory you want to install fonts in and invoke this script. 26# Options: 27# 28# -samples Create sample PS files for each font 29# -nox Do not create fonts.scale and fonts.dir for X11 30# -nogs Do not create Fontmap for GhostScript 31# -quiet Don't print anything on the stdout, just to the log 32# (see also next section). 33# -silent Same as -quiet (for backwards compatiblity) 34# -q Same as -quiet 35# -nolog Don't create a log file 36# -version Print version info and quit 37# -v Same as -version 38# 39# 40# 41# THIS IS BETA SOFTWARE! PLEASE READ THE "README" FILE!!! 42# 43# Direct all correspondence regarding this software to 44# 45# J.Macnicol@student.anu.edu.au 46# 47# 48# Good luck! 49# 50# 51# James Macnicol 52# 53#----------------------------------------------------------------------------- 54 55# Version number and date information 56 57# NOTE THAT MY E-MAIL ADDRESS HAS CHANGED (AS OF VERSION 0.6.1) !!!! 58 59$version = "0.6.1"; 60$versiondate = "11th February 1998"; 61$emailaddress = "james.macnicol\@mailexcite.com"; 62$copyright = "Copyright (C) 1996-1998 James Macnicol ($emailaddress)"; 63 64# 65# Map identifying strings in /Notice into foundry names. Separate identifier 66# from name with a :. Someone let me know if this is a problem (i.e. foundry 67# has a : in its name which really ought to be there (although I may not 68# believe it) ; we'll change it to ! or something. 69# 70# You probably want to put foundries which license type from others near the 71# top of this list (e.g. Adobe). If the name of the original source of the 72# face is listed lower down then it will be used that instead. It's just that 73# Adobe does have its own faces too, but more often than not they are 74# licensed. Doing it this way will make it work out correctly in either case. 75# 76 77 78@foundries = ( 79 "Adobe:adobe", 80 "Allied Corporation:allied", 81 "American Mathematical Society:ams", 82 "Publishers' Paradise:paradise", 83 "PUBLISHERS' PARADISE:paradise", 84 "Bigelow & Holmes:b&h", 85 "Bitstream:bitstream", 86 "Corel Corporation:corel", 87 "Swfte International:expert", 88 "International Typeface Corporation:itc", 89 "IBM:ibm", 90 "LETRASET:letraset", 91 "Monotype Corporation:monotype", 92 "Star Division GmbH:star", 93 "SoftMaker:softmaker", 94 "URW:urw", 95 "Jonathan Brecher:brecher", 96 "Brendel Informatik:brendel", 97 "A. Carr:carr", 98 "FontBank:fontbank", 99 "Hershey:hershey", 100 "A.S.Meit:meit", 101 "Andrew s. Meit:meit", 102 "S.G. Moye:moye", 103 "S. G. Moye:moye", 104 "D. Rakowski:rakowski", 105 "David Rakowski:rakowski", 106 "Reasonable Solutions:reasonable", 107 "Southern Software:southern", 108 "Title Wave:titlewave", 109 "Wolfram Research:wri", 110 "ZSoft:zsoft", 111 "Digiteyes Multimedia:digiteyes", 112 "MWSoft:mwsoft", 113 "MacroMind:macromind", 114 "Three Islands Press:3ip", 115 "Hank Gillette:gillette", 116 "Doug Miles:miles", 117 "Richard Mitchell:mitchell", 118 "Porchez Typofonderie:ptf"); 119 120# Note: Hershey is the public Hershey fonts which come with Ghostscript. 121# These cause no end of problems since they look inside like funny PS 122# programs rather than standard fonts. The current version of type1inst will 123# refuse to process such fonts. Older versions (< 0.6) tended to fall over 124# when these were present. 125 126# Note 2 : Some of these are obviously names of people only, not companies. 127# They are generally public domain fonts. 128 129# Note 3 : Publisher's Paradise did not produce a majority of the fonts that 130# contain their name in the /Notice field, rather they distributed them on 131# their BBS. Unfortunately there is no other identifying info in these fonts. 132 133# 134# These are font weights. Some are synonyms, e.g. regular for medium. It 135# has been suggested we map "thin" to "light", however there are some font 136# families which have both "thin" and "light" variants. An example is 137# Linotype's Helvetica Neue. Please let me know if you find a font where 138# assuming "semi", and "demi" to be the same fails. 139# 140 141@weights = ( 142 "book:book", 143 "demibold:demibold", 144 "semibold:demibold", 145 "demi:demibold", 146 "semi:demibold", 147 "extrabold:extrabold", 148 "boldface:bold", 149 "bold:bold", 150 "heavyface:heavyface", 151 "heavy:heavy", 152 "ultrablack:ultrablack", 153 "extrablack:extrablack", 154 "ultra:ultra", # it's gonna break some widths... 155 "black:black", 156 "extralight:extralight", 157 "light:light", 158 "thin:thin", 159 "super:super", 160 "thin:thin", 161 "light:light", 162 "semi:demi", 163 "bold:bold", 164 "heavy:heavy", 165 "black:black", 166 "normal:medium", 167 "regular:regular", 168 "roman:regular" # this too might break something... 169 ); 170 171# 172# Likewise for slants 173# 174 175@slants = ( 176 "italic:i", 177 "roman:r", 178 "regular:r", 179 # "it:i", 180 "cursive:i", 181 "kursiv:i", 182 "oblique:o", 183 "obl:o", 184 "slanted:o", 185 # Cyrillic fonts 186 "upright:r", 187 "inclined:i"); 188 189# 190# Style. Wondering if we should put "serif" in here somehow....? 191# 192# I haven't put "ultracondensed" here since I think they're two different 193# things, i.e. Garamond Ultra Condensed is very bold but condensed. 194 195@styles = ( 196 "extracondensed:extracondensed", 197 "condensed:condensed", 198 "cond:condensed", 199 "sans:sans", 200 "wide:wide", 201 "cn:condensed", 202 "narrow:narrow", 203 "extracompressed:extracompressed", 204 "compressed:compressed", 205 "extraextended:extraextended", 206 "extended:extended", 207 "expanded:expanded", 208 "normal:normal"); 209 210# 211# Additional styles. Refer to the line that puts together $xline. 212# 213 214@addstyles = ("alt:alternate", 215 "beginning:beginning", 216 "display:display", 217 "dfr:dfr", 218 "ending:ending", 219 # "exp" and "ep" seems to be sometimes part of a fonts name, 220 # sometimes part of additional classification. I'm crying... :-( 221 "ep:expert", 222 "exp:expert", 223 "ornaments:ornaments", 224 "osf:oldstylefigures", 225 "outline:outline", 226 "sc:smallcaps", 227 "shaded:shaded", 228 "shadowed:shadowed", 229 "stencil:stencil", 230 "swash:swash", 231 "sw:swash", 232 "one:one", 233 "two:two", 234 "three:three", 235 "four:four", 236 # Some fonts use just "a" to mean a font with alternate 237 # character set. 238 "a:alternate"); 239 240# 241# Write a message to the stdout and/or the log file depending on what the 242# user chose. 243# 244 245sub log_msg { 246 ($msg) = @_; 247 248 if (! $silent) { 249 print STDOUT "$msg"; 250 } 251 if ($dologfile) { 252 print LOG "$msg"; 253 } 254} 255 256sub log_only_msg { 257 ($msg) = @_; 258 259 if ($dologfile) { 260 print LOG "$msg"; 261 } 262} 263 264# 265# Die with a bug message 266# 267 268sub die_bug { 269 ($msg) = @_; 270 271 die("BUG: $msg\nIf you have not modified the script in a way which might have\ncaused this error you are encouraged to report it as a bug to\n\n$emailaddress\n\n"); 272} 273 274# 275# Print out a string with a given minimum width. This is used to make the 276# Fontmap entries look nice. 277# 278 279sub print_min_width { 280 ($stream, $minwidth, $string) = @_; 281 $_ = $string; 282 $strlength = length($string); 283 # Print the string 284 print $stream $string; 285 # Now pad out the rest of the space if the string is short. 286 if ($strlength < $minwidth) { 287 for ($i = 0; $i < ($minwidth - $strlength); $i = $i + 1) { 288 print $stream " "; 289 } 290 } 291} 292 293# 294# Indicate progress through the directory on the command line 295# 296 297sub print_progress { 298 $totalfonts = $numpffonts + $numgsfonts + $badfonts; 299 if (! $silent) { 300 if (($totalfonts % 10) == 0) { 301 print "[$totalfonts]\n"; 302 } 303 } 304} 305 306# 307# Put the processing stuff into a procedure since we want to do the same for 308# .pfb, .pfa and .gsf files (once .pfb's are decompressed). 309# 310# Argument : filename. 311# Returns : X font description, name of font for Fontmap 312# 313 314sub process_font { 315 ($fname) = @_; 316 local($xline); 317 318 # Check to see if this is a ghostscript font 319 if ($fname =~ /\.gsf\s*$/) { 320 $gsfont = 1; 321 } else { 322 $gsfont = 0; 323 } 324 325 # Default is not MultipleMaster 326 $mm = 0; 327 328 open(IN, $fname) || die "cannot open $file for reading"; 329 # An unlikely name to check to see we get a fontname out of the file. 330 $fontname = "abcXYZ:!@#"; 331 $foundry = "unknown"; 332 $notice = "No notice given."; 333 while(<IN>) { 334 if (/\/isFixedPitch\s+(.+)\s+def\s*/) { 335 if ($1 =~ /true/) { 336 $fixedpitch = "m"; 337 } else { 338 $fixedpitch = "p"; 339 } 340 } 341 342 # I think that we should accept the manufacturers classification. 343 # Try to extract this from FontName only if it's missing. 344 # (It shouldn't. There are other reasons why this won't work, though.) 345 if (/\/FamilyName\s*\((.+)\)\s*readonly\s+def\s*/) { 346 $familyname = $1; 347 348 # Convert to lower case (because case is insignificant). 349 # Spaces are acceptable according to XLFD. 350 $familyname =~ tr/A-Z/a-z/; 351 } 352 # Previous applies to this also... This might make xfontsels list a 353 # a little cluttered, though. Perhaps it would be better to map it 354 # to standard strings like you do. It's named $weight_add because 355 # you already used $weight... 356 if (/\/Weight\s*\((.+)\)\s*readonly\s+def\s*/) { 357 $weight_add = $1; 358 359 # Convert to lower case. Spaces are acceptable according to XLFD? 360 # Remove for consistency (as there would be any left after my 361 # slaughtering). 362 $weight_add =~ tr/A-Z/a-z/; 363 $weight_add =~ s/\s*//g; 364 365 # Remember if it's a MultipleMaster font 366 $mm = 1 if ($weight_add =~ /^all$/); 367 # Strange. This field seems to contain also width sometimes... remove it. 368 $numstyles = @styles; 369 for ($x = 0; $x < $numstyles; $x = $x + 1) { 370 $ident = $styles[$x]; 371 @fields = split(/:/, $ident); 372 $numfields = @fields; 373 if ($numfields != 2) { 374 die_bug("The style identification \"$ident\" is bad\n"); 375 } 376 # Remove matched word from the font's name 377 $weight_add =~ s/$fields[0]//; 378 } 379 } 380 # FullName might contain useful information in determining 381 # the properties of a font. 382 if (/\/FullName\s*\((.+)\)\s*readonly\s+def\s*/) { 383 $fullname = $1; 384 385 # Convert to lower case 386 $fullname =~ tr/A-Z/a-z/; 387 388 # Some names got extra numerical information at the start. 389 $fullname =~ s/^\d*\s*(.+)/$1/; 390 } 391 # Note : some fonts have a suspect /FontName declaration where there 392 # is no space between /FontName and the name of the font itself.... 393 if (/\/FontName\s*[\/\(]([^\)]+)\)?\s*def\s*/ 394 or ($gsfont and /^\/([^ ]+)\s+\d+\s+\[107\s+0/)) { 395 $fontname = $1; 396 397 # Remove any embedded spaces 398 # (Probably unnecessary. If I remember it right, it can't contain any spaces, 399 # because it's a PostScript identifier/keyword or what's the right term...) 400 $fontname =~ s/\s//g; 401 402 # Save a copy of original full name for later 403 $fontnamecopy = $fontname; 404 405 # Convert to lower case 406 $fontname =~ tr/A-Z/a-z/; 407 408 # There are fonts like Mendoza Roman, Baskerville Book etc, where what 409 # looks like weight is part of the font's name, not it's weight. 410 # Split the name into fontname and fontstyle instead and handle them separate. 411 ($fontname, $fontstyle) = split(/-/, $fontname); 412 413 # Remove -s 414 $fontname =~ s/-//g; 415 $fontstyle =~ s/-//g; 416 417 418 # Check for weight modifiers (medium, bold, demi, light etc.) 419 $weight = "medium"; 420 $numweights = @weights; 421 for ($x = 0; $x < $numweights; $x = $x + 1) { 422 $ident = $weights[$x]; 423 @fields = split(/:/, $ident); 424 $numfields = @fields; 425 if ($numfields != 2) { 426 die_bug("The weight identification \"$ident\" is bad\n"); 427 } 428 if ($fontstyle =~ /$fields[0]/) { 429 $weight = $fields[1]; 430 } elsif ($weight_add) { 431 # Try any possible way 432 $weight = $weight_add; 433 } 434 # Remove matched word from the font's name 435 $fontstyle =~ s/$fields[0]//; 436 } 437 438 # Check for slant (italic, roman, oblique) 439 $slant = "r"; 440 441 $numslants = @slants; 442 for ($x = 0; $x < $numslants; $x = $x + 1) { 443 $ident = $slants[$x]; 444 @fields = split(/:/, $ident); 445 $numfields = @fields; 446 if ($numfields != 2) { 447 die_bug("The slant identification \"$ident\" is bad\n"); 448 } 449 if ($fontstyle =~ /$fields[0]/) { 450 $slant = $fields[1]; 451 } 452 # Remove matched word from the font's name 453 $fontstyle =~ s/$fields[0]//; 454 } 455 456 # Check for style (condensed, normal, sans, or wide) 457 $style = "normal"; 458 459 $numstyles = @styles; 460 for ($x = 0; $x < $numstyles; $x = $x + 1) { 461 $ident = $styles[$x]; 462 @fields = split(/:/, $ident); 463 $numfields = @fields; 464 if ($numfields != 2) { 465 die_bug("The style identification \"$ident\" is bad\n"); 466 } 467 if ($fontstyle =~ /$fields[0]/) { 468 $style = $fields[1]; 469 } 470 # Remove matched word from the font's name 471 $fontstyle =~ s/$fields[0]//; 472 } 473 474 # Check for additional styles (alternate, smallcaps, oldstylefigures etc.) 475 $addstyle = ""; 476 477 $numaddstyles = @addstyles; 478 for ($x = 0; $x < $numaddstyles; $x = $x + 1) { 479 $ident = $addstyles[$x]; 480 @fields = split(/:/, $ident); 481 $numfields = @fields; 482 if ($numfields != 2) { 483 die_bug("The additional style identification \"$ident\" is bad.\n"); 484 } 485 if ($fontstyle =~ /$fields[0]/) { 486 $addstyle = $fields[1]; 487 } 488 # Remove matched word from the font's name 489 $fontstyle =~ s/$fields[0]//; 490 } 491 } 492 if (/^\/Encoding\s+(\S+)\s*/) { 493 if ($1 =~ /StandardEncoding/) { 494 $encoding = "iso8859-1"; 495 } else { 496 # This needs work 497 $encoding = "adobe-fontspecific"; 498 } 499 } 500 501 if (/^\s*\/Notice\s*(.*)$/) { 502 $notice = $1; 503 504 $notice =~ s/readonly def//g; 505 506 $numfoundries = @foundries; 507 for ($x = 0; $x < $numfoundries; $x = $x + 1) { 508 $ident = $foundries[$x]; 509 @fields = split(/:/, $ident); 510 $numfields = @fields; 511 if ($numfields != 2) { 512 die_bug("The foundry identification \"$ident\" is bad.\n"); 513 } 514 if ($notice =~ /$fields[0]/) { 515 $foundry = $fields[1]; 516 } 517 } 518 } 519 520 # MultipleMaster fonts have this field. 521 if (/\/BlendAxisTypes\s+\[([^\]]+)\]\s*def/) { 522 $axis = $1; 523 # Remove axises we don't need 524 $axis =~ s/\/Weight\s*//; 525 $axis =~ s/\/Width\s*//; 526 # Are there still some axises left? 527 if ($axis =~ /\//) { 528 # Remove trailing spaces 529 $axis =~ s/^(.*?)\s*$/$1/; 530 $axis =~ s/\/\S+/0/g; 531 $axis= "[$axis]"; 532 } 533 } 534 535 # Break out of loop if we've passed the interesting stuff. 536 # And time to try another way to find out the fontname. 537 if ((! $gsfont) && (/currentfile\s+eexec/)) { 538 &try_another_way(); 539 # This is for .pfa and .pfb fonts 540 last; 541 } #elsif (($gsfont) && (/currentdict\s+end/)) { 542 # &try_another_way(); 543 # # This is for ghostscript .gsf fonts. Why don't all these have a 544 # # currentfile eexec ? 545 # last; 546 #} 547 } 548 close(IN); 549 550 # I use quite different mechanism to get fontname etc. However it's done, 551 # the results are hard to get right. Should it be a command-line option? 552 # Now I try both ways. 553 554 # familyname, use fontname 555 $familyname = ($anotherway ? $familyname : $fontname); 556 557 # Oh, we are dealing with a MultipleMaster font... 558 if ($mm) { 559 $weight = "0"; 560 $style = "0"; 561 $addstyle .= $axis; 562 } 563 564 if ($familyname =~ /abcXYZ\:\!\@\#/) { 565 log_only_msg("\n"); 566 log_only_msg("$filename : could not determine font name\n"); 567 log_only_msg("\n"); 568 $badfonts = $badfonts + 1; 569 &print_progress(); 570 return; 571 } 572 573 if (($dox) && (! $gsfont) && ($foundry =~ /unknown/)) { 574 $nofoundry = $nofoundry + 1; 575 log_only_msg("\n"); 576 log_only_msg("$filename ($fontnamecopy) : foundry not matched\n"); 577 log_only_msg(" /Notice said : \"$notice\"\n"); 578 log_only_msg("\n"); 579 } elsif ($dox) { 580# log_only_msg("$filename ($fontnamecopy) : okay\n"); 581 } 582 583 if (($dox) && (! $gsfont)) { 584 # Addstyle is any extra information needed to uniquely identify a variation of a font 585 # in it's family, like "alternate" (ACaslon-AltRegular) or "one" (EuropeanPi-One). 586 # Changed fontname to familyname because it describes that field better, but that's 587 # just my opinion... 588 $xline = "-$foundry-$familyname-$weight-$slant-$style-$addstyle-0-0-0-0-$fixedpitch-0-$encoding"; 589 } 590 591 # Update count of each type 592 if ($gsfont) { 593 $numgsfonts = $numgsfonts + 1; 594 } else { 595 $numpffonts = $numpffonts + 1; 596 } 597 598 &print_progress(); 599 600 ($xline, $fontnamecopy); 601} 602 603 604# 605# An alternative way to get fontname 606# 607 608sub try_another_way { 609 # Strip familyname from fullname. This seems to work most of time. 610 # Some fontnames have extra numerical information after familyname. 611 # Strip it if it's longer than two numbers. 612 # Otherwise, it's probably part of additional style classification. 613 # In a few cases it IS part of the name, and this algorithm should break. 614 # Sometimes there's a strange string of *'s somewhere. Get rid of it. 615 $fullname =~ s/\*//g; 616 print STDERR "1: ${fullname}:\n" if $debug; 617 if ($fullname =~ s/^$familyname\s*(\d\d+)?\s*(.*)/$2/) { 618 # Wow. It worked. Let's continue and remove excess whitespace. 619 $anotherway = 1; 620 $fullname =~ s/\s+//g; 621 622 # familyname can now stripped of -s 623 $familyname =~ s/-//g; # Or space? 624 print STDERR "2: ${fullname}:\n" if $debug; 625 626 # Check for weight modifiers (medium, bold, demi, light etc.) 627 $weight = "medium"; 628 $numweights = @weights; 629 for ($x = 0; $x < $numweights; $x = $x + 1) { 630 $ident = $weights[$x]; 631 @fields = split(/:/, $ident); 632 $numfields = @fields; 633 if ($numfields != 2) { 634 die_bug("The weight identification \"$ident\" is bad\n"); 635 } 636 if ($fullname =~ /$fields[0]/) { 637 $weight = $fields[1]; 638 $weight =~ s/-//g; 639 } 640 # Remove matched word from the font's name 641 $fullname =~ s/$fields[0]//; 642 } 643 644 print STDERR "3: ${fullname}:\n" if $debug; 645 646 # Check for slant (italic, oblique) 647 $slant = "r"; 648 649 $numslants = @slants; 650 for ($x = 0; $x < $numslants; $x = $x + 1) { 651 $ident = $slants[$x]; 652 @fields = split(/:/, $ident); 653 $numfields = @fields; 654 if ($numfields != 2) { 655 die_bug("The slant identification \"$ident\" is bad\n"); 656 } 657 if ($fullname =~ /$fields[0]/) { 658 $slant = $fields[1]; 659 $slant =~ s/-//g; 660 } 661 # Remove matched word from the font's name 662 $fullname =~ s/$fields[0]//; 663 } 664 print STDERR "4: ${fullname}:\n" if $debug; 665 # Check for style (normal or sans) 666 $style = "normal"; 667 668 $numstyles = @styles; 669 for ($x = 0; $x < $numstyles; $x = $x + 1) { 670 $ident = $styles[$x]; 671 @fields = split(/:/, $ident); 672 $numfields = @fields; 673 if ($numfields != 2) { 674 die_bug("The style identification \"$ident\" is bad\n"); 675 } 676 if ($fullname =~ /$fields[0]/) { 677 $style = $fields[1]; 678 $style =~ s/-//g; 679 } 680 # Remove matched word from the font's name 681 $fullname =~ s/$fields[0]//; 682 } 683 684 # What's left of fullname is probably additional style information. 685 # Some fontnames have some strange numerical information here too. 686 # If it's just one number, it usually refers to some variant of the 687 # fontfamily, otherwise, just get rid of it. 688 $fullname = "" if ($fullname =~ /^\d\d+$/); 689 print STDERR "5: ${fullname}:\n" if $debug; 690 $addstyle = $fullname; 691 $addstyle =~ s/-//g; 692 } else { 693 $anotherway = 0; 694 } 695} 696 697# 698# Makes associative array out of current entries in fonts.scale 699# 700 701sub read_fonts_scale { 702 local($finish, %rv, $line, $filename, $fontname); 703 704 $finish = open(SCALE, "fonts.scale") ? 0 : 1; 705 if ($finish == 1) { 706 %rv; 707 } 708 709 log_only_msg("Reading fonts.scale ...."); 710 711 # First line should be an integer saying how many fonts there are. 712 # Discard. 713 $line = <SCALE>; 714 if (! $line =~ /\s*[0-9]+\s*/) { 715 log_only_msg("Warning : first line of fonts.scale is bad\n"); 716 } 717 718 while (<SCALE>) { 719 # Very rough pattern 720 if (/\s*(\S+)\s+(.+)\s*/) { 721 chop; 722 $filename = $1; 723 $fontname = $2; 724 if (! -e $filename) { 725 $numxremoved++; 726 log_only_msg("Removed fonts.scale entry \"$_\" since the file did not exist\n"); 727 next; 728 } 729 if ($rv{$filename}) { 730 $numxduplicates++; 731 log_only_msg("Warning : fonts.scale already contains a line for file \"$filename\"\n"); 732 log_only_msg(" the line \"$_\" has been ignored\n"); 733 } else { 734 $rv{$filename} = $fontname; 735 } 736 } else { 737 log_only_msg(" Couldn't understand line : \n"); 738 log_only_msg(" \"$_\"\n"); 739 } 740 } 741 close(SCALE); 742 743 log_only_msg("Done.\n"); 744 745 %rv; 746} 747 748# 749# Write out an associative array into fonts.scale, making a backup copy 750# first. 751# 752 753sub write_fonts_scale { 754 (%fontdata) = @_; 755 local($numentries, $key); 756 757 # First, make backup copy 758 if (-e "fonts.scale") { 759 system ("cp -f fonts.scale fonts.scale.bak"); 760 } 761 762 log_only_msg("Writing fonts.scale....\n"); 763 764 $numentries = keys(%fontdata); 765 open(SCALE, ">fonts.scale") || die("Can't open fonts.scale!\n"); 766 print SCALE "$numentries\n"; 767 foreach $key (sort(keys %fontdata)) { 768 print_min_width(SCALE, 12, $key); 769 print SCALE " "; 770 print SCALE "$fontdata{$key}\n"; 771 } 772 close(SCALE); 773 system ("chmod 0755 fonts.scale") && log_msg("Coudln't chmod \"fonts.scale\" ... continuing on anyway\n"); 774 775 log_only_msg(" Done.\n"); 776} 777 778# 779# Read the current Fontmap and return associative array with data. 780# 781 782sub read_fontmap { 783 local(%rv, $finish, $fontname, $filename); 784 785 $finish = open(FONTMAP, "Fontmap") ? 0 : 1; 786 if ($finish) { 787 %rv; 788 } 789 790 log_only_msg("Reading Fontmap ....\n"); 791 792 while (<FONTMAP>) { 793 if (/\/+(\S+)\s*\((.*)\)\s*;\s*/) { 794 chop; 795 $fontname = $1; 796 $filename = $2; 797 if (! -e $filename) { 798 $numgsremoved++; 799 log_only_msg("Removed Fontmap entry \"$_\" since the file did not exist\n"); 800 next; 801 } 802 if ($rv{$filename}) { 803 # Entry already exists 804 $numgsduplicates++; 805 log_only_msg("Warning : the Fontmap already contains a line for file \"$filename\"\n"); 806 log_only_msg(" the line \"$_\" has been ignored\n"); 807 } else { 808 $rv{$filename} = $fontname; 809 } 810 } else { 811 $numgsbarf++; 812 log_only_msg("Couldn't understand line :\n"); 813 log_only_msg(" $_\n"); 814 } 815 } 816 817 close(FONTMAP); 818 819 log_only_msg("Done.\n"); 820 821 %rv; 822} 823 824# 825# Write associative array containing font data to Fontmap 826# 827 828sub write_fontmap { 829 (%fontdata) = @_; 830 local($numentries, $key); 831 832 # First, make backup copy 833 if (-e "Fontmap") { 834 system ("cp -f Fontmap Fontmap.bak"); 835 } 836 837 log_only_msg("Writing Fontmap...."); 838 839 $numentries = keys(%fontdata); 840 open(FONTMAP, ">Fontmap") || die("Couldn't open Fontmap!\n"); 841 foreach $key (sort(keys %fontdata)) { 842 print_min_width(FONTMAP, 40, "/$fontdata{$key}"); 843 print FONTMAP " "; 844 print FONTMAP "($key)\t;\n"; 845 } 846 close(FONTMAP); 847 system ("chmod 0755 Fontmap") && log_msg("Couldn't chmod \"Fontmap\" ... continuing on anyway\n"); 848 849 log_only_msg(" Done.\n"); 850} 851 852# 853# Add a font (either X or gs) to hash table 854# 855 856sub add_font_to_aarray { 857 ($fname, $text, %aa) = @_; 858 859 if (($text =~ /^\s*$/) || ($fname =~ /^\s*$/)) { 860 # This will occur if the font is a dud (e.g. a Hershey font). We 861 # assume that $badfonts has been incremented and we just return. 862 %aa; 863 } 864 865 if (! $aa{$fname}) { 866 $aa{$fname} = $text; 867 } 868 869 %aa; 870} 871 872# 873# Create sample text using each font 874# 875 876sub font_sample { 877 ($filename, $fontname, $height) = @_; 878 local($text, $alltext, $samplefile); 879 880 if (($filename =~ /^\s*$/) || ($fontname =~ /^s*$/)) { 881 print "font_sample: $filename, $fontname\n"; 882 die_bug("Bad argument(s) to font_sample()!\n"); 883 } 884 885# Here we create a full page sample for the current font. It contains 886# a large point-size version, a normal sized version, and a small version. 887 888 $text = <<"TEXT"; 889%! 890%%EndComments 891/$samplefont findfont 89218 scalefont 893setfont 894newpath 895200 715 moveto 896(File : $filename) show 897200 695 moveto 898(Font Name : $fontname) show 899% t1embed : $filename $fontname 900closepath 901 902/$fontname findfont 90360 scalefont 904setfont 905newpath 90640 640 moveto 907(ABCDE) show 90840 575 moveto 909(FGHIJK) show 91040 510 moveto 911(LMNOP) show 91240 445 moveto 913(QRSTU) show 91440 380 moveto 915(VWXYZ) show 91640 305 moveto 917(abcdefghijklm) show 91840 240 moveto 919(nopqrstuvwxyz) show 92040 175 moveto 921(1234567890) show 922closepath 923 924/$fontname findfont 92512 scalefont 926setfont 927newpath 92850 148 moveto 929(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) show 93050 132 moveto 931(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) show 93250 116 moveto 933(1 2 3 4 5 6 7 8 9 0 \! \$ \% \& \\\( \\\) \; \: \< \> ) show 934closepath 935 936/$fontname findfont 9374 scalefont 938setfont 939newpath 94050 99 moveto 941(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) show 94250 93 moveto 943(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) show 94450 87 moveto 945(1 2 3 4 5 6 7 8 9 0 \! \$ \% \& \\\( \\\) \; \: \< \> ) show 946closepath 947showpage 948TEXT 949 950 $samplefile = $fontname . ".ps"; 951 open(SAMPLE, ">samples/$samplefile") || 952 die("Couldn't open samples/$samplefile\n"); 953 print SAMPLE "$text\n"; 954 close(SAMPLE); 955 system("chmod 0755 samples/$samplefile") && log_msg("Couldn't chmod individual sample file \"samples/$samplefile\" ... continuing on anyway\n"); 956 957# For the "allfont.ps" files we use a standard font for the font name so 958# that in the case of non-alpha fonts we still can still read the name of 959# the font (eg symbol or dingbats). 960 961 if ($height == 700) { 962 $allsample = "samples/allfont-$allcount.ps"; 963 $allcount = $allcount + 1; 964 965 log_only_msg("Creating new sample file \"$allsample\"...."); 966 open(ALLSAMPLE, ">$allsample") || 967 die("Couldn't open $allsample\n"); 968 log_only_msg("done\n"); 969 print ALLSAMPLE "%!\n"; 970 print ALLSAMPLE "%%EndComments\n"; 971 } 972 973 $alltext = <<"ALLTEXT"; 974 975% t1embed : $filename $fontname 976/$samplefont findfont 97712 scalefont 978setfont 979newpath 98030 $height moveto 981($fontname : ) show 982/$fontname findfont 98320 scalefont 984setfont 985(AbCdEfGhIjKlMnOpQrStUvWxYz 0123456789) show 986closepath 987ALLTEXT 988 989 print ALLSAMPLE "$alltext\n"; 990 $height = $height - 32; 991 if ($height < 100) { 992 print ALLSAMPLE "showpage\n"; 993 close(ALLSAMPLE); 994 system("chmod 0755 $allsample") && log_msg("Couldn't chmod all sample sheet \"$allsample\" ... continuing on anyway\n"); 995 $height = 700; 996 } 997 998 ($height); 999} 1000 1001# 1002# Some users have had problems with perl's file globbing not working. This 1003# gets a shell to do it for us. It matches all files with the extension 1004# specified in the parameter, i.e. if pat = "foo" then it matches all of 1005# *.foo . 1006# 1007 1008sub do_glob { 1009 ($pat) = @_; 1010 local($raw, @fnames); 1011 open(SHELL, "echo *.$pat|") || die("Couldn't open shell in do_glob\n"); 1012 $raw = <SHELL>; 1013 $raw =~ s/\*\.$pat//; 1014 @fnames = split(/\s/,$raw); 1015 close(SHELL); 1016 (@fnames); 1017} 1018 1019# ------------------------------------------------------------------------ 1020# Start of program proper 1021# ------------------------------------------------------------------------ 1022 1023# Process command line arguments 1024$dox = 1; 1025$dogs = 1; 1026$silent = 0; 1027$samples = 0; 1028$dologfile = 1; 1029@argvcopy = (@ARGV); 1030$numargs = @ARGV; 1031for ($x = 0; $x < $numargs; $x = $x + 1) { 1032 $arg = $ARGV[$x]; 1033 if ($arg =~ /-nox/) { 1034 $dox = 0; 1035 } elsif ($arg =~ /-nogs/) { 1036 $dogs = 0; 1037 } elsif ($arg =~ /-silent/) { 1038 $silent = 1; 1039 } elsif ($arg =~ /-quiet/) { 1040 $silent = 1; 1041 } elsif ($arg =~ /-q/) { 1042 $silent = 1; 1043 } elsif ($arg =~ /-samples/) { 1044 $samples = 1; 1045 } elsif ($arg =~ /-nolog/) { 1046 $dologfile = 0; 1047 } elsif ($arg =~ /-version/) { 1048 die("type1inst version $version ($versiondate)\n$copyright\n"); 1049 } elsif ($arg =~ /-v/) { 1050 die("type1inst version $version ($versiondate)\n$copyright\n"); 1051 } else { 1052 die("Usage: $0 [-silent] [-quiet] [-q] [-nox] [-nogs] [-samples] [-version] [-v]\n"); 1053 } 1054} 1055if ((! $dox) && (! $dogs) && (! $samples)) { 1056 die("$0: Nothing to do!\n"); 1057} 1058 1059# Open logfile 1060if ($dologfile) { 1061 open(LOG, ">type1inst.log") || die "Cannot open log file \"type1inst.log\""; 1062} 1063 1064log_only_msg("type1inst Version $version ($versiondate)\n"); 1065log_only_msg("$copyright\n\n"); 1066open (DATE, "date|") || die("Couldn't run \"date\"\n"); 1067$currenttime = <DATE>; 1068log_only_msg("Run started at $currenttime\n"); 1069close(DATE); 1070 1071# Setup directory for font samples 1072if ($samples) { 1073 if (! -e "samples") { 1074 # Create directory for sample text PS files 1075 log_only_msg("Creating directory for samples ...\n"); 1076 system("mkdir samples"); 1077 system("chmod 0755 samples") && log_msg("Coudln't chmod \"samples\" directory\n"); 1078 1079 } elsif (-f "samples") { 1080 die("$0: remove file \"samples\" or do not use -samples option\n"); 1081 } else { 1082 log_msg("Clearing samples directory\n"); 1083 system("rm -f samples/*.ps"); 1084 } 1085 $height = 700; 1086 $samplefont = "Helvetica"; 1087 $allcount = 0; 1088 $allsample = "samples/allfont-$allcount.ps"; 1089 log_only_msg("Creating new sample file \"$allsample\"...."); 1090 open(ALLSAMPLE, ">$allsample") || die("Couldn't open all sample file \"$allsample\"\n"); 1091 log_only_msg("done\n"); 1092 print ALLSAMPLE "%!\n"; 1093 print ALLSAMPLE "%%EndComments\n"; 1094} 1095 1096 1097# Counts how many fonts we come across 1098$numpffonts = 0; 1099$numgsfonts = 0; 1100$nofoundry = 0; 1101$badfonts = 0; 1102$numskipped = 0; 1103$numxremoved = 0; 1104$numgsremoved = 0; 1105$numxduplicates = 0; 1106$numgsduplicates = 0; 1107$numxbarf = 0; 1108$numgsbarf = 0; 1109 1110if (! $silent) { 1111 print "type1inst Version $version ($versiondate)\n"; 1112 print "$copyright\n\n"; 1113} 1114 1115$totalfonts = 0; 1116foreach $filename (do_glob("pfa")) { 1117 $totalfonts++; 1118} 1119foreach $filename (do_glob("pfb")) { 1120 $totalfonts++; 1121} 1122foreach $filename (do_glob("pfa.gz")) { 1123 $totalfonts++; 1124} 1125foreach $filename (do_glob("pfb.gz")) { 1126 $totalfonts++; 1127} 1128foreach $filename (do_glob("gsf")) { 1129 $totalfonts++; 1130} 1131if (! $silent) { 1132 if ($totalfonts == 0) { 1133 die("There are no PostScript fonts in this directory\n"); 1134 } elsif ($totalfonts == 1) { 1135 print "There is 1 PostScript font in this directory\n"; 1136 } else { 1137 print "There are a total of $totalfonts PostScript fonts in this directory\n"; 1138 } 1139} 1140 1141if ($dox) { 1142 %fs = &read_fonts_scale(); 1143} 1144if (($dogs) || ($samples)) { 1145 %fm = &read_fontmap(); 1146} 1147 1148# Process ASCII PS fonts 1149foreach $filename (do_glob("pfa")) { 1150 if (($dox && (! $fs{$filename})) || 1151 (($dogs || $samples) && (! $fm{$filename}))) { 1152 ($x, $gs) = &process_font($filename); 1153 if ($dox) { 1154 %fs = &add_font_to_aarray($filename, $x, %fs); 1155 } 1156 if (($dogs) || ($samples)) { 1157 %fm = &add_font_to_aarray($filename, $gs, %fm); 1158 } 1159 } else { 1160 $numpffonts = $numpffonts + 1; 1161 $numskipped = $numskipped + 1; 1162 &print_progress(); 1163 } 1164 if ($samples) { 1165 ($height) = &font_sample($filename, $fm{$filename}, $height); 1166 } 1167} 1168 1169# Process binary PS fonts 1170foreach $filename (do_glob("pfb")) { 1171 if (($dox && (! $fs{$filename})) || 1172 (($dogs || $samples) && (! $fm{$filename}))) { 1173 system("pfbtops $filename > foo"); 1174 ($x, $gs) = &process_font("foo"); 1175 system("rm foo"); 1176 if ($dox) { 1177 %fs = &add_font_to_aarray($filename, $x, %fs); 1178 } 1179 if ($dogs || $samples) { 1180 %fm = &add_font_to_aarray($filename, $gs, %fm); 1181 } 1182 } else { 1183 $numpffonts = $numpffonts + 1; 1184 $numskipped = $numskipped + 1; 1185 &print_progress(); 1186 } 1187 if ($samples) { 1188 ($height) = &font_sample($filename, $fm{$filename}, $height); 1189 } 1190} 1191 1192sub have_pfbtops_or_die 1193{ 1194 system "type pfbtops >/dev/null" or return; 1195 die "Can't find pfbtops. Try installing groff.\n"; 1196} 1197 1198# Process binary PS fonts 1199foreach $filename (do_glob("pfa.gz")) { 1200 if (($dox && (! $fs{$filename})) || 1201 (($dogs || $samples) && (! $fm{$filename}))) { 1202 have_pfbtops_or_die(); 1203 system("gunzip -c $filename > foo"); 1204 ($x, $gs) = &process_font("foo"); 1205 system("rm foo"); 1206 if ($dox) { 1207 %fs = &add_font_to_aarray($filename, $x, %fs); 1208 } 1209 if ($dogs || $samples) { 1210 %fm = &add_font_to_aarray($filename, $gs, %fm); 1211 } 1212 } else { 1213 $numpffonts = $numpffonts + 1; 1214 $numskipped = $numskipped + 1; 1215 &print_progress(); 1216 } 1217 if ($samples) { 1218 ($height) = &font_sample($filename, $fm{$filename}, $height); 1219 } 1220} 1221 1222# Process binary PS fonts 1223foreach $filename (do_glob("pfb.gz")) { 1224 if (($dox && (! $fs{$filename})) || 1225 (($dogs || $samples) && (! $fm{$filename}))) { 1226 system("gunzip -c $filename | pfbtops > foo"); 1227 ($x, $gs) = &process_font("foo"); 1228 system("rm foo"); 1229 if ($dox) { 1230 %fs = &add_font_to_aarray($filename, $x, %fs); 1231 } 1232 if ($dogs || $samples) { 1233 %fm = &add_font_to_aarray($filename, $gs, %fm); 1234 } 1235 } else { 1236 $numpffonts = $numpffonts + 1; 1237 $numskipped = $numskipped + 1; 1238 &print_progress(); 1239 } 1240 if ($samples) { 1241 ($height) = &font_sample($filename, $fm{$filename}, $height); 1242 } 1243} 1244 1245# Process Ghostscript fonts 1246if ($dogs || $samples) { 1247 foreach $filename (do_glob("gsf")) { 1248 if (! $fm{$filename}) { 1249 ($x, $gs) = &process_font($filename); 1250 %fm = &add_font_to_aarray($filename, $gs, %fm); 1251 } else { 1252 $numgsfonts = $numgsfonts + 1; 1253 $numskipped = $numskipped + 1; 1254 &print_progress(); 1255 } 1256 if ($samples) { 1257 ($height) = &font_sample($filename, $fm{$filename}, $height); 1258 } 1259 } 1260} 1261 1262if ($dox) { 1263 &write_fonts_scale(%fs); 1264 (system("mkfontdir") == 0) or system("echo 0 > fonts.dir"); 1265 system("chmod 0755 fonts.dir") && log_msg("Couldn't chmod \"fonts.dir\" ... continuing on anyway\n"); 1266} 1267if ($dogs) { 1268 &write_fontmap(%fm); 1269} 1270 1271# Finish up the all font sample file 1272if ($samples) { 1273 log_only_msg("Finished font sample files\n"); 1274 if ($height < 700) { 1275 print ALLSAMPLE "showpage\n"; 1276 close(ALLSAMPLE); 1277 system("chmod 0755 $allsample") && log_msg("Couldn't chmod \"$allsample\" ... continuing on anyway\n"); 1278 } 1279} 1280 1281# Report 1282if (! $silent) { 1283 $totalfonts = $numpffonts + $numgsfonts + $badfonts; 1284 1285 # List statistics 1286 print "-------------------------------------------------------\n"; 1287 if ($totalfonts == 0) { 1288 print "No fonts were found in this directory\n"; 1289 } elsif ($totalfonts == 1) { 1290 print "1 font was found in this directory\n"; 1291 } else { 1292 print "$totalfonts fonts found\n"; 1293 } 1294 if ($numpffonts == 1) { 1295 print "1 was a PostScript font\n"; 1296 } elsif ($numpffonts > 1) { 1297 print "$numpffonts were standard PostScript fonts\n"; 1298 } 1299 if ($numgsfonts == 1) { 1300 print "1 was a Ghostscript font\n"; 1301 } elsif ($numgsfonts > 1) { 1302 print "$numgsfonts were Ghostscript fonts\n"; 1303 } 1304 if ($numskipped == 1) { 1305 print "\n"; 1306 print "I skipped one of these fonts because it already had\n"; 1307 print "an overriding entry in both fonts.scale and/or Fontmap\n"; 1308 print "(X Windows font or Ghostscript font respectively).\n"; 1309 } elsif ($numskipped > 1) { 1310 print "\n"; 1311 print "I skipped $numskipped of these fonts because they already\n"; 1312 print "had overriding entries in both fonts.scale and/or Fontmap\n"; 1313 print "(X Windows fonts or Ghostscript fonts respectively).\n"; 1314 } 1315 1316 # Print error messages 1317 $wereerrors = 0; 1318 if ($badfonts > 0) { 1319 $wereerrors = 1; 1320 print "-------------------------------------------------------\n"; 1321 if ($badfonts == 1) { 1322 print "I couldn't extract a font name for 1 font in\n"; 1323 } else { 1324 print "I couldn't extract font names for $ badfonts fonts in\n"; 1325 } 1326 print "this directory. This means the font file had a non-standard\n"; 1327 print "format which this program doesn't know about or cannot do\n"; 1328 print "anything with. Check the README file to find out more.\n"; 1329 } 1330 if ($dox) { 1331 if ($nofoundry > 0) { 1332 $wereerrors = 1; 1333 print "-------------------------------------------------------\n"; 1334 print "For $nofoundry of these I couldn't figure out which foundry\n"; 1335 print "the font is from. Thus, these fonts will appear under the\n"; 1336 print "foundry unknown, i.e. X font name -unknown-*.\n"; 1337 print "Please consult the README file to see what this means.\n"; 1338 } 1339 1340 if ($numxremoved > 0) { 1341 $wereerrors = 1; 1342 print "-------------------------------------------------------\n"; 1343 if ($numxremoved == 1) { 1344 print "While reading the existing fonts.scale file I saw 1 entry\n"; 1345 } else { 1346 print "While reading the existing fonts.scale file I saw $numxremoved entries\n"; 1347 } 1348 print "which mentioned a filename which now does not exist. Most likely\n"; 1349 print "you removed or renamed the file. I ignored these entries.\n"; 1350 } 1351 if ($numxbarf > 0) { 1352 $wereerrors = 1; 1353 print "-------------------------------------------------------\n"; 1354 if ($numxbarf == 1) { 1355 print "There was a line in fonts.scale I couldn't understand.\n"; 1356 } else { 1357 print "There were $numxbarf lines in fonts.scale which I couldn't understand\n"; 1358 } 1359 print "These were ignored.\n"; 1360 } 1361 } 1362 if ($dogs) { 1363 if ($numgsremoved > 0) { 1364 $wereerrors = 1; 1365 print "-------------------------------------------------------\n"; 1366 if ($numgsremoved == 1) { 1367 print "While reading the existing Fontmap file I saw 1 entry\n"; 1368 } else { 1369 print "While reading the existing Fontmap file I saw $numgsremoved entries\n"; 1370 } 1371 print "which mentioned a filename which now does not exist. Most likely\n"; 1372 print "you removed or renamed the file. I ignored these entries.\n"; 1373 } 1374 if ($numgsbarf > 0) { 1375 $wereerrors = 1; 1376 print "-------------------------------------------------------\n"; 1377 if ($numgsbarf == 1) { 1378 print "There was a line in Fontmap I couldn't understand.\n"; 1379 } else { 1380 print "There were $numgsbarf lines in Fontmap which I couldn't understand\n"; 1381 } 1382 print "These were ignored.\n"; 1383 } 1384 } 1385 1386 if ($wereerrors) { 1387 print "-------------------------------------------------------\n"; 1388 print "\n"; 1389 print "A log of errors is located in the file \"type1inst.log\"\n"; 1390 print "\n"; 1391 } 1392} 1393