source: git/lib/afm2txf.pl @ e9bd0467

#!/usr/bin/perl -w

# afm2txf.pl 0.2
#
# Generates .txf font textures from Type 1 fonts
# Requirements: Ghostscript, ImageMagick
#
# Usage:
#       afm2txf.pl [-o OUTPUT.txf] whatever.afm
#
# Changelog:
#       0.2 (06/28/2002): Generate fonts with proper padding
#       0.1 (06/28/2002): Initial version
#
# Copyright (C) 2002 Andrew James Ross
# Copyright (C) 2010,2011 Olly Betts
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.

use strict;

my $output;
if (scalar @ARGV >= 1) {
    my $arg = $ARGV[0];
    if ($arg =~ s/^-o//) {
        shift;
        if ($arg eq '') {
            if (scalar @ARGV == 0) {
                die "-o needs an argument\n";
            }
            $output = shift;
        } else {
            $output = $arg;
        }
    }
}

my $METRICS = shift or die; # AFM file

# Texture size
my $TEXSIZ = 256;

# Padding around each character, for mipmap separation
my $PADDING = 4;

# Antialiasing multiplier.  Should be 16 for production work.  As low
# as 4 works well for testing.
my $DOWNSAMPLE = 16;

# The printable ISO-8859-1 characters (and space and hard space) and their
# postscript glyph names.  We use names because not all postscript
# fonts are encoded using ASCII.  AFM metrics generated by ttf2afm, in
# fact, don't have any numerical character IDs at all.  In principle,
# this mechanism will work for any 8 bit font encoding, you just have
# to do the legwork of figuring out the name to ID mapping.
my %REVCHARS = (32=>'space', 33=>'exclam', 34=>'quotedbl',
             35=>'numbersign', 36=>'dollar', 37=>'percent',
             38=>'ampersand', 39=>'quotesingle', 40=>'parenleft',
             41=>'parenright', 42=>'asterisk', 43=>'plus',
             44=>'comma', 45=>'hyphen', 46=>'period', 47=>'slash',
             48=>'zero', 49=>'one', 50=>'two', 51=>'three',
             52=>'four', 53=>'five', 54=>'six', 55=>'seven',
             56=>'eight', 57=>'nine', 58=>'colon', 59=>'semicolon',
             60=>'less', 61=>'equal', 62=>'greater', 63=>'question',
             64=>'at', 65=>'A', 66=>'B', 67=>'C', 68=>'D', 69=>'E',
             70=>'F', 71=>'G', 72=>'H', 73=>'I', 74=>'J', 75=>'K',
             76=>'L', 77=>'M', 78=>'N', 79=>'O', 80=>'P', 81=>'Q',
             82=>'R', 83=>'S', 84=>'T', 85=>'U', 86=>'V', 87=>'W',
             88=>'X', 89=>'Y', 90=>'Z', 91=>'bracketleft',
             92=>'backslash', 93=>'bracketright', 94=>'asciicircum',
             95=>'underscore', 96=>'quoteleft', 97=>'a', 98=>'b', 99=>'c',
             100=>'d', 101=>'e', 102=>'f', 103=>'g', 104=>'h',
             105=>'i', 106=>'j', 107=>'k', 108=>'l', 109=>'m',
             110=>'n', 111=>'o', 112=>'p', 113=>'q', 114=>'r',
             115=>'s', 116=>'t', 117=>'u', 118=>'v', 119=>'w',
             120=>'x', 121=>'y', 122=>'z', 123=>'braceleft',
             124=>'bar', 125=>'braceright', 126=>'asciitilde',
             160=>'space', 161=>'exclamdown', 162=>'cent', 163=>'sterling',
             164=>'currency', 165=>'yen', 166=>'brokenbar', 167=>'section',
             168=>'dieresis', 169=>'copyright', 170=>'ordfeminine', 171=>'guillemotleft',
             172=>'logicalnot', 173=>'hyphen', 174=>'registered', 175=>'macron',
             176=>'degree', 177=>'plusminus', 178=>'twosuperior', 179=>'threesuperior',
             180=>'acute', 181=>'mu', 182=>'paragraph', 183=>'bullet',
             184=>'cedilla', 185=>'onesuperior', 186=>'ordmasculine', 187=>'guillemotright',
             188=>'onequarter', 189=>'onehalf', 190=>'threequarters', 191=>'questiondown',
             192=>'Agrave', 193=>'Aacute', 194=>'Acircumflex', 195=>'Atilde',
             196=>'Adieresis', 197=>'Aring', 198=>'AE', 199=>'Ccedilla',
             200=>'Egrave', 201=>'Eacute', 202=>'Ecircumflex', 203=>'Edieresis',
             204=>'Igrave', 205=>'Iacute', 206=>'Icircumflex', 207=>'Idieresis',
             208=>'Eth', 209=>'Ntilde', 210=>'Ograve', 211=>'Oacute',
             212=>'Ocircumflex', 213=>'Otilde', 214=>'Odieresis', 215=>'multiply',
             216=>'Oslash', 217=>'Ugrave', 218=>'Uacute', 219=>'Ucircumflex',
             220=>'Udieresis', 221=>'Yacute', 222=>'Thorn', 223=>'germandbls',
             224=>'agrave', 225=>'aacute', 226=>'acircumflex', 227=>'atilde',
             228=>'adieresis', 229=>'aring', 230=>'ae', 231=>'ccedilla',
             232=>'egrave', 233=>'eacute', 234=>'ecircumflex', 235=>'edieresis',
             236=>'igrave', 237=>'iacute', 238=>'icircumflex', 239=>'idieresis',
             240=>'eth', 241=>'ntilde', 242=>'ograve', 243=>'oacute',
             244=>'ocircumflex', 245=>'otilde', 246=>'odieresis', 247=>'divide',
             248=>'oslash', 249=>'ugrave', 250=>'uacute', 251=>'ucircumflex',
             252=>'udieresis', 253=>'yacute', 254=>'thorn', 255=>'ydieresis'
             );

my %CHARS;
while (my ($k, $v) = each %REVCHARS) {
    $CHARS{$v} = $k unless exists $CHARS{$v};
}

my %metrics = ();
my %positions = ();

#
# Parse the font metrics.  This is a 5 element array.  All numbers are
# expressed as a fraction of the line spacing.
# 0:    nominal width (distance to the next character)
# 1, 2: Coordinates of the lower left corner of the bounding box,
#       relative to the nominal position.
# 3, 4: Size of the bounding box
#
print STDERR "Reading font metrics...\n";
my $FONT;
open METRICS, '<', $METRICS or die $!;
my $m;
while (defined($m = <METRICS>)) {
    if ($m =~ /^FontName (\S*)/) { $FONT = $1; next; }
    next unless $m =~ /^C /;
    chomp $m;

    die "No name: $m" if $m !~ /N\s+([^\s]+)\s+;/;
    my $name = $1;

    die "No box: $m"
        if $m !~ /B\s+([-0-9]+)\s+([-0-9]+)\s+([-0-9]+)\s+([-0-9]+)\s+;/;
    my ($left, $bottom, $right, $top) = ($1/1000, $2/1000, $3/1000, $4/1000);

    die "No width: $m" if $m !~ /WX\s+([-0-9]+)/;
    my $nomwid = $1/1000; # nominal, not physical width!

    # The coordinates of the corner relative to the character
    # "position"
    my ($x, $y) = (-$left, -$bottom);
    my ($w, $h) = ($right-$left, $top-$bottom);

    $metrics{$name} = [$nomwid, $x, $y, $w, $h];
}
close METRICS;

die "No FontName found in metrics" if not defined $FONT;

# Sanitise $FONT.
$FONT =~ s!/!_!g;

#
# Find the height of the tallest character, and print some warnings
#
my $maxhgt = 0;
foreach my $c (keys %CHARS) {
    if(!defined $metrics{$c}) {
        print STDERR "% WARNING: no metrics for char $c.  Skipping.\n";
        next;
    }
    if($metrics{$c}->[4] > $maxhgt) { $maxhgt = $metrics{$c}->[4]; }
}
if($maxhgt == 0) {
    print STDERR "No usable characters found.  Bailing out.\n";
    exit 1;
}

#
# Do the layout.  Keep increasing the row count until the characters
# just fit.  This isn't terribly elegant, but it's simple.
#
print STDERR "Laying out";
my $rows = 1;
my $PS;
my $LINEHGT;
while(!defined ($PS = genPostscript($rows))) { $rows++; }
print STDERR " ($rows rows)\n";

#
# Call ghostscript to render
#
print STDERR "Rendering Postscript...\n";
my $res = $TEXSIZ * $DOWNSAMPLE;
my $pid = open PS, "|gs -r$res -g${res}x${res} -sDEVICE=ppm -sOutputFile=\Q$FONT\E.ppm > /dev/null";
die "Couldn't spawn ghostscript interpreter" if !defined $pid;
foreach (@$PS) {
    print PS "$_\n";
}
close PS;
waitpid($pid, 0);

#
# Downsample with ImageMagick
#
print STDERR "Antialiasing image...\n";
system("mogrify -geometry ${TEXSIZ}x${TEXSIZ} \Q$FONT\E.ppm") == 0
    or die "Couldn't rescale $FONT.ppm";

#
# Generate the .txf file
#
print STDERR "Generating textured font file...\n";

# Prune undefined glyphs
foreach my $c (keys %metrics) {
    delete $metrics{$c} if !defined $CHARS{$c};
}

sub round { sprintf "%.0f", $_[0] }
$output = "$FONT.txf" unless defined $output;
open TXF, '>', $output or die;
print TXF pack "V", 0x667874ff;
print TXF pack "V", 0x12345678;
print TXF pack "V", 0;
print TXF pack "V", $TEXSIZ;
print TXF pack "V", $TEXSIZ;
print TXF pack "V", round($TEXSIZ * $LINEHGT);
print TXF pack "V", 0;
my @chars = sort keys %REVCHARS;
print TXF pack "V", scalar @chars;
foreach my $c (@chars) {
    my $name = $REVCHARS{$c};
    my $m = $metrics{$name};
    my $p = $positions{$name};
    my $step = round($m->[0] * $LINEHGT * $TEXSIZ);

    # Pad the bounding box, to handle areas that outside.  This can
    # happen due to thick lines in the font path, or be an artifact of
    # the downsampling.
    my ($w, $h, $xoff, $yoff, $x, $y);
    if ($name eq 'space') {
        $w = $h = $xoff = $yoff = $x = $y = 0;
    } else {
        $w = round($m->[3] * $LINEHGT * $TEXSIZ + 2*$PADDING);
        $h = round($m->[4] * $LINEHGT * $TEXSIZ + 2*$PADDING);
        $xoff = -round($m->[1] * $LINEHGT * $TEXSIZ) - $PADDING;
        $yoff = -round($m->[2] * $LINEHGT * $TEXSIZ) - $PADDING;
        $x = round($p->[0] * $TEXSIZ - $PADDING);
        $y = round($p->[1] * $TEXSIZ - $PADDING);
    }
    print TXF pack "v", $c;
    print TXF pack "C", $w;
    print TXF pack "C", $h;
    print TXF pack "c", $xoff;
    print TXF pack "c", $yoff;
    print TXF pack "C", $step;
    print TXF pack "C", 0;
    print TXF pack "v", $x;
    print TXF pack "v", $y;
}

# Read in the .ppm file, dump the duplicate color values (ghostscript
# won't generate pgm's) and write to the end of the .txf.  Remember to
# swap the order of the rows; OpenGL textures are bottom-up.
open PPM, "$FONT.ppm" or die;
my $pixel;
foreach my $r (1 .. $TEXSIZ) {
    seek PPM, -3*$r*$TEXSIZ, 2 or die;
    foreach (1 .. $TEXSIZ) {
        read PPM, $pixel, 3 or die;
        print TXF substr($pixel, 0, 1);
    }
}
close PPM;
close TXF;

# Clean up
unlink("$FONT.ppm");

########################################################################
########################################################################
########################################################################

# Put the digits first to help ensure they are all on the same line in the
# texture and will exactly align vertically when rendered - a slight
# discrepancy here is particularly visible in the colour key legends and
# compass bearing.
sub render_order {
    my $a = $CHARS{$a};
    my $b = $CHARS{$b};
    my $a_dig = chr($a) =~ /\d/;
    my $b_dig = chr($b) =~ /\d/;
    if ($a_dig ^ $b_dig) {
        return $a_dig ? -1 : 1;
    }
    return $a <=> $b;
}

sub genPostscript {
    my $rows = shift;
    my $rowhgt = 1/$rows;

    my @PS = ();

    # The canonical "point size" number, in texture space
    $LINEHGT = ($rowhgt - 2*$PADDING/$TEXSIZ) / $maxhgt;

    # Get to where we want.  Draw the whole thing in a 1 inch square at
    # the bottom left of the "page".
    push @PS, "72 72 scale";

    # Fill the square with black
    push @PS, "0 setgray";
    push @PS, "-1 -1 moveto";
    push @PS, "-1 1 lineto 1 1 lineto 1 -1 lineto";
    push @PS, "closepath";
    push @PS, "fill";

    # Draw in white
    push @PS, "1 setgray";

    # Generate our PUSH @PS, font
    push @PS, "/$FONT findfont $LINEHGT scalefont setfont";

    my $x = $PADDING/$TEXSIZ;
    my $y = 1 - $rowhgt + $PADDING/$TEXSIZ;
    my @chars = sort render_order (keys %CHARS);
    foreach my $c (@chars) {
        next if $c eq 'space';
        my $m = $metrics{$c};
        next if !defined $m;

        # No space?
        my $w = $m->[3]*$LINEHGT;
        if($x + $w + $PADDING/$TEXSIZ > 1) {
            $x = $PADDING/$TEXSIZ;
            $y -= $rowhgt;
            return undef if $y < 0;
        }

        # Record where in the texture the box ended up
        $positions{$c} = [$x, $y];

        my $vx = $x + $m->[1]*$LINEHGT;
        my $vy = $y + $m->[2]*$LINEHGT;

        push @PS, "$vx $vy moveto";
        push @PS, "/$c glyphshow";

        # Next box...
        $x += $w + 2*$PADDING/$TEXSIZ;
    }

    push @PS, "showpage";

    return \@PS;
}