home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Perl_Libs / site_perl / Font / make_metrics.pl < prev   
Perl Script  |  1996-02-05  |  2KB  |  77 lines
  1. #!/usr/local/bin/perl -w
  2.  
  3. # $Id: make_metrics.pl,v 1.2 1996/02/05 19:17:42 aas Exp $
  4. #
  5. # This program creates metrics modules for some fonts and place them
  6. # under the "Metrics" directory.
  7. #
  8. # Author: Gisle Aas
  9.  
  10. @FONTS = qw(Courier
  11.         Courier-Bold
  12.         Courier-Oblique
  13.         Courier-BoldOblique
  14.  
  15.         Helvetica
  16.         Helvetica-Bold
  17.         Helvetica-Oblique
  18.         Helvetica-BoldOblique
  19.   
  20.         Times-Roman
  21.         Times-Bold
  22.         Times-Italic
  23.         Times-BoldItalic
  24.        );
  25. @FONTS = @ARGV if @ARGV;
  26.       
  27. require Font::AFM;
  28.  
  29. $0 =~ s,.*/,,;
  30.  
  31. mkdir("Metrics", 0755);
  32.  
  33. for $font (@FONTS) {
  34.     eval {
  35.     $afm = new Font::AFM $font;
  36.     };
  37.     if ($@) {
  38.     print $@;
  39.     next;
  40.     }
  41.     @wx = $afm->latin1_wx_table;
  42.     
  43.     ($fontmod = $font) =~ s/-//g;
  44.  
  45.     open(FONTDEF, ">Metrics/$fontmod.pm") or die "Can't open $fontmod.pm: $!";
  46.     select FONTDEF;
  47.     print "# Font metrics for $font\n#\n";
  48.     print "# DO NOT EDIT!!!\n";
  49.     print "#\n";
  50.     print "# This file was auto-generated by $0 based on the AFM file for the font.\n";
  51.     print "#\n# ", $afm->Notice, "\n";
  52.     print "\n";
  53.     print "package Font::Metrics::$fontmod;\n";
  54.     
  55.     print "\n# Character width table (iso-8859-1)\n";
  56.     print "\@wx = (\n";
  57.     $i = 0;
  58.     for (@wx) {
  59.     printf " %.3g,", $_ / 1000;
  60.     unless (++$i % 8) {
  61.         print "\n";
  62.     }
  63.     }
  64.     print ");\n";
  65.  
  66.     $upos   = $afm->UnderlinePosition;
  67.     $uthick = $afm->UnderlineThickness;
  68.     if ($upos && $uthick) {
  69.     print "\n";
  70.     printf "\$UnderlinePosition  = %.3g;\n", $upos/1000;
  71.     printf "\$UnderlineThickness = %.3g;\n", $uthick/1000;
  72.     }
  73.  
  74.     print "\n1;\n";
  75. }
  76.  
  77.