fecc5197a5d6d0032acd38837408476394c90ef9
[librarian.git] / 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