Blame lib/Font/TTF/AATutils.pm

Packit 5d935b
package Font::TTF::AATutils;
Packit 5d935b
Packit 5d935b
=head1 NAME
Packit 5d935b
Packit 5d935b
Font::TTF::AATutils - Utility functions for AAT tables
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
use strict;
Packit 5d935b
use vars qw(@ISA @EXPORT);
Packit 5d935b
require Exporter;
Packit 5d935b
Packit 5d935b
use Font::TTF::Utils;
Packit 5d935b
use Font::TTF::Segarr;
Packit 5d935b
use IO::File;
Packit 5d935b
Packit 5d935b
@ISA = qw(Exporter);
Packit 5d935b
@EXPORT = qw(
Packit 5d935b
    AAT_read_lookup
Packit 5d935b
    AAT_pack_lookup
Packit 5d935b
    AAT_write_lookup
Packit 5d935b
    AAT_pack_classes
Packit 5d935b
    AAT_write_classes
Packit 5d935b
    AAT_pack_states
Packit 5d935b
    AAT_write_states
Packit 5d935b
    AAT_read_state_table
Packit 5d935b
    AAT_read_subtable
Packit 5d935b
    xmldump
Packit 5d935b
);
Packit 5d935b
Packit 5d935b
sub xmldump
Packit 5d935b
{
Packit 5d935b
    my ($var, $links, $depth, $processedVars, $type) = @_;
Packit 5d935b
Packit 5d935b
    $processedVars = {} unless (defined $processedVars);
Packit 5d935b
    print("\n") if $depth == 0;    # not necessarily true encoding for all text!
Packit 5d935b
Packit 5d935b
    my $indent = "\t" x $depth;
Packit 5d935b
Packit 5d935b
    my ($objType, $addr) = ($var =~ m/^.+=(.+)\((.+)\)$/);
Packit 5d935b
    unless (defined $type) {
Packit 5d935b
        if (defined $addr) {
Packit 5d935b
            if (defined $processedVars->{$addr}) {
Packit 5d935b
                if ($links) {
Packit 5d935b
                    printf("%s%s\n", $indent, "$objType");
Packit 5d935b
                }
Packit 5d935b
                else {
Packit 5d935b
                    printf("%s%s\n", $indent, "$objType");
Packit 5d935b
                }
Packit 5d935b
                return;
Packit 5d935b
            }
Packit 5d935b
            $processedVars->{$addr} = 1;
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    $type = ref $var unless defined $type;
Packit 5d935b
    
Packit 5d935b
    if ($type eq 'REF') {
Packit 5d935b
        printf("%s<ref val=\"%s\"/>\n", $indent, $$var);
Packit 5d935b
    }
Packit 5d935b
    elsif ($type eq 'SCALAR') {
Packit 5d935b
        printf("%s<scalar>%s</scalar>\n", $indent, $var);
Packit 5d935b
    }
Packit 5d935b
    elsif ($type eq 'ARRAY') {
Packit 5d935b
        # printf("%s<array>\n", $indent);
Packit 5d935b
        foreach (0 .. $#$var) {
Packit 5d935b
            if (ref($var->[$_])) {
Packit 5d935b
                printf("%s<arrayItem index=\"%d\">\n", $indent, $_);
Packit 5d935b
                xmldump($var->[$_], $links, $depth + 1, $processedVars);
Packit 5d935b
                printf("%s</arrayItem>\n", $indent);
Packit 5d935b
            }
Packit 5d935b
            else {
Packit 5d935b
                printf("%s<arrayItem index=\"%d\">%s</arrayItem>\n", $indent, $_, $var->[$_]);
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
        # printf("%s</array>\n", $indent);
Packit 5d935b
    }
Packit 5d935b
    elsif ($type eq 'HASH') {
Packit 5d935b
        # printf("%s<hash>\n", $indent);
Packit 5d935b
        foreach (sort keys %$var) {
Packit 5d935b
            if (ref($var->{$_})) {
Packit 5d935b
                printf("%s<hashElem key=\"%s\">\n", $indent, $_);
Packit 5d935b
                xmldump($var->{$_}, $links, $depth + 1, $processedVars);
Packit 5d935b
                printf("%s</hashElem>\n", $indent);
Packit 5d935b
            }
Packit 5d935b
            else {
Packit 5d935b
                printf("%s<hashElem key=\"%s\">%s</hashElem>\n", $indent, $_, $var->{$_});
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
        # printf("%s</hash>\n", $indent);
Packit 5d935b
    }
Packit 5d935b
    elsif ($type eq 'CODE') {
Packit 5d935b
        printf("%s\n", $indent, $var);
Packit 5d935b
    }
Packit 5d935b
    elsif ($type eq 'GLOB') {
Packit 5d935b
        printf("%s<GLOB/>\n", $indent, $var);
Packit 5d935b
    }
Packit 5d935b
    elsif ($type eq '') {
Packit 5d935b
        printf("%s<val>%s</val>\n", $indent, $var);
Packit 5d935b
    }
Packit 5d935b
    else {
Packit 5d935b
        if ($links) {
Packit 5d935b
            printf("%s<obj class=\"%s\" id=\"#%s\">\n", $indent, $type, $addr);
Packit 5d935b
        }
Packit 5d935b
        else {
Packit 5d935b
            printf("%s<obj class=\"%s\">\n", $indent, $type);
Packit 5d935b
        }
Packit 5d935b
        xmldump($var, $links, $depth + 1, $processedVars, $objType);
Packit 5d935b
        printf("%s</obj>\n", $indent);
Packit 5d935b
    }
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
=head2 ($classes, $states) = AAT_read_subtable($fh, $baseOffset, $subtableStart, $limits)
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub AAT_read_subtable
Packit 5d935b
{
Packit 5d935b
    my ($fh, $baseOffset, $subtableStart, $limits) = @_;
Packit 5d935b
    
Packit 5d935b
    my $limit = 0xffffffff;
Packit 5d935b
    foreach (@$limits) {
Packit 5d935b
        $limit = $_ if ($_ > $subtableStart and $_ < $limit);
Packit 5d935b
    }
Packit 5d935b
    die if $limit == 0xffffffff;
Packit 5d935b
    
Packit 5d935b
    my $dat;
Packit 5d935b
    $fh->seek($baseOffset + $subtableStart, IO::File::SEEK_SET);
Packit 5d935b
    $fh->read($dat, $limit - $subtableStart);
Packit 5d935b
    
Packit 5d935b
    $dat;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
=head2 $length = AAT_write_state_table($fh, $classes, $states, $numExtraTables, $packEntry)
Packit 5d935b
Packit 5d935b
$packEntry is a subroutine for packing an entry into binary form, called as
Packit 5d935b
Packit 5d935b
$dat = $packEntry($entry, $entryTable, $numEntries)
Packit 5d935b
Packit 5d935b
where the entry is a comma-separated list of nextStateOffset, flags, actions
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub AAT_pack_state_table
Packit 5d935b
{
Packit 5d935b
    my ($classes, $states, $numExtraTables, $packEntry) = @_;
Packit 5d935b
    
Packit 5d935b
    my ($dat) = pack("n*", (0) x (4 + $numExtraTables));    # placeholders for stateSize, classTable, stateArray, entryTable
Packit 5d935b
    
Packit 5d935b
    my ($firstGlyph, $lastGlyph) = (0xffff, 0, 0);
Packit 5d935b
    my (@classTable, $i);
Packit 5d935b
    foreach $i (0 .. $#$classes) {
Packit 5d935b
        my $class = $classes->[$i];
Packit 5d935b
        foreach (@$class) {
Packit 5d935b
            $firstGlyph = $_ if $_ < $firstGlyph;
Packit 5d935b
            $lastGlyph = $_ if $_ > $lastGlyph;
Packit 5d935b
            $classTable[$_] = $i;
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    my $classTable = length($dat);
Packit 5d935b
    $dat .= pack("nnC*", $firstGlyph, $lastGlyph - $firstGlyph + 1,
Packit 5d935b
                    map { defined $classTable[$_] ? $classTable[$_] : 1 } ($firstGlyph .. $lastGlyph));
Packit 5d935b
    $dat .= pack("C", 0) if (($lastGlyph - $firstGlyph) & 1) == 0;    # pad if odd number of glyphs
Packit 5d935b
    
Packit 5d935b
    my $stateArray = length($dat);
Packit 5d935b
    my (@entries, %entries);
Packit 5d935b
    my $state = $states->[0];
Packit 5d935b
    my $stateSize = @$state;
Packit 5d935b
    die "stateSize below minimum allowed (4)" if $stateSize < 4;
Packit 5d935b
    die "stateSize (" . $stateSize . ") too small for max class number (" . $#$classes . ")" if $stateSize < $#$classes + 1;
Packit 5d935b
    warn "state array has unreachable columns" if $stateSize > $#$classes + 1;
Packit 5d935b
Packit 5d935b
    foreach (@$states) {
Packit 5d935b
        die "inconsistent state size" if @$_ != $stateSize;
Packit 5d935b
        foreach (@$_) {
Packit 5d935b
            my $actions = $_->{'actions'};
Packit 5d935b
            my $entry = join(",", $stateArray + $_->{'nextState'} * $stateSize, $_->{'flags'}, ref($actions) eq 'ARRAY' ? @$actions : $actions);
Packit 5d935b
            if (not defined $entries{$entry}) {
Packit 5d935b
                push @entries, $entry;
Packit 5d935b
                $entries{$entry} = $#entries;
Packit 5d935b
                die "too many different state array entries" if $#entries == 256;
Packit 5d935b
            }
Packit 5d935b
            $dat .= pack("C", $entries{$entry});
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    $dat .= pack("C", 0) if (@$states & 1) != 0 and ($stateSize & 1) != 0;    # pad if state array size is odd
Packit 5d935b
    
Packit 5d935b
    my $entryTable = length($dat);
Packit 5d935b
    $dat .= map { &$packEntry($_, $entryTable, $#entries + 1) } @entries;
Packit 5d935b
    
Packit 5d935b
    my ($dat1) = pack("nnnn", $stateSize, $classTable, $stateArray, $entryTable);
Packit 5d935b
    substr($dat, 0, length($dat1)) = $dat1;
Packit 5d935b
    
Packit 5d935b
    return $dat;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
sub AAT_write_state_table
Packit 5d935b
{
Packit 5d935b
    my ($fh, $classes, $states, $numExtraTables, $packEntry) = @_;
Packit 5d935b
    
Packit 5d935b
    my $stateTableStart = $fh->tell();
Packit 5d935b
Packit 5d935b
    $fh->print(pack("n*", (0) x (4 + $numExtraTables)));    # placeholders for stateSize, classTable, stateArray, entryTable
Packit 5d935b
    
Packit 5d935b
    my ($firstGlyph, $lastGlyph) = (0xffff, 0, 0);
Packit 5d935b
    my (@classTable, $i);
Packit 5d935b
    foreach $i (0 .. $#$classes) {
Packit 5d935b
        my $class = $classes->[$i];
Packit 5d935b
        foreach (@$class) {
Packit 5d935b
            $firstGlyph = $_ if $_ < $firstGlyph;
Packit 5d935b
            $lastGlyph = $_ if $_ > $lastGlyph;
Packit 5d935b
            $classTable[$_] = $i;
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    my $classTable = $fh->tell() - $stateTableStart;
Packit 5d935b
    $fh->print(pack("nnC*", $firstGlyph, $lastGlyph - $firstGlyph + 1,
Packit 5d935b
                    map { defined $classTable[$_] ? $classTable[$_] : 1 } ($firstGlyph .. $lastGlyph)));
Packit 5d935b
    $fh->print(pack("C", 0)) if (($lastGlyph - $firstGlyph) & 1) == 0;    # pad if odd number of glyphs
Packit 5d935b
    
Packit 5d935b
    my $stateArray = $fh->tell() - $stateTableStart;
Packit 5d935b
    my (@entries, %entries);
Packit 5d935b
    my $state = $states->[0];
Packit 5d935b
    my $stateSize = @$state;
Packit 5d935b
    die "stateSize below minimum allowed (4)" if $stateSize < 4;
Packit 5d935b
    die "stateSize (" . $stateSize . ") too small for max class number (" . $#$classes . ")" if $stateSize < $#$classes + 1;
Packit 5d935b
    warn "state array has unreachable columns" if $stateSize > $#$classes + 1;
Packit 5d935b
Packit 5d935b
    foreach (@$states) {
Packit 5d935b
        die "inconsistent state size" if @$_ != $stateSize;
Packit 5d935b
        foreach (@$_) {
Packit 5d935b
            my $actions = $_->{'actions'};
Packit 5d935b
            my $entry = join(",", $stateArray + $_->{'nextState'} * $stateSize, $_->{'flags'}, ref($actions) eq 'ARRAY' ? @$actions : $actions);
Packit 5d935b
            if (not defined $entries{$entry}) {
Packit 5d935b
                push @entries, $entry;
Packit 5d935b
                $entries{$entry} = $#entries;
Packit 5d935b
                die "too many different state array entries" if $#entries == 256;
Packit 5d935b
            }
Packit 5d935b
            $fh->print(pack("C", $entries{$entry}));
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    $fh->print(pack("C", 0)) if (@$states & 1) != 0 and ($stateSize & 1) != 0;    # pad if state array size is odd
Packit 5d935b
    
Packit 5d935b
    my $entryTable = $fh->tell() - $stateTableStart;
Packit 5d935b
    $fh->print(map { &$packEntry($_, $entryTable, $#entries + 1) } @entries);
Packit 5d935b
    
Packit 5d935b
    my $length = $fh->tell() - $stateTableStart;
Packit 5d935b
    $fh->seek($stateTableStart, IO::File::SEEK_SET);
Packit 5d935b
    $fh->print(pack("nnnn", $stateSize, $classTable, $stateArray, $entryTable));
Packit 5d935b
    
Packit 5d935b
    $fh->seek($stateTableStart + $length, IO::File::SEEK_SET);
Packit 5d935b
    $length;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
sub AAT_pack_classes
Packit 5d935b
{
Packit 5d935b
    my ($classes) = @_;
Packit 5d935b
    
Packit 5d935b
    my ($firstGlyph, $lastGlyph) = (0xffff, 0, 0);
Packit 5d935b
    my (@classTable, $i);
Packit 5d935b
    foreach $i (0 .. $#$classes) {
Packit 5d935b
        my $class = $classes->[$i];
Packit 5d935b
        foreach (@$class) {
Packit 5d935b
            $firstGlyph = $_ if $_ < $firstGlyph;
Packit 5d935b
            $lastGlyph = $_ if $_ > $lastGlyph;
Packit 5d935b
            $classTable[$_] = $i;
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    my ($dat) = pack("nnC*", $firstGlyph, $lastGlyph - $firstGlyph + 1,
Packit 5d935b
                    map { defined $classTable[$_] ? $classTable[$_] : 1 } ($firstGlyph .. $lastGlyph));
Packit 5d935b
    $dat .= pack("C", 0) if (($lastGlyph - $firstGlyph) & 1) == 0;    # pad if odd number of glyphs
Packit 5d935b
    
Packit 5d935b
    return $dat;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
sub AAT_write_classes
Packit 5d935b
{
Packit 5d935b
    my ($fh, $classes) = @_;
Packit 5d935b
    
Packit 5d935b
    $fh->print(AAT_pack_classes($fh, $classes));
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
sub AAT_pack_states
Packit 5d935b
{
Packit 5d935b
    my ($classes, $stateArray, $states, $buildEntryProc) = @_;
Packit 5d935b
    
Packit 5d935b
    my ($entries, %entryHash);
Packit 5d935b
    my $state = $states->[0];
Packit 5d935b
    my $stateSize = @$state;
Packit 5d935b
    
Packit 5d935b
    die "stateSize below minimum allowed (4)" if $stateSize < 4;
Packit 5d935b
    die "stateSize (" . $stateSize . ") too small for max class number (" . $#$classes . ")" if $stateSize < $#$classes + 1;
Packit 5d935b
    warn "state array has unreachable columns" if $stateSize > $#$classes + 1;
Packit 5d935b
    
Packit 5d935b
    my ($dat);
Packit 5d935b
    foreach (@$states) {
Packit 5d935b
        die "inconsistent state size" if @$_ != $stateSize;
Packit 5d935b
        foreach (@$_) {
Packit 5d935b
            my $entry = join(",", $stateArray + $_->{'nextState'} * $stateSize, &$buildEntryProc($_));
Packit 5d935b
            if (not defined $entryHash{$entry}) {
Packit 5d935b
                push @$entries, $entry;
Packit 5d935b
                $entryHash{$entry} = $#$entries;
Packit 5d935b
                die "too many different state array entries" if $#$entries == 256;
Packit 5d935b
            }
Packit 5d935b
            $dat .= pack("C", $entryHash{$entry});
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    $dat .= pack("C", 0) if (@$states & 1) != 0 and ($stateSize & 1) != 0;    # pad if state array size is odd
Packit 5d935b
Packit 5d935b
    ($dat, $stateSize, $entries);
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
sub AAT_write_states
Packit 5d935b
{
Packit 5d935b
    my ($fh, $classes, $stateArray, $states, $buildEntryProc) = @_;
Packit 5d935b
    
Packit 5d935b
    my ($entries, %entryHash);
Packit 5d935b
    my $state = $states->[0];
Packit 5d935b
    my $stateSize = @$state;
Packit 5d935b
    
Packit 5d935b
    die "stateSize below minimum allowed (4)" if $stateSize < 4;
Packit 5d935b
    die "stateSize (" . $stateSize . ") too small for max class number (" . $#$classes . ")" if $stateSize < $#$classes + 1;
Packit 5d935b
    warn "state array has unreachable columns" if $stateSize > $#$classes + 1;
Packit 5d935b
Packit 5d935b
    foreach (@$states) {
Packit 5d935b
        die "inconsistent state size" if @$_ != $stateSize;
Packit 5d935b
        foreach (@$_) {
Packit 5d935b
            my $entry = join(",", $stateArray + $_->{'nextState'} * $stateSize, &$buildEntryProc($_));
Packit 5d935b
            if (not defined $entryHash{$entry}) {
Packit 5d935b
                push @$entries, $entry;
Packit 5d935b
                $entryHash{$entry} = $#$entries;
Packit 5d935b
                die "too many different state array entries" if $#$entries == 256;
Packit 5d935b
            }
Packit 5d935b
            $fh->print(pack("C", $entryHash{$entry}));
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    $fh->print(pack("C", 0)) if (@$states & 1) != 0 and ($stateSize & 1) != 0;    # pad if state array size is odd
Packit 5d935b
Packit 5d935b
    ($stateSize, $entries);
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
=head2 ($classes, $states, $entries) = AAT_read_state_table($fh, $numActionWords)
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub AAT_read_state_table
Packit 5d935b
{
Packit 5d935b
    my ($fh, $numActionWords) = @_;
Packit 5d935b
    
Packit 5d935b
    my $stateTableStart = $fh->tell();
Packit 5d935b
    my $dat;
Packit 5d935b
    $fh->read($dat, 8);
Packit 5d935b
    my ($stateSize, $classTable, $stateArray, $entryTable) = unpack("nnnn", $dat);
Packit 5d935b
    
Packit 5d935b
    my $classes;    # array of lists of glyphs
Packit 5d935b
Packit 5d935b
    $fh->seek($stateTableStart + $classTable, IO::File::SEEK_SET);
Packit 5d935b
    $fh->read($dat, 4);
Packit 5d935b
    my ($firstGlyph, $nGlyphs) = unpack("nn", $dat);
Packit 5d935b
    $fh->read($dat, $nGlyphs);
Packit 5d935b
    foreach (unpack("C*", $dat)) {
Packit 5d935b
        if ($_ != 1) {
Packit 5d935b
            my $class = $classes->[$_];
Packit 5d935b
            push(@$class, $firstGlyph);
Packit 5d935b
            $classes->[$_] = $class unless defined $classes->[$_];
Packit 5d935b
        }
Packit 5d935b
        $firstGlyph++;
Packit 5d935b
    }
Packit 5d935b
Packit 5d935b
    $fh->seek($stateTableStart + $stateArray, IO::File::SEEK_SET);
Packit 5d935b
    my $states;    # array of arrays of hashes{nextState, flags, actions}
Packit 5d935b
Packit 5d935b
    my $entrySize = 4 + ($numActionWords * 2);
Packit 5d935b
    my $lastState = 1;
Packit 5d935b
    my $entries;
Packit 5d935b
    while ($#$states < $lastState) {
Packit 5d935b
        $fh->read($dat, $stateSize);
Packit 5d935b
        my @stateEntries = unpack("C*", $dat);
Packit 5d935b
        my $state;
Packit 5d935b
        foreach (@stateEntries) {
Packit 5d935b
            if (not defined $entries->[$_]) {
Packit 5d935b
                my $loc = $fh->tell();
Packit 5d935b
                $fh->seek($stateTableStart + $entryTable + ($_ * $entrySize), IO::File::SEEK_SET);
Packit 5d935b
                $fh->read($dat, $entrySize);
Packit 5d935b
                my ($nextState, $flags, $actions);
Packit 5d935b
                ($nextState, $flags, @$actions) = unpack("n*", $dat);
Packit 5d935b
                $nextState -= $stateArray;
Packit 5d935b
                $nextState /= $stateSize;
Packit 5d935b
                $entries->[$_] = { 'nextState' => $nextState, 'flags' => $flags };
Packit 5d935b
                $entries->[$_]->{'actions'} = $actions if $numActionWords > 0;
Packit 5d935b
                $lastState = $nextState if ($nextState > $lastState);
Packit 5d935b
                $fh->seek($loc, IO::File::SEEK_SET);
Packit 5d935b
            }
Packit 5d935b
            push(@$state, $entries->[$_]);
Packit 5d935b
        }
Packit 5d935b
        push(@$states, $state);
Packit 5d935b
    }
Packit 5d935b
Packit 5d935b
    ($classes, $states, $entries);
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
=head2 ($format, $lookup) = AAT_read_lookup($fh, $valueSize, $length, $default)
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub AAT_read_lookup
Packit 5d935b
{
Packit 5d935b
    my ($fh, $valueSize, $length, $default) = @_;
Packit 5d935b
Packit 5d935b
    my $lookupStart = $fh->tell();
Packit 5d935b
    my ($dat, $unpackChar);
Packit 5d935b
    if ($valueSize == 1) {
Packit 5d935b
        $unpackChar = "C";
Packit 5d935b
    }
Packit 5d935b
    elsif ($valueSize == 2) {
Packit 5d935b
        $unpackChar = "n";
Packit 5d935b
    }
Packit 5d935b
    elsif ($valueSize == 4) {
Packit 5d935b
        $unpackChar = "N";
Packit 5d935b
    }
Packit 5d935b
    else {
Packit 5d935b
        die "unsupported value size";
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    $fh->read($dat, 2);
Packit 5d935b
    my $format = unpack("n", $dat);
Packit 5d935b
    my $lookup;
Packit 5d935b
    
Packit 5d935b
    if ($format == 0) {
Packit 5d935b
        $fh->read($dat, $length - 2);
Packit 5d935b
        my $i = -1;
Packit 5d935b
        $lookup = { map { $i++; ($_ != $default) ? ($i, $_) : () } unpack($unpackChar . "*", $dat) };
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    elsif ($format == 2) {
Packit 5d935b
        $fh->read($dat, 10);
Packit 5d935b
        my ($unitSize, $nUnits, $searchRange, $entrySelector, $rangeShift) = unpack("nnnnn", $dat);
Packit 5d935b
        die if $unitSize != 4 + $valueSize;
Packit 5d935b
        foreach (1 .. $nUnits) {
Packit 5d935b
            $fh->read($dat, $unitSize);
Packit 5d935b
            my ($lastGlyph, $firstGlyph, $value) = unpack("nn" . $unpackChar, $dat);
Packit 5d935b
            if ($firstGlyph != 0xffff and $value != $default) {
Packit 5d935b
                foreach ($firstGlyph .. $lastGlyph) {
Packit 5d935b
                    $lookup->{$_} = $value;
Packit 5d935b
                }
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    elsif ($format == 4) {
Packit 5d935b
        $fh->read($dat, 10);
Packit 5d935b
        my ($unitSize, $nUnits, $searchRange, $entrySelector, $rangeShift) = unpack("nnnnn", $dat);
Packit 5d935b
        die if $unitSize != 6;
Packit 5d935b
        foreach (1 .. $nUnits) {
Packit 5d935b
            $fh->read($dat, $unitSize);
Packit 5d935b
            my ($lastGlyph, $firstGlyph, $offset) = unpack("nnn", $dat);
Packit 5d935b
            if ($firstGlyph != 0xffff) {
Packit 5d935b
                my $loc = $fh->tell();
Packit 5d935b
                $fh->seek($lookupStart + $offset, IO::File::SEEK_SET);
Packit 5d935b
                $fh->read($dat, ($lastGlyph - $firstGlyph + 1) * $valueSize);
Packit 5d935b
                my @values = unpack($unpackChar . "*", $dat);
Packit 5d935b
                foreach (0 .. $lastGlyph - $firstGlyph) {
Packit 5d935b
                    $lookup->{$firstGlyph + $_} = $values[$_] if $values[$_] != $default;
Packit 5d935b
                }
Packit 5d935b
                $fh->seek($loc, IO::File::SEEK_SET);
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    elsif ($format == 6) {
Packit 5d935b
        $fh->read($dat, 10);
Packit 5d935b
        my ($unitSize, $nUnits, $searchRange, $entrySelector, $rangeShift) = unpack("nnnnn", $dat);
Packit 5d935b
        die if $unitSize != 2 + $valueSize;
Packit 5d935b
        foreach (1 .. $nUnits) {
Packit 5d935b
            $fh->read($dat, $unitSize);
Packit 5d935b
            my ($glyph, $value) = unpack("n" . $unpackChar, $dat);
Packit 5d935b
            $lookup->{$glyph} = $value if $glyph != 0xffff and $value != $default;
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    elsif ($format == 8) {
Packit 5d935b
        $fh->read($dat, 4);
Packit 5d935b
        my ($firstGlyph, $glyphCount) = unpack("nn", $dat);
Packit 5d935b
        $fh->read($dat, $glyphCount * $valueSize);
Packit 5d935b
        $firstGlyph--;
Packit 5d935b
        $lookup = { map { $firstGlyph++; $_ != $default ? ($firstGlyph, $_) : () } unpack($unpackChar . "*", $dat) };
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    else {
Packit 5d935b
        die "unknown lookup format";
Packit 5d935b
    }
Packit 5d935b
Packit 5d935b
    $fh->seek($lookupStart + $length, IO::File::SEEK_SET);
Packit 5d935b
Packit 5d935b
    ($format, $lookup);
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
=head2 AAT_write_lookup($fh, $format, $lookup, $valueSize, $default)
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b
Packit 5d935b
sub AAT_pack_lookup
Packit 5d935b
{
Packit 5d935b
    my ($format, $lookup, $valueSize, $default) = @_;
Packit 5d935b
Packit 5d935b
    my $packChar;
Packit 5d935b
    if ($valueSize == 1) {
Packit 5d935b
        $packChar = "C";
Packit 5d935b
    }
Packit 5d935b
    elsif ($valueSize == 2) {
Packit 5d935b
        $packChar = "n";
Packit 5d935b
    }
Packit 5d935b
    elsif ($valueSize == 4) {
Packit 5d935b
        $packChar = "N";
Packit 5d935b
    }
Packit 5d935b
    else {
Packit 5d935b
        die "unsupported value size";
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    my ($dat) = pack("n", $format);
Packit 5d935b
Packit 5d935b
    my ($firstGlyph, $lastGlyph) = (0xffff, 0);
Packit 5d935b
    foreach (keys %$lookup) {
Packit 5d935b
        $firstGlyph = $_ if $_ < $firstGlyph;
Packit 5d935b
        $lastGlyph = $_ if $_ > $lastGlyph;
Packit 5d935b
    }
Packit 5d935b
    my $glyphCount = $lastGlyph - $firstGlyph + 1;
Packit 5d935b
Packit 5d935b
    if ($format == 0) {
Packit 5d935b
        $dat .= pack($packChar . "*", map { defined $lookup->{$_} ? $lookup->{$_} : defined $default ? $default : $_ } (0 .. $lastGlyph));
Packit 5d935b
    }
Packit 5d935b
Packit 5d935b
    elsif ($format == 2) {
Packit 5d935b
        my $prev = $default;
Packit 5d935b
        my $segStart = $firstGlyph;
Packit 5d935b
        my $dat1;
Packit 5d935b
        foreach ($firstGlyph .. $lastGlyph + 1) {
Packit 5d935b
            my $val = $lookup->{$_};
Packit 5d935b
            $val = $default unless defined $val;
Packit 5d935b
            if ($val != $prev) {
Packit 5d935b
                $dat1 .= pack("nn" . $packChar, $_ - 1, $segStart, $prev) if $prev != $default;
Packit 5d935b
                $prev = $val;
Packit 5d935b
                $segStart = $_;
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
        $dat1 .= pack("nn" . $packChar, 0xffff, 0xffff, 0);
Packit 5d935b
        my $unitSize = 4 + $valueSize;
Packit 5d935b
        $dat .= pack("nnnnn", $unitSize, TTF_bininfo(length($dat1) / $unitSize, $unitSize));
Packit 5d935b
        $dat .= $dat1;
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    elsif ($format == 4) {
Packit 5d935b
        my $segArray = new Font::TTF::Segarr($valueSize);
Packit 5d935b
        $segArray->add_segment($firstGlyph, 1, map { $lookup->{$_} } ($firstGlyph .. $lastGlyph));
Packit 5d935b
        my ($start, $end, $offset);
Packit 5d935b
        $offset = 12 + @$segArray * 6 + 6;    # 12 is size of format word + binSearchHeader; 6 bytes per segment; 6 for terminating segment
Packit 5d935b
        my $dat1;
Packit 5d935b
        foreach (@$segArray) {
Packit 5d935b
            $start = $_->{'START'};
Packit 5d935b
            $end = $start + $_->{'LEN'} - 1;
Packit 5d935b
            $dat1 .= pack("nnn", $end, $start, $offset);
Packit 5d935b
            $offset += $_->{'LEN'} * 2;
Packit 5d935b
        }
Packit 5d935b
        $dat1 .= pack("nnn", 0xffff, 0xffff, 0);
Packit 5d935b
        $dat .= pack("nnnnn", 6, TTF_bininfo(length($dat1) / 6, 6));
Packit 5d935b
        $dat .= $dat1;
Packit 5d935b
        foreach (@$segArray) {
Packit 5d935b
            $dat1 = $_->{'VAL'};
Packit 5d935b
            $dat .= pack($packChar . "*", @$dat1);
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    elsif ($format == 6) {
Packit 5d935b
        die "unsupported" if $valueSize != 2;
Packit 5d935b
        my $dat1 = pack("n*", map { $_, $lookup->{$_} } sort { $a <=> $b } grep { $lookup->{$_} ne $default } keys %$lookup);
Packit 5d935b
        my $unitSize = 2 + $valueSize;
Packit 5d935b
        $dat .= pack("nnnnn", $unitSize, TTF_bininfo(length($dat1) / $unitSize, $unitSize));
Packit 5d935b
        $dat .= $dat1;
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    elsif ($format == 8) {
Packit 5d935b
        $dat .= pack("nn", $firstGlyph, $lastGlyph - $firstGlyph + 1);
Packit 5d935b
        $dat .= pack($packChar . "*", map { defined $lookup->{$_} ? $lookup->{$_} : defined $default ? $default : $_ } ($firstGlyph .. $lastGlyph));
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    else {
Packit 5d935b
        die "unknown lookup format";
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    my $padBytes = (4 - (length($dat) & 3)) & 3;
Packit 5d935b
    $dat .= pack("C*", (0) x $padBytes);
Packit 5d935b
    
Packit 5d935b
    return $dat;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
sub AAT_write_lookup
Packit 5d935b
{
Packit 5d935b
    my ($fh, $format, $lookup, $valueSize, $default) = @_;
Packit 5d935b
Packit 5d935b
    my $lookupStart = $fh->tell();
Packit 5d935b
    my $packChar;
Packit 5d935b
    if ($valueSize == 1) {
Packit 5d935b
        $packChar = "C";
Packit 5d935b
    }
Packit 5d935b
    elsif ($valueSize == 2) {
Packit 5d935b
        $packChar = "n";
Packit 5d935b
    }
Packit 5d935b
    elsif ($valueSize == 4) {
Packit 5d935b
        $packChar = "N";
Packit 5d935b
    }
Packit 5d935b
    else {
Packit 5d935b
        die "unsupported value size";
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    $fh->print(pack("n", $format));
Packit 5d935b
Packit 5d935b
    my ($firstGlyph, $lastGlyph) = (0xffff, 0);
Packit 5d935b
    foreach (keys %$lookup) {
Packit 5d935b
        $firstGlyph = $_ if $_ < $firstGlyph;
Packit 5d935b
        $lastGlyph = $_ if $_ > $lastGlyph;
Packit 5d935b
    }
Packit 5d935b
    my $glyphCount = $lastGlyph - $firstGlyph + 1;
Packit 5d935b
Packit 5d935b
    if ($format == 0) {
Packit 5d935b
        $fh->print(pack($packChar . "*", map { defined $lookup->{$_} ? $lookup->{$_} : defined $default ? $default : $_ } (0 .. $lastGlyph)));
Packit 5d935b
    }
Packit 5d935b
Packit 5d935b
    elsif ($format == 2) {
Packit 5d935b
        my $prev = $default;
Packit 5d935b
        my $segStart = $firstGlyph;
Packit 5d935b
        my $dat;
Packit 5d935b
        foreach ($firstGlyph .. $lastGlyph + 1) {
Packit 5d935b
            my $val = $lookup->{$_};
Packit 5d935b
            $val = $default unless defined $val;
Packit 5d935b
            if ($val != $prev) {
Packit 5d935b
                $dat .= pack("nn" . $packChar, $_ - 1, $segStart, $prev) if $prev != $default;
Packit 5d935b
                $prev = $val;
Packit 5d935b
                $segStart = $_;
Packit 5d935b
            }
Packit 5d935b
        }
Packit 5d935b
        $dat .= pack("nn" . $packChar, 0xffff, 0xffff, 0);
Packit 5d935b
        my $unitSize = 4 + $valueSize;
Packit 5d935b
        $fh->print(pack("nnnnn", $unitSize, TTF_bininfo(length($dat) / $unitSize, $unitSize)));
Packit 5d935b
        $fh->print($dat);
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    elsif ($format == 4) {
Packit 5d935b
        my $segArray = new Font::TTF::Segarr($valueSize);
Packit 5d935b
        $segArray->add_segment($firstGlyph, 1, map { $lookup->{$_} } ($firstGlyph .. $lastGlyph));
Packit 5d935b
        my ($start, $end, $offset);
Packit 5d935b
        $offset = 12 + @$segArray * 6 + 6;    # 12 is size of format word + binSearchHeader; 6 bytes per segment; 6 for terminating segment
Packit 5d935b
        my $dat;
Packit 5d935b
        foreach (@$segArray) {
Packit 5d935b
            $start = $_->{'START'};
Packit 5d935b
            $end = $start + $_->{'LEN'} - 1;
Packit 5d935b
            $dat .= pack("nnn", $end, $start, $offset);
Packit 5d935b
            $offset += $_->{'LEN'} * 2;
Packit 5d935b
        }
Packit 5d935b
        $dat .= pack("nnn", 0xffff, 0xffff, 0);
Packit 5d935b
        $fh->print(pack("nnnnn", 6, TTF_bininfo(length($dat) / 6, 6)));
Packit 5d935b
        $fh->print($dat);
Packit 5d935b
        foreach (@$segArray) {
Packit 5d935b
            $dat = $_->{'VAL'};
Packit 5d935b
            $fh->print(pack($packChar . "*", @$dat));
Packit 5d935b
        }
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    elsif ($format == 6) {
Packit 5d935b
        die "unsupported" if $valueSize != 2;
Packit 5d935b
        my $dat = pack("n*", map { $_, $lookup->{$_} } sort { $a <=> $b } grep { $lookup->{$_} ne $default } keys %$lookup);
Packit 5d935b
        my $unitSize = 2 + $valueSize;
Packit 5d935b
        $fh->print(pack("nnnnn", $unitSize, TTF_bininfo(length($dat) / $unitSize, $unitSize)));
Packit 5d935b
        $fh->print($dat);
Packit 5d935b
    }
Packit 5d935b
        
Packit 5d935b
    elsif ($format == 8) {
Packit 5d935b
        $fh->print(pack("nn", $firstGlyph, $lastGlyph - $firstGlyph + 1));
Packit 5d935b
        $fh->print(pack($packChar . "*", map { defined $lookup->{$_} ? $lookup->{$_} : defined $default ? $default : $_ } ($firstGlyph .. $lastGlyph)));
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    else {
Packit 5d935b
        die "unknown lookup format";
Packit 5d935b
    }
Packit 5d935b
    
Packit 5d935b
    my $length = $fh->tell() - $lookupStart;
Packit 5d935b
    my $padBytes = (4 - ($length & 3)) & 3;
Packit 5d935b
    $fh->print(pack("C*", (0) x $padBytes));
Packit 5d935b
    $length += $padBytes;
Packit 5d935b
    
Packit 5d935b
    $length;
Packit 5d935b
}
Packit 5d935b
Packit 5d935b
1;
Packit 5d935b
Packit 5d935b
=head1 AUTHOR
Packit 5d935b
Packit 5d935b
Jonathan Kew L<http://scripts.sil.org/FontUtils>. 
Packit 5d935b
Packit 5d935b
Packit 5d935b
=head1 LICENSING
Packit 5d935b
Packit 5d935b
Copyright (c) 1998-2016, SIL International (http://www.sil.org) 
Packit 5d935b
Packit 5d935b
This module is released under the terms of the Artistic License 2.0. 
Packit 5d935b
For details, see the full text of the license in the file LICENSE.
Packit 5d935b
Packit 5d935b
Packit 5d935b
Packit 5d935b
=cut
Packit 5d935b