51d650a4c6a626b8d5467be4eccea105c78c80b7
[librarian.git] / src / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Kern / StateTable.pm
1 package Font::TTF::Kern::StateTable;
2
3 =head1 NAME
4
5 Font::TTF::Kern::StateTable - State Table Kern 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::Kern::Subtable;
16 use IO::File;
17
18 @ISA = qw(Font::TTF::Kern::Subtable);
19
20 sub new
21 {
22     my ($class) = @_;
23     my ($self) = {};
24     
25     $class = ref($class) || $class;
26     bless $self, $class;
27 }
28
29 =head2 $t->read
30
31 Reads the table into memory
32
33 =cut
34
35 sub read
36 {
37     my ($self, $fh) = @_;
38     my ($dat);
39     
40     my $stTableStart = $fh->tell();
41
42     my ($classes, $states, $entries) = AAT_read_state_table($fh, 0);
43
44     foreach (@$entries) {
45         my $flags = $_->{'flags'};
46         delete $_->{'flags'};
47         $_->{'push'} = 1        if $flags & 0x8000;
48         $_->{'noAdvance'} = 1    if $flags & 0x4000;
49         $flags &= ~0xC000;
50         if ($flags != 0) {
51             my $kernList = [];
52             $fh->seek($stTableStart + $flags, IO::File::SEEK_SET);
53             while (1) {
54                 $fh->read($dat, 2);
55                 my $k = TTF_Unpack("s", $dat);
56                 push @$kernList, ($k & ~1);
57                 last if ($k & 1) != 0;
58             }
59             $_->{'kernList'} = $kernList;
60         }
61     }
62
63     $self->{'classes'} = $classes;
64     $self->{'states'} = $states;
65     $self->{'entries'} = $entries;
66
67     $fh->seek($stTableStart - 8 + $self->{'length'}, IO::File::SEEK_SET);
68     
69     $self;
70 }
71
72 =head2 $t->out_sub($fh)
73
74 Writes the table to a file
75
76 =cut
77
78 sub out_sub
79 {
80 }
81
82 =head2 $t->print($fh)
83
84 Prints a human-readable representation of the table
85
86 =cut
87
88 sub print
89 {
90 }
91
92 sub dumpXML
93 {
94     my ($self, $fh) = @_;
95     
96     $fh->printf("<classes>\n");
97     $self->dumpClasses($self->{'classes'}, $fh);
98     $fh->printf("</classes>\n");
99
100     $fh->printf("<states>\n");
101     my $states = $self->{'states'};
102     foreach (0 .. $#$states) {
103         $fh->printf("<state index=\"%s\">\n", $_);
104         my $members = $states->[$_];
105         foreach (0 .. $#$members) {
106             my $m = $members->[$_];
107             $fh->printf("<m index=\"%s\" nextState=\"%s\"", $_, $m->{'nextState'});
108             $fh->printf(" push=\"1\"")        if $m->{'push'};
109             $fh->printf(" noAdvance=\"1\"")    if $m->{'noAdvance'};
110             if (exists $m->{'kernList'}) {
111                 $fh->printf(">");
112                 foreach (@{$m->{'kernList'}}) {
113                     $fh->printf("<kern v=\"%s\"/>", $_);
114                 }
115                 $fh->printf("</m>\n");
116             }
117             else {
118                 $fh->printf("/>\n");
119             }
120         }
121         $fh->printf("</state>\n");
122     }
123     $fh->printf("</states>\n");
124 }
125
126 sub type
127 {
128     return 'kernStateTable';
129 }
130
131 1;
132
133 =head1 BUGS
134
135 None known
136
137 =head1 AUTHOR
138
139 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
140 licensing.
141
142 =cut
143