package Font::TTF::Mort::Subtable;

=head1 NAME

Font::TTF::Mort::Subtable - Mort subtable superclass for AAT

=head1 METHODS

=cut

use strict;

use Font::TTF::Utils;

use Font::TTF::AATutils;

use IO::File;

require Font::TTF::Mort::Rearrangement;

require Font::TTF::Mort::Contextual;

require Font::TTF::Mort::Ligature;

require Font::TTF::Mort::Noncontextual;

require Font::TTF::Mort::Insertion;

sub new

{

    my ($class) = @_;

    my ($self) = {};

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

    bless $self, $class;

}

sub create

{

    my ($class, $type, $coverage, $subFeatureFlags, $length) = @_;

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

    my $subclass;

    if ($type == 0) {

        $subclass = 'Font::TTF::Mort::Rearrangement';

    }

    elsif ($type == 1) {

        $subclass = 'Font::TTF::Mort::Contextual';

    }

    elsif ($type == 2) {

        $subclass = 'Font::TTF::Mort::Ligature';

    }

    elsif ($type == 4) {

        $subclass = 'Font::TTF::Mort::Noncontextual';

    }

    elsif ($type == 5) {

        $subclass = 'Font::TTF::Mort::Insertion';

    }

    my ($self) = $subclass->new(

            (($coverage & 0x4000) ? 'RL' : 'LR'),

            (($coverage & 0x2000) ? 'VH' : ($coverage & 0x8000) ? 'V' : 'H'),

            $subFeatureFlags

        );

    $self->{'type'} = $type;

    $self->{'length'} = $length;

    $self;

}

=head2 $t->out($fh)

Writes the table to a file

=cut

sub out

{

    my ($self, $fh) = @_;

    my ($subtableStart) = $fh->tell();

    my ($type) = $self->{'type'};

    my ($coverage) = $type;

    $coverage += 0x4000 if $self->{'direction'} eq 'RL';

    $coverage += 0x2000 if $self->{'orientation'} eq 'VH';

    $coverage += 0x8000 if $self->{'orientation'} eq 'V';

    $fh->print(TTF_Pack("SSL", 0, $coverage, $self->{'subFeatureFlags'}));    # placeholder for length

    my ($dat) = $self->pack_sub();

    $fh->print($dat);

    my ($length) = $fh->tell() - $subtableStart;

    my ($padBytes) = (4 - ($length & 3)) & 3;

    $fh->print(pack("C*", (0) x $padBytes));

    $length += $padBytes;

    $fh->seek($subtableStart, IO::File::SEEK_SET);

    $fh->print(pack("n", $length));

    $fh->seek($subtableStart + $length, IO::File::SEEK_SET);

}

=head2 $t->print($fh)

Prints a human-readable representation of the table

=cut

sub post

{

    my ($self) = @_;

    my ($post) = $self->{' PARENT'}{' PARENT'}{' PARENT'}{'post'};

    if (defined $post) {

        $post->read;

    }

    else {

        $post = {};

    }

    return $post;

}

sub feat

{

    my ($self) = @_;

    return $self->{' PARENT'}->feat();

}

sub print

{

    my ($self, $fh) = @_;

    my ($feat) = $self->feat();

    my ($post) = $self->post();

    $fh = 'STDOUT' unless defined $fh;

    my ($type) = $self->{'type'};

    my ($subFeatureFlags) = $self->{'subFeatureFlags'};

    my ($defaultFlags) = $self->{' PARENT'}{'defaultFlags'};

    my ($featureEntries) = $self->{' PARENT'}{'featureEntries'};

    $fh->printf("\n\t%s table, %s, %s, subFeatureFlags = %08x # %s (%s)\n",

                subtable_type_($type), $_->{'direction'}, $_->{'orientation'}, $subFeatureFlags,

                "Default " . ((($subFeatureFlags & $defaultFlags) != 0) ? "On" : "Off"),

                join(", ",

                    map {

                        join(": ", $feat->settingName($_->{'type'}, $_->{'setting'}) )

                    } grep { ($_->{'enable'} & $subFeatureFlags) != 0 } @$featureEntries

                ) );

}

sub subtable_type_

{

    my ($val) = @_;

    my ($res);

    my (@types) =    (

                        'Rearrangement',

                        'Contextual',

                        'Ligature',

                        undef,

                        'Non-contextual',

                        'Insertion',

                    );

    $res = $types[$val] or ('Undefined (' . $val . ')');

    $res;

}

=head2 $t->print_classes($fh)

Prints a human-readable representation of the table

=cut

sub print_classes

{

    my ($self, $fh) = @_;

    my ($post) = $self->post();

    my ($classes) = $self->{'classes'};

    foreach (0 .. $#$classes) {

        my $class = $classes->[$_];

        if (defined $class) {

            $fh->printf("\t\tClass %d:\t%s\n", $_, join(", ", map { $_ . " [" . $post->{'VAL'}[$_] . "]" } @$class));

        }

    }

}

1;

=head1 BUGS

None known

=head1 AUTHOR

Jonathan Kew L<http://scripts.sil.org/FontUtils>. 

=head1 LICENSING

Copyright (c) 1998-2016, SIL International (http://www.sil.org) 

This module is released under the terms of the Artistic License 2.0. 

For details, see the full text of the license in the file LICENSE.

=cut