#!/usr/bin/perl

=pod

=head1 NAME

font2afm - create font metrics (in F<afm> format) for (almost) any font file 

=head1 SYNOPSIS

font2afm [options] I<font> ...

font2afm [options] @I<filelist>

=head1 DESCRIPTION

B<font2afm> generates font metrics (in Adobe's F<afm> format) for Type1,
TrueType and OpenType fonts.

B<font2afm> is just a wrapper script around several utilities (B<cfftot1>, 
B<pf2afm>, B<ttf2afm>, B<pfm2kpx> and B<ot2kpx>) that do the real work. 
All these utilities need to be available on your system.

=head1 OPTIONS

=over 4

=item B<-f>

Force overwriting of existing F<afm> files.

=back

=head1 FILES

=over 4

=item I<font>

This can be any Type1 (in either F<pfa> or F<pfb> format), TrueType or 
OpenType (both PostScript- and TrueType-flavored) font.

=item I<filelist>

This should contain a newline-separated list of font filenames.

=back

=head1 SEE ALSO

F<pf2afm> (part of I<GhostScript>), F<ttf2afm> (part of I<pdfTeX>),
F<afm2afm>, F<autoinst>, F<cmap2enc>, F<ot2kpx>, F<pfm2kpx>, F<cfftot1> 
(part of Eddie Kohler's I<LCDF TypeTools>).

=head1 AUTHOR

Marc Penninga <marc@penninga.info>

=head1 HISTORY

=over 12

=item I<2005-04-15>

First version

=item I<2005-04-29>

Improved the documentation

=item I<2005-05-23>

Bugfix.

=item I<2005-07-29>

Added support for PostScript-flavored (F<otf>) OpenType fonts.

=item I<2005-08-08>

Bugfix.

=item I<2010-07-19>

Another small bugfix.

=back

=cut

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

use Getopt::Std;
use integer;
use warnings; no warnings qw(uninitialized);

getopts "f", \%options;

$0 =~ s!.*/!!;
die "Usage: $0 fontfile ...\n   or: $0 \@fontlist\n" if @ARGV < 1;

if ($ARGV[0] =~ m!^@(.+)!) {
    open LIST, "<$1" or die "Error: can't open `$1' - $!\n";
    chop(@ARGV = <LIST>);
    map {m!\S+! and $_ = $&} @ARGV;
}

for (@ARGV) {
    if (m!(.+)\.(pfb|pfa|ttf|otf)!) {
        ($base, $ext) = ($1, $2);
    }
    else {
        warn "Warning: unrecognised font file `$_' skipped\n";
        next;
    }
    
    next if -e "${base}.afm" and !$options{f};
    
    if ($ext =~ m!pf(?:a|b)!) {
        if (-e "${base}.pfm") {
            system "pfm2kpx '${base}.pfm'";
        }
        else {
            system "pf2afm '$_'";
        }
        if (-e "${base}.otf") {
            system "ot2kpx '${base}.otf' >'${base}.kpx'";
            open AFM, "<${base}.afm" or 
                    die "Error: can't open `${base}.afm' - $!\n";
            open KPX, "<${base}.kpx" or 
                    warn("Warning: can't open `${base}.kpx' - $!\n"), next;
            {
                local $/;
                $afm = <AFM>;
                $kpx = <KPX>;
            }
	    close AFM;
            open AFM, ">${base}.afm" or 
                    die "Error: can't create `${base}.afm' - $!\n";
		    
	    if ($afm =~ m!^(.+?)(?:StartKernData.+EndKernData\n)?
	    	    	    EndFontMetrics!sx) 
	    {
		print AFM "$1${kpx}EndFontMetrics\n";
	    }
	    else {
	    	warn "Warning: `${base}.afm' seems rotten - please check\n";
	    	print AFM $afm;
	    }
	    unlink "${base}.kpx";
        }
    }
    elsif ($ext =~ m!ttf!) {
        system "ttf2afm -o '${base}.afm' '$_'";
        system "ot2kpx '${base}.ttf' >'${base}.kpx'";
        open AFM, "<${base}.afm" or 
                die "Error: can't open `${base}.afm' - $!\n";
        open KPX, "<${base}.kpx" or 
                warn("Warning: can't open `${base}.kpx' - $!\n"), next;
        {
            local $/;
            $afm = <AFM>;
            $kpx = <KPX>;
        }
	close AFM;
        open AFM, ">${base}.afm" or 
                die "Error: can't create `${base}.afm' - $!\n";

	if ($afm =~ m!^(.+?)(?:StartKernData.+EndKernData\n)?
	    	    	EndFontMetrics!sx) 
	{
	    print AFM "$1${kpx}EndFontMetrics\n";
	}
	else {
	    warn "Warning: `${base}.afm' seems rotten - please check\n";
	    print AFM $afm;
	}
	unlink "${base}.kpx";
    }
    elsif ($ext =~ m!otf!) {
        system "cfftot1 -b -o ${base}.pfb $_";
        $_ = $base . ".pfb";
        redo;
    }
    else {
    	die "Error: you've just found a bug in `$0' - congratulations!\n";
    }
}

__END__
