<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Font::TTF::Kern::Subtable;

=head1 NAME

Font::TTF::Kern::Subtable - Kern Subtable superclass for AAT

=head1 METHODS

=cut

use strict;
use Font::TTF::Utils;
use Font::TTF::AATutils;
use IO::File;

require Font::TTF::Kern::OrderedList;
require Font::TTF::Kern::StateTable;
require Font::TTF::Kern::ClassArray;
require Font::TTF::Kern::CompactClassArray;

sub new
{
    my ($class) = @_;
    my ($self) = {};

    $class = ref($class) || $class;

    bless $self, $class;
}

sub create
{
    my ($class, $type, $coverage, $length) = @_;

    $class = ref($class) || $class;

    my $subclass;
    if ($type == 0) {
        $subclass = 'Font::TTF::Kern::OrderedList';
    }
    elsif ($type == 1) {
        $subclass = 'Font::TTF::Kern::StateTable';
    }
    elsif ($type == 2) {
        $subclass = 'Font::TTF::Kern::ClassArray';
    }
    elsif ($type == 3) {
        $subclass = 'Font::TTF::Kern::CompactClassArray';
    }

    my @options;
    push @options,'vertical'    if ($coverage &amp; 0x8000) != 0;
    push @options,'crossStream' if ($coverage &amp; 0x4000) != 0;
    push @options,'variation'   if ($coverage &amp; 0x2000) != 0;
    
    my ($subTable) = $subclass-&gt;new(@options);

    map { $subTable-&gt;{$_} = 1 } @options;

    $subTable-&gt;{'type'} = $type;
    $subTable-&gt;{'length'} = $length;

    $subTable;
}

=head2 $t-&gt;out($fh)

Writes the table to a file

=cut

sub out
{
    my ($self, $fh) = @_;
    
    my $subtableStart = $fh-&gt;tell();
    my $type = $self-&gt;{'type'};
    my $coverage = $type;
    $coverage += 0x8000 if $self-&gt;{'vertical'};
    $coverage += 0x4000 if $self-&gt;{'crossStream'};
    $coverage += 0x2000 if $self-&gt;{'variation'};
    
    $fh-&gt;print(TTF_Pack("LSS", 0, $coverage, $self-&gt;{'tupleIndex'}));    # placeholder for length
    
    $self-&gt;out_sub($fh);
    
    my $length = $fh-&gt;tell() - $subtableStart;
    my $padBytes = (4 - ($length &amp; 3)) &amp; 3;
    $fh-&gt;print(pack("C*", (0) x $padBytes));
    $length += $padBytes;
    $fh-&gt;seek($subtableStart, IO::File::SEEK_SET);
    $fh-&gt;print(pack("N", $length));
    $fh-&gt;seek($subtableStart + $length, IO::File::SEEK_SET);
}

=head2 $t-&gt;print($fh)

Prints a human-readable representation of the table

=cut

sub post
{
    my ($self) = @_;
    
    my $post = $self-&gt;{' PARENT'}{' PARENT'}{'post'};
    if (defined $post) {
        $post-&gt;read;
    }
    else {
        $post = {};
    }
    
    return $post;
}

sub print
{
    my ($self, $fh) = @_;
    
    my $post = $self-&gt;post();
    $fh = 'STDOUT' unless defined $fh;
}

=head2 $t-&gt;print_classes($fh)

Prints a human-readable representation of the table

=cut

sub print_classes
{
    my ($self, $fh) = @_;
    
    my $post = $self-&gt;post();
    
    my $classes = $self-&gt;{'classes'};
    foreach (0 .. $#$classes) {
        my $class = $classes-&gt;[$_];
        if (defined $class) {
            $fh-&gt;printf("\t\tClass %d:\t%s\n", $_, join(", ", map { $_ . " [" . $post-&gt;{'VAL'}[$_] . "]" } @$class));
        }
    }
}

sub dumpClasses
{
    my ($self, $classes, $fh) = @_;
    my $post = $self-&gt;post();
    
    foreach (0 .. $#$classes) {
        my $c = $classes-&gt;[$_];
        if ($#$c &gt; -1) {
            $fh-&gt;printf("&lt;class n=\"%s\"&gt;\n", $_);
            foreach (@$c) {
                $fh-&gt;printf("&lt;g index=\"%s\" name=\"%s\"/&gt;\n", $_, $post-&gt;{'VAL'}[$_]);
            }
            $fh-&gt;printf("&lt;/class&gt;\n");
        }
    }
}

1;

=head1 BUGS

None known

=head1 AUTHOR

Jonathan Kew L&lt;Jonathan_Kew@sil.org&gt;. See L&lt;Font::TTF::Font&gt; for copyright and
licensing.

=cut

</pre></body></html>