PDF::API3::Compat::API2::Basic::TTF::Kern - Kerning tables

    $kern = $f->{'kern'}{'tables'}[$tnum]{'kerns'}{$leftnum}{$rightnum};

#=======================================================================
#    ____  ____  _____              _    ____ ___   ____
#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
#
#   A Perl Module Chain to faciliate the Creation and Modification
#   of High-Quality "Portable Document Format (PDF)" Files.
#
#=======================================================================
#
#   THIS IS A REUSED PERL MODULE, FOR PROPER LICENCING TERMS SEE BELOW:
#
#
#   Copyright Martin Hosken <Martin_Hosken@sil.org>
#
#   No warranty or expression of effectiveness, least of all regarding
#   anyone's safety, is implied in this software or documentation.
#
#   This specific module is licensed under the Perl Artistic License.
#
#
#   $Id: Kern.pm,v 2.0 2005/11/16 02:16:00 areibens Exp $
#
#=======================================================================
package PDF::API3::Compat::API2::Basic::TTF::Kern;

use strict;
use vars qw(@ISA);
use PDF::API3::Compat::API2::Basic::TTF::Utils;
use PDF::API3::Compat::API2::Basic::TTF::Table;

@ISA = qw(PDF::API3::Compat::API2::Basic::TTF::Table);

sub read
{
    my ($self) = @_;
    my ($fh) = $self->{' INFILE'};
    my ($dat, $i, $numt, $len, $cov, $t);

    $self->SUPER::read or return $self;

    $fh->read($dat, 4);
    ($self->{'Version'}, $numt) = unpack("n2", $dat);
    $self->{'Num'} = $numt;

    for ($i = 0; $i < $numt; $i++)
    {
        $t = {};
        $fh->read($dat, 6);
        ($t->{'Version'}, $len, $cov) = unpack("n3", $dat);
        $t->{'coverage'} = $cov & 255;
        $t->{'type'} = $cov >> 8;
        $fh->read($dat, $len - 6);
        if ($t->{'Version'} == 0)
        {
            my ($j);

            $t->{'Num'} = unpack("n", $dat);
            for ($j = 0; $j < $t->{'Num'}; $j++)
            {
                my ($f, $l, $v) = TTF_Unpack("SSs", substr($dat, $j * 6 + 8, 6));
                $t->{'kern'}{$f}{$l} = $v;
            }
        } elsif ($t->{'Version'} == 2)
        {
            my ($wid, $off, $numg, $maxl, $maxr, $j);

            $wid = unpack("n", $dat);
            $off = unpack("n", substr($dat, 2));
            ($t->{'left_first'}, $numg) = unpack("n2", substr($dat, $off));
            $t->{'left'} = [unpack("C$numg", substr($dat, $off + 4))];
            foreach (@{$t->{'left'}})
            {
                $_ /= $wid;
                $maxl = $_ if ($_ > $maxl);
            }
            $t->{'left_max'} = $maxl;

            $off = unpack("n", substr($dat, 4));
            ($t->{'right_first'}, $numg) = unpack("n2", substr($dat, $off));
            $t->{'right'} = [unpack("C$numg", substr($dat, $off + 4))];
            foreach (@{$t->{'right'}})
            {
                $_ >>= 1;
                $maxr = $_ if ($_ > $maxr);
            }
            $t->{'right_max'} = $maxr;

            $off = unpack("n", substr($dat, 6));
            for ($j = 0; $j <= $maxl; $j++)
            {
                my ($k) = 0;

                map { $t->{'kern'}{$j}{$k} = $_ if $_; $k++; }
                        unpack("n$maxr", substr($dat, $off + $wid * $j));
            }
        }
        push (@{$self->{'tables'}}, $t);
    }
    $self;
}

sub out
{
    my ($self, $fh) = @_;
    my ($i, $l, $r, $loc, $loc1, $t);

    return $self->SUPER::out($fh) unless ($self->{' read'});

    $fh->print(pack("n2", $self->{'Version'}, $self->{'Num'}));
    for ($i = 0; $i < $self->{'Num'}; $i++)
    {
        $t = $self->{'tables'}[$i];
        $loc = $fh->tell();

        $fh->print(pack("nnn", $t->{'Version'}, 0, $t->{'coverage'}));
        if ($t->{'Version'} == 0)
        {
            my ($dat);
            foreach $l (sort {$a <=> $b} keys %{$t->{'kern'}})
            {
                foreach $r (sort {$a <=> $b} keys %{$t->{'kern'}{$l}})
                { $dat .= TTF_Pack("SSs", $l, $r, $t->{'kern'}{$l}{$r}); }
            }
            $fh->print(TTF_Pack("SSSS", PDF::API3::Compat::API2::Basic::TTF::Utils::TTF_bininfo(length($dat) / 6, 6)));
            $fh->print($dat);
        } elsif ($t->{'Version'} == 2)
        {
            my ($arr);

            $fh->print(pack("nnnn", $t->{'right_max'} << 1, 8, ($#{$t->{'left'}} + 7) << 1,
                    ($#{$t->{'left'}} + $#{$t->{'right'}} + 10) << 1));

            $fh->print(pack("nn", $t->{'left_first'}, $#{$t->{'left'}} + 1));
            foreach (@{$t->{'left'}})
            { $fh->print(pack("C", $_ * (($t->{'left_max'} + 1) << 1))); }

            $fh->print(pack("nn", $t->{'right_first'}, $#{$t->{'right'}} + 1));
            foreach (@{$t->{'right'}})
            { $fh->print(pack("C", $_ << 1)); }

            $arr = "\000\000" x (($t->{'left_max'} + 1) * ($t->{'right_max'} + 1));
            foreach $l (keys %{$t->{'kern'}})
            {
                foreach $r (keys %{$t->{'kern'}{$l}})
                { substr($arr, ($l * ($t->{'left_max'} + 1) + $r) << 1, 2)
                        = pack("n", $t->{'kern'}{$l}{$r}); }
            }
            $fh->print($arr);
        }
        $loc1 = $fh->tell();
        $fh->seek($loc + 2, 0);
        $fh->print(pack("n", $loc1 - $loc));
        $fh->seek($loc1, 0);
    }
    $self;
}

sub XML_element
{
    my ($self) = shift;
    my ($context, $depth, $key, $value) = @_;
    my ($fh) = $context->{'fh'};
    my ($f, $l);

    return $self->SUPER::XML_element(@_) unless ($key eq 'kern');
    $fh->print("$depth<kern-table>\n");
    foreach $f (sort {$a <=> $b} keys %{$value})
    {
        foreach $l (sort {$a <=> $b} keys %{$value->{$f}})
        { $fh->print("$depth$context->{'indent'}<adjust first='$f' last='$l' dist='$value->{$f}{$l}'/>\n"); }
    }
    $fh->print("$depth</kern-table>\n");
    $self;
}

1;