doc/afmmetrics.pl

   1 #!/usr/bin/perl
   2 ## --------------------------------------------------------------------------
   3 ##
   4 ##   Copyright 1996-2016 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         my($kpx, $a, $b, $adj) = split(/\s+/, $line);
  72         if ( $kpx eq 'KPX' ) {
  73             $kernpairs{$a} = {} unless defined($kernpairs{$a});
  74             $kernpairs{$a}{$b} = $adj;
  75         }
  76     }
  77 }
  78
  79 sub qstr($) {
  80     my($s) = @_;
  81     my($o,$c,$i);
  82     $o = '"';
  83     for ( $i = 0 ; $i < length($s) ; $i++ ) {
  84         $c = substr($s,$i,1);
  85         if ( $c lt ' ' || $c gt '~' ) {
  86             $o .= sprintf("\\%03o", ord($c));
  87         } elsif ( $c eq "\'" || $c eq "\"" || $c eq "\\" ) {
  88             $o .= "\\".$c;
  89         } else {
  90             $o .= $c;
  91         }
  92     }
  93     return $o.'"';
  94 }
  95
  96 $psfont = $fontname;
  97 $psfont =~ s/[^A-Za-z0-9]/_/g;
  98
  99 print "%PS_${psfont} = (\n";
 100 print "  name => \'$fontname\',\n";
 101 print "  widths => {";
 102 $lw = 100000;
 103 foreach $cc ( sort(keys(%charwidth)) ) {
 104     $ss = sprintf(' %s => %d,', qstr($cc), $charwidth{$cc});
 105     $lw += length($ss);
 106     if ( $lw > 72 ) {
 107         print "\n   ";
 108         $lw = 4 + length($ss);
 109     }
 110     print $ss;
 111 }
 112 print "\n  },\n";
 113 print "  kern => {";
 114 $lt = "\n";
 115 foreach $ka ( sort(keys(%kernpairs)) ) {
 116     printf '%s    %s => {', $lt, qstr($ka);
 117     $lw = 100000;
 118     foreach $kb ( sort(keys(%{$kernpairs{$ka}})) ) {
 119         $ss = sprintf(' %s => %d,', qstr($kb), $kernpairs{$ka}{$kb});
 120         $lw += length($ss);
 121         if ( $lw > 72 ) {
 122             print "\n     ";
 123             $lw = 6 + length($ss);
 124         }
 125         print $ss;
 126     }
 127     print "\n    }";
 128     $lt = ",\n";
 129 }
 130 print "\n  }\n";
 131 print ");\n";
 132 print "1;\n";