b1db4104cecbc30b599af1335d160f3a9d7bf15a
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Kern / Subtable.pm
1 package Font::TTF::Kern::Subtable;
2
3 =head1 NAME
4
5 Font::TTF::Kern::Subtable - Kern Subtable superclass for AAT
6
7 =head1 METHODS
8
9 =cut
10
11 use strict;
12 use Font::TTF::Utils;
13 use Font::TTF::AATutils;
14 use IO::File;
15
16 require Font::TTF::Kern::OrderedList;
17 require Font::TTF::Kern::StateTable;
18 require Font::TTF::Kern::ClassArray;
19 require Font::TTF::Kern::CompactClassArray;
20
21 sub new
22 {
23     my ($class) = @_;
24     my ($self) = {};
25
26     $class = ref($class) || $class;
27
28     bless $self, $class;
29 }
30
31 sub create
32 {
33     my ($class, $type, $coverage, $length) = @_;
34
35     $class = ref($class) || $class;
36
37     my $subclass;
38     if ($type == 0) {
39         $subclass = 'Font::TTF::Kern::OrderedList';
40     }
41     elsif ($type == 1) {
42         $subclass = 'Font::TTF::Kern::StateTable';
43     }
44     elsif ($type == 2) {
45         $subclass = 'Font::TTF::Kern::ClassArray';
46     }
47     elsif ($type == 3) {
48         $subclass = 'Font::TTF::Kern::CompactClassArray';
49     }
50
51     my @options;
52     push @options,'vertical'    if ($coverage & 0x8000) != 0;
53     push @options,'crossStream' if ($coverage & 0x4000) != 0;
54     push @options,'variation'   if ($coverage & 0x2000) != 0;
55     
56     my ($subTable) = $subclass->new(@options);
57
58     map { $subTable->{$_} = 1 } @options;
59
60     $subTable->{'type'} = $type;
61     $subTable->{'length'} = $length;
62
63     $subTable;
64 }
65
66 =head2 $t->out($fh)
67
68 Writes the table to a file
69
70 =cut
71
72 sub out
73 {
74     my ($self, $fh) = @_;
75     
76     my $subtableStart = $fh->tell();
77     my $type = $self->{'type'};
78     my $coverage = $type;
79     $coverage += 0x8000 if $self->{'vertical'};
80     $coverage += 0x4000 if $self->{'crossStream'};
81     $coverage += 0x2000 if $self->{'variation'};
82     
83     $fh->print(TTF_Pack("LSS", 0, $coverage, $self->{'tupleIndex'}));    # placeholder for length
84     
85     $self->out_sub($fh);
86     
87     my $length = $fh->tell() - $subtableStart;
88     my $padBytes = (4 - ($length & 3)) & 3;
89     $fh->print(pack("C*", (0) x $padBytes));
90     $length += $padBytes;
91     $fh->seek($subtableStart, IO::File::SEEK_SET);
92     $fh->print(pack("N", $length));
93     $fh->seek($subtableStart + $length, IO::File::SEEK_SET);
94 }
95
96 =head2 $t->print($fh)
97
98 Prints a human-readable representation of the table
99
100 =cut
101
102 sub post
103 {
104     my ($self) = @_;
105     
106     my $post = $self->{' PARENT'}{' PARENT'}{'post'};
107     if (defined $post) {
108         $post->read;
109     }
110     else {
111         $post = {};
112     }
113     
114     return $post;
115 }
116
117 sub print
118 {
119     my ($self, $fh) = @_;
120     
121     my $post = $self->post();
122     $fh = 'STDOUT' unless defined $fh;
123 }
124
125 =head2 $t->print_classes($fh)
126
127 Prints a human-readable representation of the table
128
129 =cut
130
131 sub print_classes
132 {
133     my ($self, $fh) = @_;
134     
135     my $post = $self->post();
136     
137     my $classes = $self->{'classes'};
138     foreach (0 .. $#$classes) {
139         my $class = $classes->[$_];
140         if (defined $class) {
141             $fh->printf("\t\tClass %d:\t%s\n", $_, join(", ", map { $_ . " [" . $post->{'VAL'}[$_] . "]" } @$class));
142         }
143     }
144 }
145
146 sub dumpClasses
147 {
148     my ($self, $classes, $fh) = @_;
149     my $post = $self->post();
150     
151     foreach (0 .. $#$classes) {
152         my $c = $classes->[$_];
153         if ($#$c > -1) {
154             $fh->printf("<class n=\"%s\">\n", $_);
155             foreach (@$c) {
156                 $fh->printf("<g index=\"%s\" name=\"%s\"/>\n", $_, $post->{'VAL'}[$_]);
157             }
158             $fh->printf("</class>\n");
159         }
160     }
161 }
162
163 1;
164
165 =head1 BUGS
166
167 None known
168
169 =head1 AUTHOR
170
171 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
172 licensing.
173
174 =cut
175