Merge branch 'nasm-2.03.x'
[nasm.git] / doc / afmmetrics.pl
blobb93d22e93795d411a9c6407e1673227ff9030579
1 #!/usr/bin/perl
3 # Parse AFM metric files
6 @widths = ((undef)x256);
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];
34 if ( defined($name) && defined($width) ) {
35 $charwidth{$name} = $width;
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];
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;
64 return $o.'"';
67 $psfont = $fontname;
68 $psfont =~ s/[^A-Za-z0-9]/_/g;
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);
81 print $ss;
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;
95 #print " }\n";
96 print ");\n";
97 print "1;\n";