80f66d9d5f8d235f291a62f5d7959e28a387e33f
[librarian.git] / src / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Kern.pm
1 package Font::TTF::Kern;
2
3 =head1 NAME
4
5 Font::TTF::Kern - Kerning tables
6
7 =head1 DESCRIPTION
8
9 Kerning tables are held as an ordered collection of subtables each giving
10 incremental information regarding the kerning of various pairs of glyphs.
11
12 The basic structure of the kerning data structure is:
13
14     $kern = $f->{'kern'}{'tables'}[$tnum]{'kerns'}{$leftnum}{$rightnum};
15
16 Due to the possible complexity of some kerning tables the above information
17 is insufficient. Reference also needs to be made to the type of the table and
18 the coverage field.
19
20 =head1 INSTANCE VARIABLES
21
22 The instance variables for a kerning table are relatively straightforward.
23
24 =over 4
25
26 =item Version
27
28 Version number of the kerning table
29
30 =item Num
31
32 Number of subtables in the kerning table
33
34 =item tables
35
36 Array of subtables in the kerning table
37
38 =over 4
39
40 Each subtable has a number of instance variables.
41
42 =item kern
43
44 A two level hash array containing kerning values. The indexing is left
45 value and then right value. In the case of type 2 tables, the indexing
46 is via left class and right class. It may seem using hashes is strange,
47 but most tables are not type 2 and this method saves empty array values.
48
49 =item type
50
51 Stores the table type. Only type 0 and type 2 tables are specified for
52 TrueType so far.
53
54 =item coverage
55
56 A bit field of coverage information regarding the kerning value. See the
57 TrueType specification for details.
58
59 =item Version
60
61 Contains the version number of the table.
62
63 =item Num
64
65 Number of kerning pairs in this type 0 table.
66
67 =item left
68
69 An array indexed by glyph - left_first which returns a class number for
70 the glyph in type 2 tables.
71
72 =item right
73
74 An array indexed by glyph - right_first which returns a class number for
75 the glyph in type 2 tables.
76
77 =item left_first
78
79 the glyph number of the first element in the left array for type 2 tables.
80
81 =item right_first
82
83 the glyph number of the first element in the right array for type 2 tables.
84
85 =item num_left
86
87 Number of left classes
88
89 =item num_right
90
91 Number of right classes
92
93 =back
94
95 =back
96
97 =head1 METHODS
98
99 =cut
100
101 use strict;
102 use vars qw(@ISA);
103 use Font::TTF::Utils;
104 use Font::TTF::Table;
105
106 @ISA = qw(Font::TTF::Table);
107
108 =head2 $t->read
109
110 Reads the whole kerning table into structures
111
112 =cut
113
114 sub read
115 {
116     my ($self) = @_;
117     my ($fh) = $self->{' INFILE'};
118     my ($dat, $i, $numt, $len, $cov, $t);
119
120     $self->SUPER::read or return $self;
121
122     $fh->read($dat, 4);
123     ($self->{'Version'}, $numt) = unpack("n2", $dat);
124     $self->{'Num'} = $numt;
125
126     for ($i = 0; $i < $numt; $i++)
127     {
128         $t = {};
129         $fh->read($dat, 6);
130         ($t->{'Version'}, $len, $cov) = unpack("n3", $dat);
131         $t->{'coverage'} = $cov & 255;
132         $t->{'type'} = $cov >> 8;
133         $fh->read($dat, $len - 6);
134         if ($t->{'Version'} == 0)
135         {
136             $t->{'Num'} = unpack("n", $dat);
137             my (@vals) = unpack("n*", substr($dat, 8, $t->{'Num'} * 6));
138             for (0 .. ($t->{'Num'} - 1))
139             {
140                 my ($f, $l, $v);
141                 $f = shift @vals;
142                 $l = shift @vals;
143                 $v = shift @vals;
144                 $v -= 65536 if ($v > 32767);
145                 $t->{'kern'}{$f}{$l} = $v;
146             }
147         } elsif ($t->{'Version'} == 2)
148         {
149             my ($wid, $off, $numg, $maxl, $maxr, $j);
150             
151             $wid = unpack("n", $dat);
152             $off = unpack("n", substr($dat, 2));
153             ($t->{'left_first'}, $numg) = unpack("n2", substr($dat, $off));
154             $t->{'left'} = [unpack("C$numg", substr($dat, $off + 4))];
155             foreach (@{$t->{'left'}})
156             {
157                 $_ /= $wid;
158                 $maxl = $_ if ($_ > $maxl);
159             }
160             $t->{'left_max'} = $maxl;
161
162             $off = unpack("n", substr($dat, 4));
163             ($t->{'right_first'}, $numg) = unpack("n2", substr($dat, $off));
164             $t->{'right'} = [unpack("C$numg", substr($dat, $off + 4))];
165             foreach (@{$t->{'right'}})
166             {
167                 $_ >>= 1;
168                 $maxr = $_ if ($_ > $maxr);
169             }
170             $t->{'right_max'} = $maxr;
171
172             $off = unpack("n", substr($dat, 6));
173             for ($j = 0; $j <= $maxl; $j++)
174             {
175                 my ($k) = 0;
176
177                 map { $t->{'kern'}{$j}{$k} = $_ if $_; $k++; }
178                         unpack("n$maxr", substr($dat, $off + $wid * $j));
179             }
180         }
181         push (@{$self->{'tables'}}, $t);
182     }
183     $self;
184 }
185
186
187 =head2 $t->out($fh)
188
189 Outputs the kerning tables to the given file
190
191 =cut
192
193 sub out
194 {
195     my ($self, $fh) = @_;
196     my ($i, $l, $r, $loc, $loc1, $t);
197
198     return $self->SUPER::out($fh) unless ($self->{' read'});
199
200     $fh->print(pack("n2", $self->{'Version'}, $self->{'Num'}));
201     for ($i = 0; $i < $self->{'Num'}; $i++)
202     {
203         $t = $self->{'tables'}[$i];
204         $loc = $fh->tell();
205
206         $fh->print(pack("nnn", $t->{'Version'}, 0, $t->{'coverage'}));
207         if ($t->{'Version'} == 0)
208         {
209             my ($dat);
210             foreach $l (sort {$a <=> $b} keys %{$t->{'kern'}})
211             {
212                 foreach $r (sort {$a <=> $b} keys %{$t->{'kern'}{$l}})
213                 { $dat .= TTF_Pack("SSs", $l, $r, $t->{'kern'}{$l}{$r}); }
214             }
215             $fh->print(TTF_Pack("SSSS", Font::TTF::Utils::TTF_bininfo(length($dat) / 6, 6)));
216             $fh->print($dat);
217         } elsif ($t->{'Version'} == 2)
218         {
219             my ($arr);
220
221             $fh->print(pack("nnnn", $t->{'right_max'} << 1, 8, ($#{$t->{'left'}} + 7) << 1,
222                     ($#{$t->{'left'}} + $#{$t->{'right'}} + 10) << 1));
223
224             $fh->print(pack("nn", $t->{'left_first'}, $#{$t->{'left'}} + 1));
225             foreach (@{$t->{'left'}})
226             { $fh->print(pack("C", $_ * (($t->{'left_max'} + 1) << 1))); }
227
228             $fh->print(pack("nn", $t->{'right_first'}, $#{$t->{'right'}} + 1));
229             foreach (@{$t->{'right'}})
230             { $fh->print(pack("C", $_ << 1)); }
231
232             $arr = "\000\000" x (($t->{'left_max'} + 1) * ($t->{'right_max'} + 1));
233             foreach $l (keys %{$t->{'kern'}})
234             {
235                 foreach $r (keys %{$t->{'kern'}{$l}})
236                 { substr($arr, ($l * ($t->{'left_max'} + 1) + $r) << 1, 2)
237                         = pack("n", $t->{'kern'}{$l}{$r}); }
238             }
239             $fh->print($arr);
240         }
241         $loc1 = $fh->tell();
242         $fh->seek($loc + 2, 0);
243         $fh->print(pack("n", $loc1 - $loc));
244         $fh->seek($loc1, 0);
245     }
246     $self;
247 }
248
249
250 =head2 $t->XML_element($context, $depth, $key, $value)
251
252 Handles outputting the kern hash into XML a little more tidily
253
254 =cut
255
256 sub XML_element
257 {
258     my ($self) = shift;
259     my ($context, $depth, $key, $value) = @_;
260     my ($fh) = $context->{'fh'};
261     my ($f, $l);
262
263     return $self->SUPER::XML_element(@_) unless ($key eq 'kern');
264     $fh->print("$depth<kern-table>\n");
265     foreach $f (sort {$a <=> $b} keys %{$value})
266     {
267         foreach $l (sort {$a <=> $b} keys %{$value->{$f}})
268         { $fh->print("$depth$context->{'indent'}<adjust first='$f' last='$l' dist='$value->{$f}{$l}'/>\n"); }
269     }
270     $fh->print("$depth</kern-table>\n");
271     $self;
272 }
273
274 1;
275
276 =head1 BUGS
277
278 =over 4
279
280 =item *
281
282 Only supports kerning table types 0 & 2.
283
284 =item *
285
286 No real support functions to I<do> anything with the kerning tables yet.
287
288 =back
289
290 =head1 AUTHOR
291
292 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
293 licensing.
294
295 =cut
296