src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Mort/Contextual.pm

   1 package Font::TTF::Mort::Contextual;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Mort::Contextual - Contextual Mort subtable for AAT
   6
   7 =head1 METHODS
   8
   9 =cut
  10
  11 use strict;
  12 use vars qw(@ISA);
  13 use Font::TTF::Utils;
  14 use Font::TTF::AATutils;
  15 use Font::TTF::Mort::Subtable;
  16 use IO::File;
  17
  18 @ISA = qw(Font::TTF::AAT::Mort::Subtable);
  19
  20 sub new
  21 {
  22     my ($class, $direction, $orientation, $subFeatureFlags) = @_;
  23     my ($self) = {
  24                     'direction'            => $direction,
  25                     'orientation'        => $orientation,
  26                     'subFeatureFlags'    => $subFeatureFlags
  27                 };
  28
  29     $class = ref($class) || $class;
  30     bless $self, $class;
  31 }
  32
  33 =head2 $t->read
  34
  35 Reads the table into memory
  36
  37 =cut
  38
  39 sub read
  40 {
  41     my ($self, $fh) = @_;
  42     my ($dat);
  43
  44     my $stateTableStart = $fh->tell();
  45     my ($classes, $states, $entries) = AAT_read_state_table($fh, 2);
  46
  47     $fh->seek($stateTableStart, IO::File::SEEK_SET);
  48     $fh->read($dat, 10);
  49     my ($stateSize, $classTable, $stateArray, $entryTable, $mappingTables) = unpack("nnnnn", $dat);
  50     my $limits = [$classTable, $stateArray, $entryTable, $mappingTables, $self->{'length'} - 8];
  51
  52     foreach (@$entries) {
  53         my $actions = $_->{'actions'};
  54         foreach (@$actions) {
  55             $_ = $_ ? $_ - ($mappingTables / 2) : undef;
  56         }
  57     }
  58
  59     $self->{'classes'} = $classes;
  60     $self->{'states'} = $states;
  61     $self->{'mappings'} = [unpack("n*", AAT_read_subtable($fh, $stateTableStart, $mappingTables, $limits))];
  62
  63     $self;
  64 }
  65
  66 =head2 $t->pack_sub()
  67
  68 =cut
  69
  70 sub pack_sub
  71 {
  72     my ($self) = @_;
  73
  74     my ($dat) = pack("nnnnn", (0) x 5);    # placeholders for stateSize, classTable, stateArray, entryTable, mappingTables
  75
  76     my $classTable = length($dat);
  77     my $classes = $self->{'classes'};
  78     $dat .= AAT_pack_classes($classes);
  79
  80     my $stateArray = length($dat);
  81     my $states = $self->{'states'};
  82     my ($dat1, $stateSize, $entries) = AAT_pack_states($classes, $stateArray, $states,
  83             sub {
  84                 my $actions = $_->{'actions'};
  85                 ( $_->{'flags'}, @$actions )
  86             }
  87         );
  88     $dat .= $dat1;
  89
  90     my $entryTable = length($dat);
  91     my $offset = ($entryTable + 8 * @$entries) / 2;
  92     foreach (@$entries) {
  93         my ($nextState, $flags, @parts) = split /,/;
  94         $dat .= pack("nnnn", $nextState, $flags, map { $_ eq "" ? 0 : $_ + $offset } @parts);
  95     }
  96
  97     my $mappingTables = length($dat);
  98     my $mappings = $self->{'mappings'};
  99     $dat .= pack("n*", @$mappings);
 100
 101     $dat1 = pack("nnnnn", $stateSize, $classTable, $stateArray, $entryTable, $mappingTables);
 102     substr($dat, 0, length($dat1)) = $dat1;
 103
 104     return $dat;
 105 }
 106
 107 =head2 $t->print($fh)
 108
 109 Prints a human-readable representation of the table
 110
 111 =cut
 112
 113 sub print
 114 {
 115     my ($self, $fh) = @_;
 116
 117     my $post = $self->post();
 118
 119     $fh = 'STDOUT' unless defined $fh;
 120
 121     $self->print_classes($fh);
 122
 123     $fh->print("\n");
 124     my $states = $self->{'states'};
 125     foreach (0 .. $#$states) {
 126         $fh->printf("\t\tState %d:", $_);
 127         my $state = $states->[$_];
 128         foreach (@$state) {
 129             my $flags;
 130             $flags .= "!" if ($_->{'flags'} & 0x4000);
 131             $flags .= "*" if ($_->{'flags'} & 0x8000);
 132             my $actions = $_->{'actions'};
 133             $fh->printf("\t(%s%d,%s,%s)", $flags, $_->{'nextState'}, map { defined $_ ? $_ : "=" } @$actions);
 134         }
 135         $fh->print("\n");
 136     }
 137
 138     $fh->print("\n");
 139     my $mappings = $self->{'mappings'};
 140     foreach (0 .. $#$mappings) {
 141         $fh->printf("\t\tMapping %d: %d [%s]\n", $_, $mappings->[$_], $post->{'VAL'}[$mappings->[$_]]);
 142     }
 143 }
 144
 145 1;
 146
 147 =head1 BUGS
 148
 149 None known
 150
 151 =head1 AUTHOR
 152
 153 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 154 licensing.
 155
 156 =cut
 157