#!/usr/bin/perl
use Font::Fret;
use Font::TTF::Useall;

fret('Attach', @ARGV);

package Attach;

use XML::Parser::Expat;

BEGIN {
    @ISA = qw(Font::Fret::Default);
    $VERSION = "1.000";
      }

sub make_cids
{
    my ($class, $font) = @_;
    my (@map, @res, $m);
    my ($c) = $font->{'cmap'}->read->find_ms;

    if (defined $ARGV[2])
    {
        my ($xml) = XML::Parser::Expat->new();
        $xml->setHandlers('Start' => sub {
            my ($xml, $tag, %attrs) = @_;

            if ($tag eq 'glyph')
            {
                $gid = $attrs{'GID'} || $c->{'val'}{hex($attrs{'UID'})}
                    || $font->{'post'}{'STRINGS'}{$attrs{'PSName'}};
                if ($gid == 0 && ($attrs{'PSName'} || $attrs{'UID'}))
                { return $xml->xpcarp("No glyph called: $attrs{'PSName'}, Unicode: $attrs{'UID'}"); }
                $xml_dat[$gid]{'ps'} = $attrs{'PSName'};
                $xml_dat[$gid]{'UID'} = $attrs{'UID'};
            } elsif ($tag eq 'point')
            {
                $pname = $attrs{'type'};
            } elsif ($tag eq 'contour')
            {
                $xml_dat[$gid]{'points'}{$pname}{'cont'} = $attrs{'num'};
            } elsif ($tag eq 'location')
            {
                $xml_dat[$gid]{'points'}{$pname}{'loc'} = [$attrs{'x'}, $attrs{'y'}];
            } elsif ($tag eq 'font')
            {
                $fontname = $attrs{'name'};
                $fontupem = $attrs{'upem'};
            } elsif ($tag eq 'compound')
            {
                push (@{$xml_dat[$gid]{'compounds'}}, {%attrs});
            } elsif ($tag eq 'break')
            {
                $xml_dat[$gid]{'break'} = $attrs{'weight'};
            }
        });

        $xml->parsefile($ARGV[2]) || die "Can't parse $ARGV[2]";
    }

    @rev = $font->{'cmap'}->read->reverse('array' => 1);
    @map = $font->{'cmap'}->read->reverse;
    $map[$font->{'maxp'}{'numGlyphs'}] = 0;
    foreach $m (@map) { $m = 65536 if $m == 0; }
    @res = (sort {$map[$a] <=> $map[$b] || $font->{'post'}{'VAL'}[$a] cmp $font->{'post'}{'VAL'}[$b] || $a <=> $b}
            (0 .. $font->{'maxp'}{'numGlyphs'} - 1));

    return ("Glyph ID", @res);
}

sub boxhdr
{
    return ("Advance", "PSName", "GID", "Unicode");
}

sub lowdat
{
    my ($class, $cid, $gid, $glyph, $uid, $font) = @_;

    return ($font->{'hmtx'}{'advance'}[$gid], "r|$font->{'post'}{'VAL'}[$gid]");
}

sub topdat
{
    my ($class, $cid, $gid, $glyph, $uid, $font) = @_;

    return ($gid, "r,r|" . join(',', map {sprintf("|U+%04X", $_)} sort {$a <=> $b} @{$rev[$gid]}));
}

sub row1hdr
{
    my ($class, $font) = @_;
    my ($i);

    for ($i = 0; $i < $font->{'cmap'}{'Num'}; $i++)
    {
        if ($font->{'cmap'}{'Tables'}[$i]{'Platform'} == 1)
        { @macrev = $font->{'cmap'}->reverse('tnum' => $i); last; }
    }

    return ('PSName', 'GID', 'UID', 'Macid',
            'r,b|adv', 'r,i|xmax', 'r,i|xmin', 'r,i|ymax', 'r,i|ymin');
}

sub row1
{
    my ($class, $cid, $gid, $glyph, $uid, $font) = @_;
    my ($aw) = $font->{'hmtx'}{'advance'}[$gid];
    my ($rsb) = $aw - $glyph->{'xMax'};

    return ($font->{'post'}{'VAL'}[$gid], $gid, 
            join(',', map {sprintf("|U+%04X", $_)} sort {$a <=> $b} @{$rev[$gid]}), $macrev[$gid],
            "r,b|$aw", "r,i|$glyph->{'xMax'}",
            "r,i|$glyph->{'xMin'}", "r,i|$glyph->{'yMax'}",
            "r,i|$glyph->{'yMin'}");
}

sub row2hdr
{
    my ($class, $font) = @_;

    return ("Attach1", "Attach2", "Attach3", "Attach4");
}

sub row2
{
    my ($class, $cid, $gid, $glyph, $uid, $font) = @_;
    my ($ptext);
    my ($p, $pc, @res);

    if (!defined $xml_dat[$gid]{'points'})
    { return (@res); }
    
    $glyph->get_points;
    foreach $p (sort keys %{$xml_dat[$gid]{'points'}})
    {
        $pc = $xml_dat[$gid]{'points'}{$p};
        $pnum = $glyph->{'endPoints'}[$pc->{'cont'}];
        $res = "$p($pc->{'cont'}:";
#        $res = "$p($pc->{'cont'},$pnum)($pc->{'loc'}[0],$pc->{'loc'}[1])";
        $res .= "$glyph->{'x'}[$pnum],$glyph->{'y'}[$pnum])";
#        $res = "$p($pc->{'cont'},$pnum)";
        push (@res, $res);
    }
    return (@res);
}

__END__

=head1 TITLE

FRET - Font REporting Tool

=head1 SYNOPSIS

  FRET [-f] [-g] [-r] [-s size] [-p package] [-q] font_file [out_file] [ap.xml]
Generates a report on a font according to a particular package. In some
contexts the package may be over-ridden. Paper size may also be specified.

=head1 OPTIONS

If no out_file is given then out_file becomes font_file.pdf (removing .ttf
if present)

  -f            Don't try to save memory on large fonts (>1000 glyphs)
  -g            Add one glyph per page report following summary report
  -h            Mode for glyph per page output. Bitfield:
                1 = bit 0       don't output point positions
  -m points     Sets glyph size in the box regardless of what is calculated
                Regardless of the consequences for clashes
  -p package    Perl package specification to use for report information
  -q            quiet mode
  -r            Don't output report lines, fill the page with glyph boxes
  -s size       paper size: a4, ltr, legal

=head1 DESCRIPTION

FRET creates a PDF report from a TrueType font containing information about
every glyph in the font. It sorts the glyphs by Unicode identifier and then
for those glyphs with no Unicode identifier it sorts them by glyph name and
then by glyph number.

In addition it is possible to get a report including a page per glyph with
a large outline of each glyph perhaps with the drawn points.

If the optional ap.xml file is specified on the command line then attachment
point information is included in the report. See ttfbuilder for details of
the ap.xml file format.

=head1 SEE ALSO

ttfbuilder

=cut
