doc/afmmetrics.pl

   1 #!/usr/bin/perl
   2 #
   3 # Parse AFM metric files
   4 #
   5
   6 @widths = ((undef)x256);
   7
   8 while ( $line = <STDIN> ) {
   9     if ( $line =~ /^\s*FontName\s+(.*)\s*$/ ) {
  10         $fontname = $1;
  11     } elsif ( $line =~ /^\s*StartCharMetrics\b/ ) {
  12         $charmetrics = 1;
  13     } elsif ( $line =~ /^\s*EndCharMetrics\b/ ) {
  14         $charmetrics = 0;
  15     } elsif ( $line =~ /^\s*StartKernPairs\b/ ) {
  16         $kerndata = 1;
  17     } elsif ( $line =~ /^\s*EndKernPairs\b/ ) {
  18         $kerndata = 0;
  19     } elsif ( $charmetrics ) {
  20         @data = split(/\s*;\s*/, $line);
  21         undef $charcode, $width, $name;
  22         foreach $d ( @data ) {
  23             @dd = split(/\s+/, $d);
  24             if ( $dd[0] eq 'C' ) {
  25                 $charcode = $dd[1];
  26             } elsif ( $dd[0] eq 'WX' ) {
  27                 $width = $dd[1];
  28             } elsif ( $dd[0] eq 'W' ) {
  29                 $width = $dd[2];
  30             } elsif ( $dd[0] eq 'N' ) {
  31                 $name = $dd[1];
  32             }
  33         }
  34         if ( defined($name) && defined($width) ) {
  35             $charwidth{$name} = $width;
  36         }
  37     } elsif ( $kerndata ) {
  38         @data = split(/\s+/, $line);
  39         if ( $data[0] eq 'KPX' ) {
  40             if ( defined($charcodes{$data[1]}) &&
  41                  defined($charcodes{$data[2]}) &&
  42                  $data[3] != 0 ) {
  43                 $kernpairs{chr($charcodes{$data[1]}).
  44                            chr($charcodes{$data[2]})} = $data[3];
  45             }
  46         }
  47     }
  48 }
  49
  50 sub qstr($) {
  51     my($s) = @_;
  52     my($o,$c,$i);
  53     $o = '"';
  54     for ( $i = 0 ; $i < length($s) ; $i++ ) {
  55         $c = substr($s,$i,1);
  56         if ( $c lt ' ' || $c gt '~' ) {
  57             $o .= sprintf("\\%03o", ord($c));
  58         } elsif ( $c eq "\'" || $c eq "\"" || $c eq "\\" ) {
  59             $o .= "\\".$c;
  60         } else {
  61             $o .= $c;
  62         }
  63     }
  64     return $o.'"';
  65 }
  66
  67 $psfont = $fontname;
  68 $psfont =~ s/[^A-Za-z0-9]/_/g;
  69
  70 print "%PS_${psfont} = (\n";
  71 print "  name => \'$fontname\',\n";
  72 print "  widths => {";
  73 $lw = 100000;
  74 foreach $cc ( keys(%charwidth) ) {
  75     $ss = sprintf('%s => %d, ', qstr($cc), $charwidth{$cc});
  76     $lw += length($ss);
  77     if ( $lw > 72 ) {
  78         print "\n    ";
  79         $lw = 4 + length($ss);
  80     }
  81     print $ss;
  82 }
  83 print "\n  }\n";
  84 #print "  kern => {";
  85 #$lw = 100000;
  86 #foreach $kp ( keys(%kernpairs) ) {
  87 #    $ss = sprintf('%s => %d, ', qstr($kp), $kernpairs{$kp});
  88 #    $lw += length($ss);
  89 #    if ( $lw > 72 ) {
  90 #       print "\n    ";
  91 #       $lw = 4 + length($ss);
  92 #    }
  93 #    print $ss;
  94 #}
  95 #print "  }\n";
  96 print ");\n";
  97 print "1;\n";