#! /usr/bin/perl
use Font::TTF::Font;
use Pod::Usage;
use Getopt::Long;

use strict;

my (%opts, @xaps);
my $VERSION;
our $CHAIN_CALL;
our ($if, $of);

$VERSION = 0.33;    # MJPH      27-NOV-2009     -a now copies all tables
# $VERSION = 0.32;    # MJPH      28-JUL-2009     Add <scale> to scale glyphs
# $VERSION = 0.31;    # MJPH      16-APR-2009     Take last advance for sequential base glyphs
# $VERSION = 0.30;    # MJPH      13-MAR-2009     Get multifont scaling working
# $VERSION = 0.30;    # MJPH       6-JAN-2009     Fix font scale reference in offset glyphs
# $VERSION = 0.29;    # MJPH      18-JUL-2008     Fix references to empty glyphs
# $VERSION = 0.28;    # MJPH      27-JUN-2008     Add multifont support
# $VERSION = 0.27;    # MJPH      27-MAR-2008     Add -d128 to ignore non-existent glyphs
# $VERSION = 0.26;    # MJPH       2-FEB-2007     Fix crash when missing APs
# $VERSION = 0.25;    # MJPH      27-APR-2006     Reorganise docs for better man pages
# $VERSION = 0.24;    # MJPH      12-OCT-2005     Add more string names
# $VERSION = 0.23;    # MJPH      11-AUG-2005     Fix handling empty glyphs (no outline)
#                                                 add component generation for joined glyph chains (adv each)
# $VERSION = 0.22;    # MJPH      22-JUL-2005     Make chain callable
# $VERSION = 0.21;    # MJPH      13-JUN-2005     Fix adjacent glyph sequences
# $VERSION = 0.20;    # MJPH      23-JAN-2004     Fix single glyph internal cross-references
# $VERSION = 0.19;    # MJPH      14-AUG-2003     Add warnings
# $VERSION = 0.18;    # MJPH      12-JUN-2003     Improve name support, noaps is now a list
# $VERSION = 0.17;    # MJPH      28-MAR-2003     Fix property copying
# $VERSION = 0.16;    # MJPH       1-FEB-2003     Fix surrogates
# $VERSION = 0.15;    # MJPH       3-OCT-2002     Allow overstrike="right" etc.
# $VERSION = 0.14;    # MJPH       2-OCT-2002     Fix scaling and component references
# $VERSION = 0.13;    # MJPH      17-AUG-2002     Add noaps attribute, points on attachments now work
# $VERSION = 0.12;    # MJPH      22-JUL-2002     Fix overstrike
# $VERSION = 0.11;    # MJPH      11-JUL-2002     Error message refining
# $VERSION = 0.10;    # MJPH      24-JUN-2002     add rsb  & lsb tags and -d 16 (overstriking disabling)
# $VERSION = 0.09;    # MJPH      14-JUN-2002     Fix property output and bad sync in attach.xml
# $VERSION = 0.08;    # MJPH      16-APR-2002     Change default PS names for .notdef null & CR
# $VERSION = 0.07;    # MJPH      18-MAR-2002     Support .notdef
# $VERSION = 0.06;    # MJPH       7-MAR-2002     errors, base glyphs with no outlines, 
#                                                 properties & notes, symbol fonts, surrogates
# $VERSION = 0.05;    # MJPH      10-DEC-2001     improve error messages
# $VERSION = 0.04;    # MJPH      19-SEP-2001     documentation improvements add Pod::Usage
# $VERSION = 0.03;    # MJPH      18-SEP-2001     add ascent, descent, linegap attributes
# $VERSION = 0.02;    #   MJPH    12-SEP-2001     -x now optional, -a bug fixes
# $VERSION = 0.01;    #   MJPH    31-JUL-2001     Original

unless ($CHAIN_CALL)
{
#    getopts('ac:d:hx:z:', \%opts);
#    $Getopt::Long::debug = 1;
    %opts = ("x" => sub {$xaps[defined $opts{'f'} ? scalar @{$opts{'f'}} : 0] = $_[1]});
    GetOptions(\%opts, 'a', 'c|config=s', 'd|debug=i', 'f|font=s@', 'h|help', 'x|apdb=s@', 'z|apout=s');

    unless ((defined $ARGV[1] && defined $opts{c}) || 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 = Font::TTF::Scripts::TTFBuilder::main($if, \%opts, 
            [$if, map {Font::TTF::Font->open($_) || die "Can't read font $_"} @{$opts{'f'}}],
            [@xaps]);

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

package Font::TTF::Scripts::TTFBuilder;
use Font::TTF::Font;
use Font::TTF::Glyf;
use Font::TTF::Glyph;
use Font::TTF::Hmtx;
use Font::TTF::Loca;
use Font::TTF::PSNames;
use Font::TTF::Coverage;
use XML::Parser::Expat;

sub main
{
    my ($if, $opts, $fonts, $iaps) = @_;
    my (@xml_dat, $oc, $gcount, @glyphs);
    my ($uidmax, $bc, $done_cpyrt, $fissymbol);
    my ($gid, $pname, $i, $currtext, $cur_str, $i);
    my ($opt_a, $opt_c, $opt_d, $opt_z) = @{$opts}{qw(a c d z)};

    my (%name_nums) = map {$_ => $i++} (qw(copyright family subfamily fontid fullname version psname
        trademark vendor designer description vendor_url designer_url license license_url reserved 
        preferred_family preferred_subfamily compat_full text CID_name));

    my $of = Font::TTF::Font->new();
    $Font::TTF::Coverage::dontsort = 1;
    my @tlist;
    if ($opt_a)
    { @tlist = sort grep {length($_) == 4 and $_ ne 'glyf' and $_ ne 'loca'} keys %$if; }
    else
    { @tlist = ('OS/2', 'cvt ', 'fpgm', 'gasp', 'head', 'hhea', 'maxp', 'name', 'prep', 'post'); }
    $if->tables_do(sub {
        my ($table, $t) = @_;
        return unless $table;
        $table->read_dat;
        $of->{$t} = bless {%{$table}}, ref $table;
        $of->{$t}{' PARENT'} = $of;
        $of->{$t}->read;
        $table->read;
        }, @tlist);

    my $ifissymbol = $if->{'cmap'}->read->ms_enc;
    $ifissymbol = 1 if (defined $ifissymbol && $ifissymbol == 0);

    my $fname = $if->{'name'}->read->find_name(4);

    if (scalar @$iaps)
    {
        my ($fnum, $currcmap, $currif, $fname);

        my $xml = XML::Parser::Expat->new();
        $xml->setHandlers('Start' => sub {
            my ($xml, $tag, %attrs) = @_;
    
            if ($tag eq 'glyph')
            {
                $gid = $currcmap->{'val'}{hex($attrs{'UID'})}
                    || $currif->{'post'}{'STRINGS'}{$attrs{'PSName'}}
                    || $attrs{'GID'};
                if (!defined $gid && ($attrs{'PSName'} || $attrs{'UID'}))
                { return $xml->xpcarp("No glyph called: $attrs{'PSName'}, Unicode: $attrs{'UID'} in $fname"); }
                unless ($opt_d & 64)
                {
                    my ($ugid) = $currcmap->{'val'}{hex($attrs{'UID'})};
                    my ($ggid) = $attrs{'GID'};
                    my ($pgid) = $currif->{'post'}{'STRINGS'}{$attrs{'PSName'}};
                    $xml->xpcarp("UID of $attrs{'UID'} maps to $ugid, but GID is $ggid in $fname")
                            if ($ugid && $ggid && $ugid != $ggid);
                    $xml->xpcarp("PSName of $attrs{'PSName'} maps to $pgid, but GID is $ggid in $fname")
                            if ($pgid && $ggid && $pgid != $pgid);
                    $xml->xpcarp("UID of $attrs{'UID'} maps to $ugid, while PSName of $attrs{'PSName'} maps to $pgid in $fname")
                            if ($pgid && $ugid && !$ggid && $ugid != $pgid);
                }
                $xml_dat[$fnum][$gid]{'ps'} = $attrs{'PSName'};
                $xml_dat[$fnum][$gid]{'UID'} = $attrs{'UID'};
            } elsif ($tag eq 'point')
            {
                $pname = $attrs{'type'};
            } elsif ($tag eq 'contour')
            {
                $xml_dat[$fnum][$gid]{'points'}{$pname}{'cont'} = $attrs{'num'};
            } elsif ($tag eq 'location')
            {
                $xml_dat[$fnum][$gid]{'points'}{$pname}{'loc'} = [$attrs{'x'}, $attrs{'y'}];
            } elsif ($tag eq 'font')
            {
#                $fontname = $attrs{'name'};
#                $fontupem = $attrs{'upem'};
            } elsif ($tag eq 'property')
            {
                $xml_dat[$fnum][$gid]{'properties'}{$attrs{'name'}} = $attrs{'value'};
            } elsif ($tag eq 'note')
            {
                $currtext = '';
            }
        }, 'End' => sub {
            my ($xml, $tag) = @_;
    
            if ($tag eq 'point')
            { $xml->xpcarp("Attachment point must have location or contour in $fname")
                unless (defined $xml_dat[$fnum][$gid]{'points'}{$pname}{'cont'}
                        || defined $xml_dat[$fnum][$gid]{'points'}{$pname}{'loc'}); }
            elsif ($tag eq 'note')
            {
                $currtext =~ s/\s*(.*?)\s*$//o;
                $xml_dat[$fnum][$gid]{'notes'} = $currtext;
                $currtext = '';
            }
        }, 'Char' => sub {
            my ($xml, $str) = @_;
            
            $currtext .= $str;
        });
    
        for ($fnum = 0; $fnum < scalar @$iaps; $fnum++)
        {
            $currif = $fonts->[$fnum];
            $currcmap = $fonts->[$fnum]{'cmap'}->read->find_ms;
            $fname = $iaps->[$fnum];
            next unless ($fname);
            $xml->parsefile($fname) || die "Can't read $fname";
        }
    }

    $if->{'loca'}->read;
    $if->{'hmtx'}->read;
    $if->{'post'}->read;
    $of->{'hmtx'} = Font::TTF::Hmtx->new(PARENT => $of, read => 1);

    if ($opt_a)
    {
        my ($p, $aglyph);
        
        $oc = {%{$if->{'cmap'}->find_ms->{'val'}}};
        for ($i = 0; $i < $if->{'maxp'}{'numGlyphs'}; $i++)
        {
            my ($g) = $if->{'loca'}{'glyphs'}[$i];
            my ($bbox);
    
            $aglyph = {
                'font' => $if,
                'GID' => $i,
                'PSName' => $if->{'post'}{'VAL'}[$i]};
    
            if ($g)
            {
                $g->read;
                $aglyph->{'glyph_list'} = [{
                    'glyph' => $g,
                    'GID' => $i,
                    'offset' => [0, 0]}];
                $aglyph->{'bbox'} = [$g->{'xMin'}, $g->{'yMin'}, $g->{'xMax'}, $g->{'yMax'}];
            }
    
            foreach $p (keys %{$xml_dat[0][$i]{'points'}})
            {
                my ($p1) = $xml_dat[0][$i]{'points'}{$p};
                $aglyph->{'points'}{$p}{'base'} = $aglyph;
                $aglyph->{'points'}{$p}{'loc'} = [@{$p1->{'loc'}}] if (defined $p1->{'loc'});
                $aglyph->{'points'}{$p}{'cont'} = $p1->{'cont'} if (defined $p1->{'cont'});     # deep copy - klunky
            }
            $aglyph->{'properties'} = {%{$xml_dat[0][$i]{'properties'}}} if defined $xml_dat[0][$i]{'properties'};
            $aglyph->{'notes'} = $xml_dat[0][$i]{'notes'} if defined $xml_dat[0][$i]{'notes'};
            $g->{'required'} = $i;
            push (@glyphs, $aglyph);
            $of->{'hmtx'}{'advance'}[$i] = $if->{'hmtx'}{'advance'}[$i];
        }
        $gcount = $i - 1;
    } else {
        $oc = {};
        $gcount = 2;
    }

#    unshift(@$fonts, $if);
    $i = 0;
    foreach my $f (@$fonts)
    {
        foreach (qw(cmap hmtx loca head post))
        { $f->{$_}->read; }
        $f->{'scale'} = 1. * $if->{'head'}{'unitsPerEm'} / $f->{'head'}{'unitsPerEm'};
        $f->{'number'} = $i++;
    }

    my $xml = XML::Parser::Expat->new();
    $xml->setHandlers('Start' => sub {
        my ($xml, $tag, %attrs) = @_;
        my ($curbase) = $xml->{' curbase'};
    
        if ($tag eq 'glyph')
        {
            $curbase = {%attrs};
            $xml->{' curbase'} = $curbase;
            $curbase->{'GID'} = ++$gcount unless (defined $curbase->{'GID'});
            $gcount = $curbase->{'GID'} if ($gcount < $curbase->{'GID'});
            $glyphs[$curbase->{'GID'}] = $curbase;
        }
        elsif ($tag eq 'base' || $tag eq 'attach')
        {
            my ($gid, $aglyph, $p, %noaps);
            my ($fnum) = $attrs{'font'} || "0";
            my ($cif) = $fonts->[$fnum];
            my ($ccmap) = $cif->{'cmap'}->find_ms;
            
            unless (($attrs{'PSName'} && ($gid = $cif->{'post'}{'STRINGS'}{$attrs{'PSName'}}))
                    || ($attrs{'UID'} && ($gid = $ccmap->{'val'}{hex($attrs{'UID'})}))
                    || ($gid = $attrs{'GID'}) || defined $attrs{'GID'} || ($opt_d & 128) == 128)
            { $xml->xpcarp("Can't find glyph $attrs{PSName}/U+" . ($attrs{UID} ? $attrs{UID} : "0000") . " for $tag in $curbase->{'PSName'} in $opt_c"); }
    
            $aglyph = {
                'fnum' => $fnum,
                'font' => $cif,
                'gid' => $gid,
                'glyph' => $cif->{'loca'}{'glyphs'}[$gid],
                'parent' => $curbase,
                'PSName' => $attrs{'PSName'},
                'UID' => $attrs{'UID'}
                };
            push (@{$curbase->{'glyphs'}}, $aglyph);        # build components tree
    
            unless ($attrs{'noaps'} == 1)
            {
                my %noaps = map {$_ => 1} split(' ', $attrs{'noaps'});
                foreach $p (keys %{$xml_dat[$fnum][$gid]{'points'}})
                {
                    next if $noaps{$p};
                    my ($p1) = $xml_dat[$fnum][$gid]{'points'}{$p};
                    $aglyph->{'points'}{$p}{'base'} = $aglyph;
                    $aglyph->{'points'}{$p}{'loc'} = [@{$p1->{'loc'}}] if (defined $p1->{'loc'});
                    $aglyph->{'points'}{$p}{'cont'} = $p1->{'cont'} if (defined $p1->{'cont'});     # deep copy - klunky
                }
            }
            $aglyph->{'properties'} = {%{$xml_dat[$fnum][$gid]{'properties'}}} if defined $xml_dat[$fnum][$gid]{'properties'};
            $aglyph->{'notes'} = $xml_dat[$fnum][$gid]{'notes'} if defined $xml_dat[$fnum][$gid]{'notes'};
    
            if ($tag eq 'attach')                            # position attachment
            {
                my ($atx, $aty, $withx, $withy, $pt);
                my ($currif) = $curbase->{'font'};
                if (defined $attrs{'at'})
                {
                    $pt = $xml_dat[$curbase->{'fnum'}][$curbase->{'gid'}]{'points'}{$attrs{'at'}};
                    if (!defined $pt)
                    { $xml->xpcarp("Undefined attachment point $attrs{'at'} on glyph $xml_dat[$curbase->{'gid'}]{'ps'} in $opt_c"); }
                    elsif (!defined $pt->{'loc'})
                    {
                        if (defined $pt->{'cont'})
                        { 
                            $xml->xpcarp("glyph $xml_dat[$curbase->{'fnum'}][$curbase->{'gid'}]{'ps'} has no outline in $opt_c") 
                                unless ($curbase->{'glyph'});
                            $pt->{'loc'} = lookup_pt($curbase->{'glyph'}, $pt->{'cont'}, $curbase->{'font'}{'scale'}); 
                        }
                        else
                        { $xml->xpcarp("Unlocatable attachment point $attrs{'at'} on glyph $xml_dat[$curbase->{'fnum'}][$curbase->{'gid'}]{'ps'} in $opt_c"); }
                    }
                    ($atx, $aty) = @{$pt->{'loc'}};
                    delete $curbase->{'points'}{$attrs{'at'}};      # used it so delete it
                } else                                              # no attachment point, default centre the glyphs in x
                {
                    $atx = $curbase->{'font'}{'hmtx'}{'advance'}[$curbase->{'gid'}] / 2 * $curbase->{'font'}{'scale'};
                    $aty = 0;
                }

                if (defined $attrs{'with'})
                {
                    $pt = $xml_dat[$fnum][$aglyph->{'gid'}]{'points'}{$attrs{'with'}};
                    if (!defined $pt)
                    {
                        $xml->xpcarp("Undefined attachment point $attrs{'with'} on glyph $xml_dat[$fnum][$aglyph->{'gid'}]{'ps'} in $opt_c");
                        $pt->{'loc'} = [0, 0];
                    }
                    elsif (!defined $pt->{'loc'})
                    {
                        if (defined $pt->{'cont'})
                        { $pt->{'loc'} = lookup_pt($aglyph->{'glyph'}, $pt->{'cont'}, $currif->{'scale'}); }
                        else
                        {
                            $xml->xpcarp("Unlocatable attachment point $attrs{'at'} on glyph $xml_dat[$fnum][$aglyph->{'gid'}]{'ps'} in $opt_c");
                            $pt->{'loc'} = [0, 0];
                        }
                    }
                    ($withx, $withy) = @{$pt->{'loc'}};
                    delete $aglyph->{'points'}{$attrs{'with'}}     # delete if attaching to a real glyph
                            if (defined $curbase->{'glyph'} && (!ref $curbase->{'glyph'}{'endpoints'} || $curbase->{'glyph'}{'numPoints'} != scalar @{$curbase->{'glyph'}{'endPoints'}}));
                } else
                {
                    $withx = $currif->{'hmtx'}{'advance'}[$aglyph->{'gid'}] / 2 * $currif->{'scale'};
                    $withy = 0;
                }
    
                $aglyph->{'roffset'} = [$atx - $withx, $aty - $withy];
            }
            $xml->{' curbase'} = $aglyph;
        }
        elsif ($tag eq 'advance')
        {
            $curbase->{'adv'} = $attrs{'width'};
        }
        elsif ($tag eq 'rsb')
        {
            $curbase->{'adv'} = $curbase->{'glyph'}->read->{'xMax'} + $attrs{'width'};
        }
        elsif ($tag eq 'lsb')
        {
            $curbase->{'lsb'} = $attrs{'width'};
        }
        elsif ($tag eq 'shift')
        {
            $curbase->{'roffset'}[0] += $attrs{'x'};
            $curbase->{'roffset'}[1] += $attrs{'y'};
        }
        elsif ($tag eq 'scale')
        {
            my (@r, @s, $angle, $res);
            if (defined $attrs{'rotate'})
            {
                $angle = $attrs{'rotate'} * 3.141592535 / 180;
                @r = (cos($angle), -sin($angle), sin($angle), cos($angle))
            }
            else
            { @r = (1, 0, 0, 1); }
            @s = (1, 0, 0, 1);
            $s[0] = $attrs{'x'} if (defined $attrs{'x'});
            $s[3] = $attrs{'y'} if (defined $attrs{'y'});
            $res = mat_mult(\@s, \@r);
            $curbase->{'scale'} = $res;
        }
        elsif ($tag eq 'string')
        {
            $cur_str = {%attrs};
            $currtext = '';
        }
        elsif ($tag eq 'font')
        {
            my ($s);

            $of->{'hhea'}{'Ascender'} = $attrs{'ascent'} if defined $attrs{'ascent'};
            $of->{'hhea'}{'Descender'} = $attrs{'descent'} if defined $attrs{'descent'};
            $of->{'hhea'}{'LineGap'} = $attrs{'linegap'} if defined $attrs{'linegap'};
            if ($s = $attrs{'cp'})
            {
                $s = '0' x (16 - length($s)) . $s;
                $of->{'OS/2'}{'ulCodePageRange1'} = hex(substr($s, 8));
                $of->{'OS/2'}{'ulCodePageRange2'} = hex(substr($s, 0, 8));
                $of->{'OS/2'}{'Version'} = 1 unless ($of->{'OS/2'}{'Version'});
            }
            if ($s = $attrs{'coverage'})
            {
                $s = '0' x (32 - length($s)) . $s;
                $of->{'OS/2'}{'ulUnicodeRange1'} = hex(substr($s, 24));
                $of->{'OS/2'}{'ulUnicodeRange2'} = hex(substr($s, 16, 8));
                $of->{'OS/2'}{'ulUnicodeRange3'} = hex(substr($s, 8, 8));
                $of->{'OS/2'}{'ulUnicodeRange4'} = hex(substr($s, 0, 8));
                $of->{'OS/2'}{'Version'} = 1 unless ($of->{'OS/2'}{'Version'});
            }
        }
        elsif ($tag eq 'property')
        {
            $curbase->{'properties'}{$attrs{'name'}} = $attrs{'value'};
        }
        elsif ($tag eq 'note')
        {
            $currtext = '';
        }
        elsif ($tag eq 'name')
        {
            $attrs{'num'} = $name_nums{$attrs{'num'}} if (defined $name_nums{$attrs{'num'}});
            $currtext .= $if->{'name'}->find_name($attrs{'num'});
        } elsif ($tag eq 'point')
        {
            $curbase->{'points'}{$attrs{'name'}}{'loc'} = [$attrs{'x'}, $attrs{'y'}];
        }
    }, 'End' => sub {
        my ($xml, $tag) = @_;
        my ($curbase) = $xml->{' curbase'};

        if ($tag eq 'base' || $tag eq 'attach')
        {
            $curbase->{'adv'} = $curbase->{'font'}{'hmtx'}{'advance'}[$curbase->{'gid'}] * $curbase->{'font'}{'scale'} * (defined $curbase->{'scale'} ? $curbase->{'scale'}[0] : 1)
                unless (defined $curbase->{'adv'});
            $xml->{' curbase'} = $curbase->{'parent'};
            $curbase = $xml->{' curbase'};
            if ($tag eq 'base' && scalar @{$curbase->{'glyphs'}} == 1)
            {
                my ($k);
                foreach $k (keys %{$curbase->{'glyphs'}[0]{'properties'}})
                {
                    $curbase->{'properties'}{$k} = $curbase->{'glyphs'}[0]{'properties'}{$k} 
                            unless defined $curbase->{'properties'}{$k};
                }
                $curbase->{'notes'} = $curbase->{'glyphs'}[0]{'notes'} 
                        if (defined $curbase->{'glyphs'}[0]{'notes'} && !defined $curbase->{'notes'});
            }
        }
        elsif ($tag eq 'glyph')
        {
            my ($adv, $g, $xMin, $yMin, $xMax, $yMax, $p, $lorg, $pcount, $i, $lastg);

            $i = 0;
            foreach $g (@{$curbase->{'glyphs'}})
            {
                $pcount = resolve_glyph($g, ($lastg ? $lastg->{'adv'} : 0), 0, $pcount, !(over_asnum($curbase->{'overstrike'}, ($opt_d & 32) >> 4) & 2));    # get absolute position of glyph, create flattened glyph_list
                $adv = $g->{'adv'} if ($g->{'adv'} > $adv);	    # + $g->{'offset'}[0]
                $lorg = $g->{'lorg'} if ($g->{'lorg'} < $lorg);
                push (@{$curbase->{'glyph_list'}}, @{$g->{'glyph_list'}});  # compile full glyph list
                if (defined $g->{'bbox'})
                { ($xMin, $yMin, $xMax, $yMax) =
                    findbox($xMin, $yMin, $xMax, $yMax, $g->{'bbox'}, $g->{'offset'}); }
                foreach $p (keys %{$g->{'points'}})
                { $curbase->{'points'}{$p} = $g->{'points'}{$p}; }
                if (scalar @{$curbase->{'glyphs'}} > 1)
                {
                    $curbase->{'properties'}{"component.$i"} = $adv;
                    $i++;
                }
                $lastg = $g;
            }
    
            if ((over_asnum($curbase->{'overstrike'}, ($opt_d & 16) >> 4) & 1) && $lorg < 0)
            {
                foreach $g (@{$curbase->{'glyph_list'}})
                { $g->{'offset'}[0] -= $lorg; }
                foreach $g (@{$curbase->{'glyphs'}})
                { $g->{'offset'}[0] -= $lorg; }
                $adv -= $lorg;
                $xMax -= $lorg;
                $xMin -= $lorg;
            }
    
            if (scalar @{$curbase->{'glyph_list'}} == 1)        # only one glyph?
            {
                my ($cg) = $curbase->{'glyph_list'}[0];
    
                if ($cg->{'offset'}[0] == 0 && $cg->{'offset'}[1] == 0 && !defined $cg->{'scale'})     # no move - then basis for other references
                { $cg->{'glyph'}{'required'} = $curbase->{'GID'}; }
                elsif (!defined $cg->{'glyph'}{'required1'} or
                    !defined $cg->{'scale'} or
                    mat_det($glyphs[$cg->{'glyph'}{'required1'}]{'scale'}) < mat_det($cg->{'scale'}))
                { $cg->{'glyph'}{'required1'} = $curbase->{'GID'}; }         # moved - perhaps a basis
            }
    
            $curbase->{'bbox'} = [$xMin, $yMin, $xMax, $yMax];
            $of->{'hmtx'}{'advance'}[$curbase->{'GID'}] =                       # font update handles lsb
                    defined ($curbase->{'adv'}) ? $curbase->{'adv'} : $adv;     # resolve advance width here
            undef $xml->{' curbase'};
        }
        elsif ($tag eq 'string')
        {
            $currtext =~ s/^\s*(.*?)\s*$/$1/o;
            $currtext =~ s/\s(?=\s)//og;
            $cur_str->{'text'} = $currtext;
            if ($cur_str->{'num'} eq 'name')
            {
                my ($style);
                
                $cur_str->{'num'} = 1;
                do_name($of, $cur_str);
                $cur_str->{'num'} = 16;
                do_name($of, $cur_str);
                $style = $of->{'name'}->find_name(2);
                if ($style && $style ne 'Regular')
                { 
                    my $tempstr = {};
                    
                    $cur_str->{'text'} .= " $style";
                    $tempstr->{'text'} = $style;
                    $tempstr->{'num'} = 17;
                    do_name($of, $tempstr);
                }
                $cur_str->{'num'} = 4;
                do_name($of, $cur_str);
            }
            elsif ($cur_str->{'num'} !~ m/^\d+$/o)
            {
                my ($num) = $name_nums{$cur_str->{'num'}};
                if (defined $num)
                {
                    $cur_str->{'num'} = $num;
                    do_name($of, $cur_str);
                }
                else
                { $xml->xpcarp("Unknown string name $cur_str->{'num'}, skipping in $opt_c"); }
            }
            else
            { do_name($of, $cur_str); }
            if ($cur_str->{'num'} == 0)
            { $done_cpyrt = 1; }
            undef $cur_str;
        }
        elsif ($tag eq 'note')
        {
            $currtext =~s/^\s*(.*?)\s*$/$1/o;
            $curbase->{'notes'} = $currtext;
        }
    }, 'Char' => sub {
        my ($xml, $text) = @_;
    
        $currtext .= $text;
    });
    
    $xml->parsefile($opt_c) || die "Can't read $opt_c";

    unless ($opt_a)     # only need this if not copying old font anyway.
    {
        my (@names) = qw(.notdef .null nonmarkingreturn);
        # fill in first 3 special glyphs: .notdef .null nonmarkingreturn
        for ($i = 0; $i < 3; $i++)
        {
            my ($g, $bbox);
        
            next if defined $glyphs[$i];
    
            $g = $if->{'loca'}{'glyphs'}[$i];
            $glyphs[$i] = {
                'fnum' => 0,
                'font' => $if,
                'GID' => $i,
                'PSName' => $names[$i]};
            if ($g)
            {
                $g->read;
                $glyphs[$i]{'bbox'} = [$g->{'xMin'}, $g->{'yMin'}, $g->{'xMax'}, $g->{'yMax'}];
                $glyphs[$i]{'glyph_list'} = [{
                    'glyph' => $g,
                    'GID' => $i}],
            }
            $of->{'hmtx'}{'advance'}[$i] = $if->{'hmtx'}{'advance'}[$i];
        }
    
        # resolve reference bases - use possible bases here
        foreach my $f (@$fonts)
        {
            my ($s) = $f->{'scale'};
            
            for ($i = 0; $i < $f->{'maxp'}{'numGlyphs'}; $i++)
            {
                my ($g) = $f->{'loca'}{'glyphs'}[$i];
                my ($bbox);
 
                next unless ($g && $g->{'required'} == -1);
                $g->read;
                if (defined $g->{'required1'})
                {
                    $g->{'required'} = $g->{'required1'};
                    next;
                }
                $bbox = [$g->{'xMin'} * $s, $g->{'yMin'} * $s, $g->{'xMax'} * $s, $g->{'yMax'} * $s];
 
                push (@glyphs, {
                    'GID' => ++$gcount,
                    'font' => $f,
                    'fnum' => $f->{'number'},
                    'glyph_list' => [{
                        'font' => $f,
                        'fnum' => $f->{'number'},
                        'glyph' => $g,
                        'GID' => $i,
                        'offset' => [0, 0]}],
                    'bbox' => $bbox,
                    ($opt_d & 2 ? () : ('PSName' => $f->{'post'}{'VAL'}[$i]))});
                $g->{'required'} = $gcount;
                $of->{'hmtx'}{'advance'}[$gcount] = $f->{'hmtx'}{'advance'}[$i] * $f->{'scale'};
            }
        }
    }
    
    
    $of->{'maxp'}{'numGlyphs'} = scalar @glyphs;
    $of->{'post'}->read;
    $of->{'post'}{'VAL'} = [];
    $of->{'loca'} = Font::TTF::Loca->new(PARENT => $of, read => 1);
    $of->{'glyf'} = Font::TTF::Glyf->new(PARENT => $of, read => 1);
    
    if ($opt_z)
    {
        my ($fname) = $of->{'name'}->find_name(4);
        open (OX, "> $opt_z") || die "Can't open $opt_z for writing";
        print OX "<?xml version='1.0' encoding='UTF-8'?>\n";
        print OX "<font name=\"$fname\" upem=\"$of->{'head'}{'unitsPerEm'}\">\n";
    }

    for (my $i = 0; $i < $of->{'maxp'}{'numGlyphs'}; $i++)
    {
        my ($g) = $glyphs[$i];
        my ($glyph, $uid, $pname);
    
        unless (defined $g)
        {
            $of->{'post'}{'VAL'}[$i] = '.notdef';
            next;
        }
    
        if ($g->{'UID'})
        {
            $uid = hex($g->{'UID'});
            $uidmax = $uid if ($uid > $uidmax);
            $oc->{$uid} = $i;
        } else
        { $uid = 0; }
        if ($g->{'BID'})
        { $bc->{hex($g->{'BID'})} = $i; }
        
        if ($g->{'PSName'})
        { $pname = $g->{'PSName'}; }
        else
        { $pname = Font::TTF::PSNames::lookup($uid); }
        $of->{'post'}{'VAL'}[$i] = $pname;
    
        if (defined $g->{'glyph_list'} && scalar @{$g->{'glyph_list'}})
        {
        
            $glyph = Font::TTF::Glyph->new(PARENT => $of, read => 2);
            $glyph->{' isDirty'} = 1;
            $glyph->{'xMin'} = $g->{'bbox'}[0];
            $glyph->{'yMin'} = $g->{'bbox'}[1];
            $glyph->{'xMax'} = $g->{'bbox'}[2];
            $glyph->{'yMax'} = $g->{'bbox'}[3];
            if (scalar @{$g->{'glyph_list'}} == 1 
                && ($g->{'glyph_list'}[0]{'glyph'}{'required'} == $i))  # v0.20
            {
                my ($cg) = $g->{'glyph_list'}[0];
                my ($gb) = $cg->{'glyph'};
                foreach (qw(numberOfContours xMin yMin xMax yMax), ' DAT')
                { $glyph->{$_} = $gb->{$_}; }
                $glyph->{' read'} = 1;
                if ($glyph->{'numberOfContours'} < 0)
                {
                    my ($comp);
                    $glyph->read_dat;
                    foreach $comp (@{$glyph->{'comps'}})
                    { $comp->{'glyph'} = $g->{'font'}{'loca'}{'glyphs'}[$comp->{'glyph'}]{'required'}; }
                }
                if ($cg->{'fnum'} || $cg->{'offset'}[0] != 0 || $cg->{'offset'}[1] != 0 || defined $cg->{'scale'})
                {
                    my ($scale) = $cg->{'font'}{'scale'};
                    $glyph->read_dat;
                    if ($glyph->{'numberOfContours'} < 0)
                    {
                        my ($comp);
        
                        foreach $comp (@{$glyph->{'comps'}})
                        {
                            $comp->{'args'}[0] = $comp->{'args'}[0] * $scale + $cg->{'offset'}[0];
                            $comp->{'args'}[1] = $comp->{'args'}[1] * $scale + $cg->{'offset'}[1];
                            $comp->{'scale'} = mat_mult($cg->{'scale'}, $comp->{'scale'}, $scale);
                        }
                    } else
                    {
                        for (my $j = 0; $j < scalar @{$glyph->{'x'}}; $j++)
                        {
                            my ($x, $y) = ($glyph->{'x'}[$j] * $scale, $glyph->{'y'}[$j] * $scale);
                            
                            if ($cg->{'scale'})
                            {
                                my (@m) = @{$cg->{'scale'}};
                                if ($m[0] != 0 || $m[1] != 0 || $m[2] != 0 || $m[3] != 0)
                                {
                                    ($x, $y) = ($x * $m[0] + $y * $m[1], $x * $m[2] + $y * $m[3]);
                                }
                            }
                            
                            $x += $cg->{'offset'}[0];
                            $y += $cg->{'offset'}[1];
                            ($glyph->{'x'}[$j], $glyph->{'y'}[$j]) = ($x, $y);
                        }
                    }
                }
                $of->{'hmtx'}{'lsb'}[$i] -= $cg->{'offset'}[0];
            } else
            {
                my ($gb);
                
                $glyph->{'numberOfContours'} = -1;
                foreach $gb (@{$g->{'glyph_list'}})
                {
                    my ($c) = $glyphs[$gb->{'glyph'}{'required'}];
                    my ($co) = $c->{'glyph_list'}[0];
    
                    push (@{$glyph->{'comps'}}, {
                        'glyph' => $gb->{'glyph'}{'required'},
                        'flag' => 2,
                        'scale' => mat_div($gb->{'scale'}, $co->{'scale'}),
                #        'scale' => $gb->{'scale'},
                        'args' => [$gb->{'offset'}[0] - $co->{'offset'}[0], $gb->{'offset'}[1] - $co->{'offset'}[1]]});
                }
            }
            $of->{'loca'}{'glyphs'}[$i] = $glyph;
        }
        
        next unless defined $opt_z;
        print OX "\n<glyph GID=\"$i\"";
        print OX " PSName=\"$pname\"" if ($pname ne '.notdef');
        printf OX " UID=\"%04X\"", $uid if ($uid != 0);
        print OX ">\n";
#        foreach $glyph (@{$g->{'glyphs'}})
#        {
        my ($p, $cg);
        if (ref $g->{'glyph_list'} && scalar @{$g->{'glyph_list'}} > 1)
        {
            foreach $cg (@{$g->{'glyph_list'}})
            {
                my ($ag) = $glyphs[$if->{'loca'}{'glyphs'}[$cg->{'GID'}]{'required'}];
                my (@bbox) = ($ag->{'bbox'}[0] + $cg->{'offset'}[0],
                            $ag->{'bbox'}[1] + $cg->{'offset'}[1],
                            $ag->{'bbox'}[2] + $cg->{'offset'}[0],
                            $ag->{'bbox'}[3] + $cg->{'offset'}[1]);
                print OX "    <compound bbox=\"" . join(', ', @bbox) . "\"";
                if ($ag->{'UID'})
                { print OX " UID=\"$ag->{'UID'}\""; }
                elsif ($ag->{'PSName'})
                { print OX " PSName=\"$ag->{'PSName'}\""; }
                elsif ($ag->{'GID'})
                { print OX " GID=\"$ag->{'GID'}\""; }
                print OX "/>\n";
            }
        }
        
        foreach $p (keys %{$g->{'points'}})
        {
            my ($p1) = $g->{'points'}{$p};
            my ($pb) = $p1->{'base'};
            
            print OX "    <point type=\"$p\">\n";
            print OX "        <contour num=\"" .
                ($p1->{'cont'} + $pb->{'pathbase'}) .
                "\"/>\n" if (defined $p1->{'cont'});
            if ($p1->{'loc'})
            {
                my ($x) = $p1->{'loc'}[0];
                my ($y) = $p1->{'loc'}[1];
                if ($pb->{'offset'}[0])
                {
                    if ($x == 0 and $x !~ m/^\s*-?[0-9]*\s*$/o)
                    { $x = "$x + $pb->{'offset'}[0]"; }
                    else
                    { $x = $x + $pb->{'offset'}[0]; }
                }
                if ($pb->{'offset'}[1])
                {
                    if ($y == 0 and $y !~ m/^\s*-?[0-9]*\s*$/o)
                    { $y = "$y + $pb->{'offset'}[1]"; }
                    else
                    { $y = $y + $pb->{'offset'}[1]; }
                }
                print OX "        <location x=\"$x\" y=\"$y\"/>\n";
            }
            print OX "    </point>\n";
        }
#       }
#        foreach my $p (keys %{$g->{'glyphs'}[0]{'properties'}})
        foreach my $p (keys %{$g->{'properties'}})
#        { print OX "    <property name=\"$p\" value=\"$g->{'glyphs'}[0]{'properties'}{$p}\"/>\n"; }
        { print OX "    <property name=\"$p\" value=\"$g->{'properties'}{$p}\"/>\n"; }
        print OX "</glyph>\n";
    }

    if ($opt_z)
    {
        print OX "\n</font>\n";
        close(OX);
    }
    
    $of->{'cmap'} = Font::TTF::Cmap->new(PARENT => $of, read => 1);
    
    my $format = $uidmax > 0xFFFF ? 12 : 4;
    push (@{$of->{'cmap'}{'Tables'}}, {
        'Platform' => 0,
        'Encoding' => 0,
        'Format' => $format,
        'Ver' => 0,
        'val' => $oc});
    if ($bc)
    {
        push (@{$of->{'cmap'}{'Tables'}}, {
            'Platform' => 1,
            'Encoding' => 0,
            'Format' => 0,
            'Ver' => 0,
            'val' => $bc});
    }
    
    push (@{$of->{'cmap'}{'Tables'}}, {
        'Platform' => 3,
        'Encoding' => ($uidmax > 0xFFFF ? 10 : ($opt_d & 8 ? 0 : 1)),
        'Format' => $format,
        'Ver' => 0,
        'val' => $oc});
        
    if ($uidmax > 0xFFFF)       # also include a BMP cmap
    {
        my ($k, %bmpc);
        
        foreach $k (keys %{$oc})
        { $bmpc{$k} = $oc->{$k} if ($k <= 0xFFFF); }
        push (@{$of->{'cmap'}{'Tables'}}, {
            'Platform' => 3,
            'Encoding' => ($opt_d & 8 ? 0 : 1),
            'Format' => 4,
            'Ver' => 0,
            'val' => \%bmpc});
    }
    
    $of->{'cmap'}{'Num'} = scalar @{$of->{'cmap'}{'Tables'}};
    
    unless ($done_cpyrt || ($opt_d & 4))
    {
        my ($text) = $of->{'name'}->find_name(0);
        $text .= " Derived from $fname by ttfbuilder v$VERSION";
        do_name($of, {'num' => 0, 'text' => $text});
    }
    
    if ($ifissymbol ^ ($opt_d & 8 ? 1 : 0))
    {
        my ($n, $s);
        
        foreach $n (@{$of->{'name'}{'strings'}})
        {
            if (defined ($s = $n->[3][!$ifissymbol]))
            {
                undef $n->[3][!$ifissymbol];
                $n->[3][$ifissymbol] = $s;
            }
        }
    }
    
    unless ($opt_d & 1)
    {
        $of->{'head'}->setdate(time(), 1);  # set creation date
        $of->{'head'}->setdate(time(), 0);  # set modified date
    }
    $of->tables_do(sub {$_[0]->dirty});
    $of->update;
    # $of->{'head'}{'flags'} &= ~2;
    return $of;
}

sub resolve_glyph
{
    my ($g, $orgx, $orgy, $pathcount, $overstrike) = @_;
    my ($glyph, $xMin, $yMin, $xMax, $yMax, $c, $p, $adv, $lorg);
    my ($f) = $g->{'font'};
    my ($s) = $f->{'scale'};

    $g->{'pathbase'} = $pathcount;
    $g->{'offset'} = [$g->{'roffset'}[0] + $orgx,
                      $g->{'roffset'}[1] + $orgy];
    $adv = (defined $g->{'adv'} ? $g->{'adv'} : $f->{'hmtx'}{'advance'}[$g->{'gid'}] * $s)
            + $g->{'offset'}[0];
    
    if ($glyph = $g->{'glyph'})
    {
        $glyph->read->get_points;
        $pathcount += scalar @{$glyph->{'endPoints'}} if (defined $glyph->{'endpoints'});

        push (@{$g->{'glyph_list'}}, pos_glyphs($f, $g->{'gid'}, $glyph, @{$g->{'offset'}}, $g->{'scale'}, $s));

        $xMin = $glyph->{'xMin'} * $s;
        $yMin = $glyph->{'yMin'} * $s;
        $xMax = $glyph->{'xMax'} * $s;
        $yMax = $glyph->{'yMax'} * $s;
    }
    elsif (!defined $g->{'glyph_list'})
    { $g->{'glyph_list'} = []; }

    $lorg = $xMin - $g->{'lsb'} + $g->{'offset'}[0];

    foreach $c (@{$g->{'glyphs'}})
    {
        my ($lorgt);
        $pathcount = resolve_glyph($c, @{$g->{'offset'}}, $pathcount);
        $adv = $c->{'adv'} if (!$overstrike && $c->{'adv'} > $adv);
        ($xMin, $yMin, $xMax, $yMax) = findbox($xMin, $yMin, $xMax, $yMax, $c->{'bbox'}, $c->{'offset'});
        $lorgt = $c->{'bbox'}[0] - $c->{'lsb'} + $c->{'offset'}[0];
        $lorg = $lorgt if ($lorgt < $lorg);
        push (@{$g->{'glyph_list'}}, @{$c->{'glyph_list'}});
        foreach $p (keys %{$c->{'points'}})
        { $g->{'points'}{$p} = $c->{'points'}{$p}; }
    }
    $g->{'bbox'} = [$xMin, $yMin, $xMax, $yMax];
    $g->{'adv'} = $adv;
    $g->{'lorg'} = $lorg;
    return $pathcount;
}

sub pos_glyphs
{
    my ($font, $gid, $glyph, $orgx, $orgy, $scale, $qs) = @_;
    my ($comp);

    if ($glyph->{'numberOfContours'} < 0)
    {
        my (@res);
        $glyph->read_dat;
        foreach $comp (@{$glyph->{'comps'}})
        {
            push (@res, pos_glyphs($font, $comp->{'glyph'},
                    $font->{'loca'}{'glyphs'}[$comp->{'glyph'}],
                    $comp->{'args'}[0] * $qs + $orgx,
                    $comp->{'args'}[1] * $qs + $orgy, mat_mult($scale, $comp->{'scale'}, $qs), $qs)) if ($font->{'loca'}{'glyphs'}[$comp->{'glyph'}]);
        }
        return @res;
    } elsif (scalar @{$glyph->{'endPoints'}} == $glyph->{'numPoints'})
    {
        return ();
    } else
    {
        $glyph->{'required'} = -1 if (!defined $glyph->{'required'});
        return ({
            'font' => $font,
            'fnum' => $font->{'number'},
            'GID' => $gid,
            'offset' => [$orgx, $orgy],
            'scale' => $scale,
            'glyph' => $glyph});
    }
}


sub lookup_pt
{
    my ($glyph, $cont, $scale) = @_;
    $glyph->get_points;
    return [$glyph->{'x'}[$glyph->{'endPoints'}[$cont]] * $scale,
            $glyph->{'y'}[$glyph->{'endPoints'}[$cont]] * $scale];
}

sub findbox
{
    my ($xMin, $yMin, $xMax, $yMax, $others, $org) = @_;
    my ($o);
    
    $o = $others->[0] + $org->[0];
    $xMin = $o if (!defined $xMin || $o < $xMin);
    $o = $others->[1] + $org->[1];
    $yMin = $o if (!defined $yMin || $o < $yMin);
    $o = $others->[2] + $org->[0];
    $xMax = $o if ($o > $xMax);
    $o = $others->[3] + $org->[1];
    $yMax = $o if ($o > $yMax);
    ($xMin, $yMin, $xMax, $yMax);
}
    
sub do_name
{
    my ($f, $inf) = @_;
    my ($base) = $f->{'name'}{'strings'}[$inf->{'num'}];
    my ($pid, $eid, $lid);
    my $processed;

    for ($pid = 0; $pid <= $#{$base}; $pid++)
    {
        next if (defined $inf->{'pid'} && $pid != $inf->{'pid'});
        next unless $base->[$pid];
        for ($eid = 0; $eid <= $#{$base->[$pid]}; $eid++)
        {
            next if (defined $inf->{'eid'} && $eid != $inf->{'eid'});
            next unless $base->[$pid][$eid];
            next unless $f->{'name'}->is_utf8($pid, $eid);
            foreach $lid (keys %{$base->[$pid][$eid]})
            {
                next if (defined $inf->{'lid'} && $lid != $inf->{'lid'});
                $base->[$pid][$eid]{$lid} = $inf->{'text'};
                $processed = 1;
            }
        }
    }
    # Add this name if we haven't done something with it yet and it is fully specified:
    if (!$processed)
    {
        if (defined $inf->{'pid'} && defined $inf->{'eid'} && defined $inf->{'lid'})
        { $f->{'name'}{'strings'}[$inf->{'num'}][$inf->{'pid'}][$inf->{'eid'}]{$inf->{'lid'}}
                = $inf->{'text'}; } 
#        else
#        { warn "Incompletely specified string not added to name table."; }    
    }
}

sub as_bool
{
    my ($str, $default) = @_;
    
    if ($str eq '1' || $str eq 'true')
    { return 1; }
    elsif ($str eq '0' || $str eq 'false')
    { return 0; }
    else
    { return $default; }
}

sub over_asnum
{
    my ($str, $default) = @_;
    
    if ($str eq '1' || $str eq 'true' || $str eq 'both')
    { return 3; }
    elsif ($str eq 'left')
    { return 1; }
    elsif ($str eq 'right')
    { return 2; }
    elsif ($str eq '0' || $str eq 'false' || $str eq 'none')
    { return 0; }
    else
    { return $default; }
}

sub mat_mult
{
    my ($a, $b, $s) = @_;
    
    if (!defined $a)
    { return $b; }
    if (!defined $b)
    { return $a; }
    $s ||= 1.0;

    return [($a->[0] * $b->[0] + $a->[1] * $b->[2]) * $s, ($a->[0] * $b->[1] + $a->[1] * $b->[3]) * $s,
            ($a->[2] * $b->[0] + $a->[3] * $b->[2]) * $s, ($a->[2] * $b->[1] + $a->[3] * $b->[3]) * $s];
}

sub mat_div
{
    my ($a, $b) = @_;

    return $a unless defined $b;
    my ($det) = ($b->[0] * $b->[3] - $b->[1] * $b->[2]) * 1.;
    my ($d) = [$b->[3] / $det, -$b->[1] / $det, -$b->[2] / $det, $b->[0] / $det];

    return $d unless defined $a;
    return mat_mult($a, $d, 1);
}

sub mat_det
{
    my ($a) = @_;
    return 1.0 unless (defined $a);
    return ($a->[0] * $a->[3] - $a->[1] * $a->[2]) * 1.;
}

__END__

=head1 TITLE

ttfbuilder - assemble a font from another font

=head1 SYNOPSIS

  ttfbuilder [-a] [-h] -c config.xml [-x attach.xml] [-z out.xml] \\
      infile.ttf outfile.ttf

Builds outfile.ttf from infile.ttf according to config.xml. Also
requires an attachment point database (attach.xml) and can generate
out.xml.

=head1 OPTIONS

  -a          initialise output font with all the glyphs of the input
              font and append new glyphs to that
  -c file     Configuration file to use
  -d bits     Flag bits
              0: Don't Set dates in the font to now
              1: Don't Auto-create postscript names for component glyphs
              2: Don't Hack the copyright message (if none set)
              3: Mark target font as symbol font
              4: Default to not allowing overstrikes (ensures guard
                 space) on lhs
              5: Default to not allowing overstriking on rhs
              6: Disable some warnings
              7: Don't report missing glyphs
  -f font     Extra font to reference [repeatable]
  -h          Help
  -x file     Attachment database to read [repeatable, follows correspond -f
                or occurs before -f to correspond to main font]
  -z file     Attachment database to output
    
=head1 DESCRIPTION

ttfbuilder is a font subsetting program gone wild. Its aim is to allow a user to
describe a new font in terms of the glyph pallette of a source font. Thus the new
font may include ligatures of glyphs in the source font, or positional movements
or whatever.

The main features of ttfbuilder are

=over 4

=item *

Ability to create glyphs that are not in any cmap and to reference such glyphs via
postscript name, glyph id or Unicode cmap entry.

=item *

Ability to work with an attachment points database. Thus ligatures are assembled
by describing which attachment points should coincide, rather than having to give
absolute locations in terms of shifting.

=item *

Ability to change the name of the font and change strings in the name table.

=item *

Ability to merge glyphs from other fonts.

=back

ttfbuilder is controlled via a description file which describes the glyphs in the
new font, in terms of glyphs in the source font. This description file is an XML
file with the following key elements:

=over 4

=item glyph

This describes a glyph and the attributes allow setting of the postscript name and
Unicode id for the glyph. The glyph element has children which describe what goes
into the glyph.

The C<overstrike> attribute controls whether an attachment to a base glyph can extend
beyond origin or the advance width of the base glyph. The default is to allow the
diacritics to extend and even occur to the left of the origin or to the right of the
advance. if C<overstrike> is set to C<left> for a glyph, then any diacritics may not
extend to the left of the origin and the glyph will be shifted right to ensure this, 
if necessary. Likewise if C<overstrike> is set to C<right> then the advance will be
increased to ensure that a diacritic does not extend beyond the advance width. values
of C<true> or C<1> or C<both> or C<all> guard both sides of the glyph.

The default action for all glyphs is not to guard. This can be changed using the -d
option with 16 setting the default C<left> value and 32 setting the default C<right>
value.

=item base

A base character is a reference to a glyph in the source font (via Unicode id,
postscript name, glyph id) which is used in building the parent glyph. If there is
more than one base glyph in a glyph, then the base glyphs are concatenated in
sequence according to their advance widths, creating a single glyph. If a glyph only
contains a single base glyph with no attachments, and the base glyph has not been
shifted in any way, then the resulting font will include the glyph directly rather
than by reference.

The C<font> attribute indicates that the glyph comes from another font. The attribute is a number (starting at 1) that refers to the nth font file in the list of -f command line options. Notice that any hinting associate with the glyph will be lost. The glyph will also be automatically scaled if the units per em of its source font are different from the main font.

=item attach

A base glyph may have attachments, which may have their own attachments in their
turn. An attachment is a reference to a glyph in the source font and also the name
of an attachment point on the attachment and one on its parent which are used to
position the attachment so that the attachment points coincide.

The C<attach> element takes two parameters describing the attachment point on the base
(C<at>) and the attachment point on the diacritic (C<with>). If these are missing, then
the glyphs are aligned centrally in the x direction and with no adjustment vertically.

The C<noaps> attribute may be used to stop certain, or all, attachment points being
propagated from a C<base> or C<attach> glyph to the glyph being defined. If C<noaps> has
the value C<1>, then no attachment points from this glyph will appear in the output
glyph. If C<noaps> contains a space separated listed of attachment point names, then
none of those attachment points will propagate (whether or not they exist).

When referencing a <base> or <attach> glyph, in additio to being able to use glyph
id, unicode id, or postscript name, it is possible to specify a font number which the
glyph should be taken from. This corresponds to the -f command line option values.
Thus a value of 0 is the required input font. A value of 1 is the first font referenced
by a -f option and so on.

=item advance

It is possible to override the default value of the advance width for any glyph. Thus
the advance element may occur is a child of either glyph, base or attach and it sets
the value of the advance width for its parent to the value given in the width
attribute. The default value of the advance width for a glyph is the widest advance
width taken from each of the child glyphs (including attachments) in their position
within the glyph. Thus if an attachment is positioned far enough to the right, it
may well cause the advance width of the glyph to increase beyond that of the base
glyph the attachment is on.

=item rsb

This allows the advance of a glyph to be specified in terms of the right side
bearing rather than an absolute advance value.

=item lsb

In the case where overstrike is disallowed, sets the guard space to the left of
the glyph.

=item shift

It is also possible to shift glyphs, at least base and attach glyphs. Shifting
occurs after attachment (for obvious reasons).

=item scale

Scaling a glyph allows for stretching given the x & y values may be different. The
x position is multiplied by the x scale and the y position is multiplied by the y
scale. There is no cross multiplication allowing for rotation.

=item string

In the names section of the description file it is possible to specify strings which
cause changes to the name section of the font. The string element takes a num
attribute which specifies which string to change. It is also possible to specify
which platform, encoding and or language id the change should be made to.

Rather than using numbers to identify strings it is possible to use names. The following
names correspond to strings 0 and following: copyright family subfamily fontid
fullname version psname trademark vendor designer description vendor_url
designer_url license license_url reserved preferred_family preferred_subfamily
compat_full text CID_name

There is one special value for the num attribute, which is C<name>. This causes
the name of the font (string id 1) and also the full font name (string id 4) to be
assembled from the font name and style (string id 2).

Within a string a C<name> element may be used to lookup an existing value of a
name string in the font for copying to the output font string being declared

=item font attributes

Various font attributes can be set from a TTFBuilder configuration file:

    ascent      amount of space needed above the baseline for a glyph
    descent     space below the baseline needed for a glyph
    linegap     how much space to put between lines
    cp          OS/2 codepages field (in binary)
    coverage    OS/2 Unicode block coverage (in binary)

Binary values are written in hex (as in: 0003)

=item property

A property element is a simple name value pair that is added to the attachment
point database for the glyph it is specified on

=item note

A note element contains text that is output to the attachment point database
for the glyph it is specified on

=back

The DTD for the configuration file is:

    <!ELEMENT font (names?, glyphs)>
    <!ATTLIST font
        ascent      CDATA #IMPLIED
        descent     CDATA #IMPLIED
        linegap     CDATA #IMPLIED
        cp          CDATA #IMPLIED
        coverage    CDATA #IMPLIED>

    <!ELEMENT names (string)+>

    <!ELEMENT string (#PCDATA|name)>
    <!ATTLIST string
        num     CDATA #REQUIRED
        pid     CDATA #IMPLIED
        eid     CDATA #IMPLIED
        lid     CDATA #IMPLIED>

    <!ELEMENT name EMPTY>
    <!ATTLIST name
        num     CDATA #REQUIRED>

    <!ELEMENT glyphs (glyph)+>

    <!ELEMENT glyph (property* | note? | (advance | rsb | lsb)+ | base)+>
    <!ATTLIST glyph
        PSNAme      CDATA #IMPLIED
        UID         CDATA #IMPLIED
        GID         CDATA #IMPLIED
        BID         CDATA #IMPLIED
        overstrike  (0 | false | none | 1 | true | all | both | left 
                       | right)  #IMPLIED>

    <!ELEMENT base (advance | rsb | lsb | attach | shift | scale)*>
    <!ATTLIST base
        PSName  CDATA #IMPLIED
        UID     CDATA #IMPLIED
        GID     CDATA #IMPLIED
        font    CDATA #IMPLIED
        noaps   CDATA #IMPLIED>

    <!ELEMENT attach (advance | rsb | lsb | shift | scale)*>
    <!ATTLIST attach
        PSName  CDATA #IMPLIED
        UID     CDATA #IMPLIED
        GID     CDATA #IMPLIED
        font    CDATA #IMPLIED
        with    CDATA #IMPLIED
        at      CDATA #IMPLIED
        noaps   CDATA #IMPLIED>

    <!ELEMENT advance EMPTY>
    <!ATTLIST advance
        width   CDATA #REQUIRED>

    <!ELEMENT rsb EMPTY>
    <!ATTLIST rsb
        width   CDATA #REQUIRED>

    <!ELEMENT lsb EMPTY>
    <!ATTLIST lsb
        width   CDATA #REQUIRED>

    <!ELEMENT shift EMPTY>
    <!ATTLIST shift
        x       CDATA #IMPLIED
        y       CDATA #IMPLIED>

    <!ELEMENT scale EMPTY>
    <!ATTLIST scale
        x       CDATA #IMPLIED
        y       CDATA #IMPLIED>

    <!ELEMENT property EMPTY>
    <!ATTLIST property
        name    CDATA #REQUIRED
        value   CDATA #REQUIRED>

    <!ELEMENT note (#PCDATA)>

From this small language, quite a lot can be done.

=head1 Attachment Points

One of the most powerful mechanisms for relating glyphs is that of attachment points.
This concept is concerned with attaching diacritics to a base character and the
attachment is achieved by specifying an attachment point on the base character
and one on the diacritic. The attachment points are usually designed as single point
paths in the glyph and their location or path number are held in a separate database.
When the attaching of the diacritic to the base character occurs, then the diacritic
is positioned so that the two attachment points coincide.

ttfbuilder works with attachment point databases represented in XML.

The DTD for an attachment point database is:

    <!ELEMENT font (glyph)*>
    <!ATTLIST font
        name    CDATA #IMPLIED
        upem    CDATA #IMPLIED
        producer    CDATA #IMPLIED>

    <!ELEMENT glyph (property* | (point | compound)* | note)>
    <!ATTLIST glyph
        PSName  CDATA #IMPLIED
        UID     CDATA #IMPLIED
        GID     CDATA #IMPLIED>

    <!ELEMENT point (location | contour)+>
    <!ATTLIST point
        type    CDATA #REQUIRED>

    <!ELEMENT location EMPTY>
    <!ATTLIST location
        x       CDATA #REQUIRED
        y       CDATA #REQUIRED>

    <!ELEMENT contour EMPTY>
    <!ATTLIST contour
        num     CDATA #REQUIRED>

    <!ELEMENT compound EMPTY>
    <!ATTLIST compound
        bbox    CDATA #REQUIRED
        PSName  CDATA #IMPLIED
        UID     CDATA #IMPLIED
        GID     CDATA #IMPLIED>

    <!ELEMENT property EMPTY>
    <!ATTLIST property
        name    CDATA #REQUIRED
        value   CDATA #REQUIRED>

    <!ELEMENT note (#PCDATA)>

A C<font> contains C<glyphs> which have attachment C<points>. Each point has a name
and either a contour (path number from 0) or a location of an attachment point (real
or virtual) in terms of C<x> and C<y> co-ordinates in em units.

A C<glyph> may also be a compound glyph in which case the boxes
representing the location of the components of the C<compound> are
listed. Each component lists a bounding box describing the location of
the component in relation to the main glyph. This is a 4 element string,
separated by comma and optional whitespace. Each element is a co-ordinate in em
units. The sequence of values is: C<xMin>, C<yMin>, C<xMax>, C<yMax>. The compound
also indicates which glyph this component refers to.

Each glyph may also contain properties. A property is a name value pair. There may only
be one property with any particular name attribute.

A glyph may have textual notes associated with it.

=cut