#!/usr/bin/perl

use Font::TTF::Font;
use Getopt::Std;
use Pod::Usage;

our $CHAIN_CALL;
our ($if, $of, %opts);

unless ($CHAIN_CALL)
{
    getopts('f:hl:n:qs:t:', \%opts);

    unless (defined $ARGV[1] || defined $opts{h})
    {
        pod2usage(1);
        exit;
    }

    if ($opts{h})
    {
        pod2usage( -verbose => 2, -noperldoc => 1);
        exit;
    }

    $if = Font::TTF::Font->open($ARGV[0]) || die "Can't read font $ARGV[0]";
}

$of = ttfname($if, %opts);

unless ($CHAIN_CALL)
{ $of->out($ARGV[1]) || die "Can't write to font file $ARGV[1]. Do you have it installed?"; }

sub ttfname
{
    my ($font, %opts) = @_;
    my ($name) = $font->{'name'}->read;
    my (@cover);

    if (defined $opts{'s'})
    {
        my ($fh) = IO::File->new("< $opts{'s'}") || die "Can't open $opts{'s'}";
        local ($/);
        $opts{'n'} = join('', <$fh>);
        $fh->close();
    }

    if (defined $opts{'l'})
    {
        my ($cmap) = $font->{'cmap'}->read;
        @cover = map {[$_->{'Platform'}, $_->{'Encoding'}]} @{$cmap->{'Tables'}};
    }

    if (defined $opts{'t'})
    {
        $name->set_name($opts{'t'}, $opts{'n'}, $opts{'l'}, @cover);
    }
    else
    {
        my ($subfamily) = $name->find_name(2);
        my ($family, $full, $post, $unique, @time);

        if ($opts{'f'})
        {
            $full = $opts{'f'};
            $family = $opts{'f'};
            unless (lc($subfamily) eq 'regular' || lc($subfamily) eq 'standard')
            {
                unless ($family =~ s/\s+$subfamily$//i)
                {
                    $family =~ s/\s+(.*?)$//oi;
                    $subfamily = $1;
                }
            }
        }
        else
        {
            $family = $opts{'n'};
            if (lc($subfamily) eq 'regular' || lc($subfamily) eq 'standard')
            { $full = $family; }
            else
            { $full = "$family $subfamily"; }
        }

        @time = gmtime($font->{'head'}->getdate);
        $unique = $name->find_name(8) . ":$full:$time[3]-$time[4]-$time[5]";
        $post = $family;
        $post =~ s/[\s\[\](){}<>\/%]//og;
        $post .= "-$subfamily";

# make sure post name set
        $name->{'strings'}[6][1][0]{0} = $post;
        $name->{'strings'}[6][3][1]{1033} = $post;

# now update all the interesting name fields
        $name->set_name(1, $family, $opts{'l'}, @cover);
        $name->set_name(2, $subfamily, $opts{'l'}, @cover);
        $name->set_name(3, $unique, $opts{'l'}, @cover);
        $name->set_name(4, $full, $opts{'l'}, @cover);
        $name->set_name(6, $post, $opts{'l'}, @cover);
        $name->set_name(16, $family, $opts{'l'}, @cover);
        $name->set_name(17, $subfamily, $opts{'l'}, @cover);
        $name->set_name(18, $full, $opts{'l'}, @cover);
    }
    return $font;
}

__END__

=head1 TITLE

ttfname - renames font files

=head1 SYNOPSIS

  ttfname [-f "full_name"] -n "name" [-t num] [-q] infile.ttf outfile.ttf
Renames the TTF with the given name and outputs the newly named font to
out.ttf.

=head1 OPTIONS

  -f "name"   specifies new full name (optional) as opposed to the
              default calculated form.
  -l lang     language number to use (default all langs)
              if specified name entries will be added for all platforms and
                  encodings covered by the cmap if not already there
  -n "name"   specifies new font family name (not optional)
  -q          disable signon message
  -s filename overrides -n and gets string from file. Useful for -t
  -t num      overrides the normal naming areas to change another
              string -f becomes inactive.
