view nasmbuild/nasm-2.13rc9/doc/afmmetrics.pl @ 10554:587a0a262d22

<moonythedwarf> ` cd nasmbuild; tar -xf nasm.tar.gz
author HackBot
date Thu, 30 Mar 2017 20:58:41 +0000
parents
children
line wrap: on
line source

#!/usr/bin/perl
## --------------------------------------------------------------------------
##
##   Copyright 1996-2016 The NASM Authors - All Rights Reserved
##   See the file AUTHORS included with the NASM distribution for
##   the specific copyright holders.
##
##   Redistribution and use in source and binary forms, with or without
##   modification, are permitted provided that the following
##   conditions are met:
##
##   * Redistributions of source code must retain the above copyright
##     notice, this list of conditions and the following disclaimer.
##   * Redistributions in binary form must reproduce the above
##     copyright notice, this list of conditions and the following
##     disclaimer in the documentation and/or other materials provided
##     with the distribution.
##
##     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
##     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
##     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
##     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
##     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
##     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
##     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
##     NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
##     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
##     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
##     CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
##     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
##     EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
##
## --------------------------------------------------------------------------

#
# Parse AFM metric files
#

@widths = ((undef)x256);

while ( $line = <STDIN> ) {
    if ( $line =~ /^\s*FontName\s+(.*)\s*$/ ) {
	$fontname = $1;
    } elsif ( $line =~ /^\s*StartCharMetrics\b/ ) {
	$charmetrics = 1;
    } elsif ( $line =~ /^\s*EndCharMetrics\b/ ) {
	$charmetrics = 0;
    } elsif ( $line =~ /^\s*StartKernPairs\b/ ) {
	$kerndata = 1;
    } elsif ( $line =~ /^\s*EndKernPairs\b/ ) {
	$kerndata = 0;
    } elsif ( $charmetrics ) {
	@data = split(/\s*;\s*/, $line);
	undef $charcode, $width, $name;
	foreach $d ( @data ) {
	    @dd = split(/\s+/, $d);
	    if ( $dd[0] eq 'C' ) {
		$charcode = $dd[1];
	    } elsif ( $dd[0] eq 'WX' ) {
		$width = $dd[1];
	    } elsif ( $dd[0] eq 'W' ) {
		$width = $dd[2];
	    } elsif ( $dd[0] eq 'N' ) {
		$name = $dd[1];
	    }
	}
	if ( defined($name) && defined($width) ) {
	    $charwidth{$name} = $width;
	}
    } elsif ( $kerndata ) {
	my($kpx, $a, $b, $adj) = split(/\s+/, $line);
	if ( $kpx eq 'KPX' ) {
	    $kernpairs{$a} = {} unless defined($kernpairs{$a});
	    $kernpairs{$a}{$b} = $adj;
	}
    }
}

sub qstr($) {
    my($s) = @_;
    my($o,$c,$i);
    $o = '"';
    for ( $i = 0 ; $i < length($s) ; $i++ ) {
	$c = substr($s,$i,1);
	if ( $c lt ' ' || $c gt '~' ) {
	    $o .= sprintf("\\%03o", ord($c));
	} elsif ( $c eq "\'" || $c eq "\"" || $c eq "\\" ) {
	    $o .= "\\".$c;
	} else {
	    $o .= $c;
	}
    }
    return $o.'"';
}

$psfont = $fontname;
$psfont =~ s/[^A-Za-z0-9]/_/g;

print "%PS_${psfont} = (\n";
print "  name => \'$fontname\',\n";
print "  widths => {";
$lw = 100000;
foreach $cc ( sort(keys(%charwidth)) ) {
    $ss = sprintf(' %s => %d,', qstr($cc), $charwidth{$cc});
    $lw += length($ss);
    if ( $lw > 72 ) {
	print "\n   ";
	$lw = 4 + length($ss);
    }
    print $ss;
}
print "\n  },\n";
print "  kern => {";
$lt = "\n";
foreach $ka ( sort(keys(%kernpairs)) ) {
    printf '%s    %s => {', $lt, qstr($ka);
    $lw = 100000;
    foreach $kb ( sort(keys(%{$kernpairs{$ka}})) ) {
	$ss = sprintf(' %s => %d,', qstr($kb), $kernpairs{$ka}{$kb});
	$lw += length($ss);
	if ( $lw > 72 ) {
	    print "\n     ";
	    $lw = 6 + length($ss);
	}
	print $ss;
    }
    print "\n    }";
    $lt = ",\n";
}
print "\n  }\n";
print ");\n";
print "1;\n";