doc/afmmetrics.pl

   1 #!/usr/bin/perl
   2 ## --------------------------------------------------------------------------
   3 ##
   4 ##   Copyright 1996-2009 The NASM Authors - All Rights Reserved
   5 ##   See the file AUTHORS included with the NASM distribution for
   6 ##   the specific copyright holders.
   7 ##
   8 ##   Redistribution and use in source and binary forms, with or without
   9 ##   modification, are permitted provided that the following
  10 ##   conditions are met:
  11 ##
  12 ##   * Redistributions of source code must retain the above copyright
  13 ##     notice, this list of conditions and the following disclaimer.
  14 ##   * Redistributions in binary form must reproduce the above
  15 ##     copyright notice, this list of conditions and the following
  16 ##     disclaimer in the documentation and/or other materials provided
  17 ##     with the distribution.
  18 ##
  19 ##     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  20 ##     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  21 ##     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  22 ##     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  23 ##     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  24 ##     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  25 ##     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  26 ##     NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27 ##     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28 ##     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  29 ##     CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  30 ##     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  31 ##     EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32 ##
  33 ## --------------------------------------------------------------------------
  34
  35 #
  36 # Parse AFM metric files
  37 #
  38
  39 @widths = ((undef)x256);
  40
  41 while ( $line = <STDIN> ) {
  42     if ( $line =~ /^\s*FontName\s+(.*)\s*$/ ) {
  43         $fontname = $1;
  44     } elsif ( $line =~ /^\s*StartCharMetrics\b/ ) {
  45         $charmetrics = 1;
  46     } elsif ( $line =~ /^\s*EndCharMetrics\b/ ) {
  47         $charmetrics = 0;
  48     } elsif ( $line =~ /^\s*StartKernPairs\b/ ) {
  49         $kerndata = 1;
  50     } elsif ( $line =~ /^\s*EndKernPairs\b/ ) {
  51         $kerndata = 0;
  52     } elsif ( $charmetrics ) {
  53         @data = split(/\s*;\s*/, $line);
  54         undef $charcode, $width, $name;
  55         foreach $d ( @data ) {
  56             @dd = split(/\s+/, $d);
  57             if ( $dd[0] eq 'C' ) {
  58                 $charcode = $dd[1];
  59             } elsif ( $dd[0] eq 'WX' ) {
  60                 $width = $dd[1];
  61             } elsif ( $dd[0] eq 'W' ) {
  62                 $width = $dd[2];
  63             } elsif ( $dd[0] eq 'N' ) {
  64                 $name = $dd[1];
  65             }
  66         }
  67         if ( defined($name) && defined($width) ) {
  68             $charwidth{$name} = $width;
  69         }
  70     } elsif ( $kerndata ) {
  71         @data = split(/\s+/, $line);
  72         if ( $data[0] eq 'KPX' ) {
  73             if ( defined($charcodes{$data[1]}) &&
  74                  defined($charcodes{$data[2]}) &&
  75                  $data[3] != 0 ) {
  76                 $kernpairs{chr($charcodes{$data[1]}).
  77                            chr($charcodes{$data[2]})} = $data[3];
  78             }
  79         }
  80     }
  81 }
  82
  83 sub qstr($) {
  84     my($s) = @_;
  85     my($o,$c,$i);
  86     $o = '"';
  87     for ( $i = 0 ; $i < length($s) ; $i++ ) {
  88         $c = substr($s,$i,1);
  89         if ( $c lt ' ' || $c gt '~' ) {
  90             $o .= sprintf("\\%03o", ord($c));
  91         } elsif ( $c eq "\'" || $c eq "\"" || $c eq "\\" ) {
  92             $o .= "\\".$c;
  93         } else {
  94             $o .= $c;
  95         }
  96     }
  97     return $o.'"';
  98 }
  99
 100 $psfont = $fontname;
 101 $psfont =~ s/[^A-Za-z0-9]/_/g;
 102
 103 print "%PS_${psfont} = (\n";
 104 print "  name => \'$fontname\',\n";
 105 print "  widths => {";
 106 $lw = 100000;
 107 foreach $cc ( keys(%charwidth) ) {
 108     $ss = sprintf('%s => %d, ', qstr($cc), $charwidth{$cc});
 109     $lw += length($ss);
 110     if ( $lw > 72 ) {
 111         print "\n    ";
 112         $lw = 4 + length($ss);
 113     }
 114     print $ss;
 115 }
 116 print "\n  }\n";
 117 #print "  kern => {";
 118 #$lw = 100000;
 119 #foreach $kp ( keys(%kernpairs) ) {
 120 #    $ss = sprintf('%s => %d, ', qstr($kp), $kernpairs{$kp});
 121 #    $lw += length($ss);
 122 #    if ( $lw > 72 ) {
 123 #       print "\n    ";
 124 #       $lw = 4 + length($ss);
 125 #    }
 126 #    print $ss;
 127 #}
 128 #print "  }\n";
 129 print ");\n";
 130 print "1;\n";