also dont add tuples to lists sleepy man.
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Coverage.pm
1 package Font::TTF::Coverage;
2
3 =head1 NAME
4
5 Font::TTF::Coverage - Opentype coverage and class definition objects
6
7 =head1 DESCRIPTION
8
9 Coverage tables and class definition objects are virtually identical concepts
10 in OpenType. Their difference comes purely in their storage. Therefore we can
11 say that a coverage table is a class definition in which the class definition
12 for each glyph is the corresponding index in the coverage table. The resulting
13 data structure is that a Coverage table has the following fields:
14
15 =item cover
16
17 A boolean to indicate whether this table is a coverage table (TRUE) or a
18 class definition (FALSE)
19
20 =item val
21
22 A hash of glyph ids against values (either coverage index or class value)
23
24 =item fmt
25
26 The storage format used is given here, but is recalculated when the table
27 is written out.
28
29 =item count
30
31 A count of the elements in a coverage table for use with add. Each subsequent
32 addition is added with the current count and increments the count.
33
34 =head1 METHODS
35
36 =cut
37
38 =head2 new($isCover [, vals])
39
40 Creates a new coverage table or class definition table, depending upon the
41 value of $isCover. if $isCover then vals may be a list of glyphs to include in order.
42 If no $isCover, then vals is a hash of glyphs against class values.
43
44 =cut
45
46 sub new
47 {
48     my ($class) = shift;
49     my ($isCover) = shift;
50     my ($self) = {};
51
52     $self->{'cover'} = $isCover;
53     $self->{'count'} = 0;
54     if ($isCover)
55     {
56         my ($v);
57         foreach $v (@_)
58         { $self->{'val'}{$v} = $self->{'count'}++; }
59     }
60     else
61     {
62         $self->{'val'} = {@_};
63         foreach (values %{$self->{'val'}}) {$self->{'max'} = $_ if $_ > $self->{'max'}}
64     }
65     bless $self, $class;
66 }
67
68
69 =head2 read($fh)
70
71 Reads the coverage/class table from the given file handle
72
73 =cut
74
75 sub read
76 {
77     my ($self, $fh) = @_;
78     my ($dat, $fmt, $num, $i, $c);
79
80     $fh->read($dat, 4);
81     ($fmt, $num) = unpack("n2", $dat);
82     $self->{'fmt'} = $fmt;
83
84     if ($self->{'cover'})
85     {
86         if ($fmt == 1)
87         {
88             $fh->read($dat, $num << 1);
89             map {$self->{'val'}{$_} = $i++} unpack("n*", $dat);
90         } elsif ($fmt == 2)
91         {
92             $fh->read($dat, $num * 6);
93             for ($i = 0; $i < $num; $i++)
94             {
95                 ($first, $last, $c) = unpack("n3", substr($dat, $i * 6, 6));
96                 map {$self->{'val'}{$_} = $c++} ($first .. $last);
97             }
98         }
99         $self->{'count'} = $num;
100     } elsif ($fmt == 1)
101     {
102         $fh->read($dat, 2);
103         $first = $num;
104         ($num) = unpack("n", $dat);
105         $fh->read($dat, $num << 1);
106         map {$self->{'val'}{$first++} = $_; $self->{'max'} = $_ if ($_ > $self->{'max'})} unpack("n*", $dat);
107     } elsif ($fmt == 2)
108     {
109         $fh->read($dat, $num * 6);
110         for ($i = 0; $i < $num; $i++)
111         {
112             ($first, $last, $c) = unpack("n3", substr($dat, $i * 6, 6));
113             map {$self->{'val'}{$_} = $c} ($first .. $last);
114             $self->{'max'} = $c if ($c > $self->{'max'});
115         }
116     }
117     $self;
118 }
119
120
121 =head2 out($fh, $state)
122
123 Writes the coverage/class table to the given file handle. If $state is 1 then
124 the output string is returned rather than being output to a filehandle.
125
126 =cut
127
128 sub out
129 {
130     my ($self, $fh, $state) = @_;
131     my ($g, $eff, $grp, $out);
132     my ($shipout) = ($state ? sub {$out .= $_[0];} : sub {$fh->print($_[0]);});
133     my (@gids) = sort {$a <=> $b} keys %{$self->{'val'}};
134
135     $fmt = 1; $grp = 1; $eff = 0;
136     for ($i = 1; $i <= $#gids; $i++)
137     {
138         if ($self->{'val'}{$gids[$i]} < $self->{'val'}{$gids[$i-1]} && $self->{'cover'})
139         {
140             $fmt = 2;
141             last;
142         } elsif ($gids[$i] == $gids[$i-1] + 1 && ($self->{'cover'} || $self->{'val'}{$gids[$i]} == $self->{'val'}{$gids[$i-1]}))
143         { $eff++; }
144         else
145         {
146             $grp++;
147             $eff += $gids[$i] - $gids[$i-1] if (!$self->{'cover'});
148         }
149     }
150 #    if ($self->{'cover'})
151     { $fmt = 2 if ($eff / $grp > 3); }
152 #    else
153 #    { $fmt = 2 if ($grp > 1); }
154     
155     if ($fmt == 1 && $self->{'cover'})
156     {
157         my ($last) = 0;
158         &$shipout(pack('n2', 1, scalar @gids));
159         &$shipout(pack('n*', @gids));
160     } elsif ($fmt == 1)
161     {
162         my ($last) = $gids[0];
163         &$shipout(pack("n3", 1, $last, $gids[-1] - $last + 1));
164         foreach $g (@gids)
165         {
166             if ($g > $last + 1)
167             { &$shipout(pack('n*', (0) x ($g - $last - 1))); }
168             &$shipout(pack('n', $self->{'val'}{$g}));
169             $last = $g;
170         }
171     } else
172     {
173         my ($start, $end, $ind, $numloc, $endloc, $num);
174         &$shipout(pack("n2", 2, 0));
175         $numloc = $fh->tell() - 2 unless $state;
176
177         $start = 0; $end = 0; $num = 0;
178         while ($end < $#gids)
179         {
180             if ($gids[$end + 1] == $gids[$end] + 1
181                 && $self->{'val'}{$gids[$end + 1]}
182                         == $self->{'val'}{$gids[$end]}
183                            + ($self->{'cover'} ? 1 : 0))
184             {
185                 $end++;
186                 next;
187             }
188
189             &$shipout(pack("n3", $gids[$start], $gids[$end],
190                     $self->{'val'}{$gids[$start]}));
191             $start = $end + 1;
192             $end++;
193             $num++;
194         }
195         &$shipout(pack("n3", $gids[$start], $gids[$end],
196                 $self->{'val'}{$gids[$start]}));
197         $num++;
198         if ($state)
199         { substr($out, 2, 2) = pack('n', $num); }
200         else
201         {
202             $endloc = $fh->tell();
203             $fh->seek($numloc, 0);
204             $fh->print(pack("n", $num));
205             $fh->seek($endloc, 0);
206         }
207     }
208     return ($state ? $out : $self);
209 }
210
211
212 =head2 $c->add($glyphid[, $class])
213
214 Adds a glyph id to the coverage table incrementing the count so that each subsequent addition
215 has the next sequential number. Returns the index number of the glyphid added
216
217 =cut
218
219 sub add
220 {
221     my ($self, $gid, $class) = @_;
222     
223     return $self->{'val'}{$gid} if (defined $self->{'val'}{$gid});
224     if ($self->{'cover'})
225     {
226         $self->{'val'}{$gid} = $self->{'count'};
227         return $self->{'count'}++;
228     }
229     else
230     {
231         $self->{'val'}{$gid} = $class || '0';
232         $self->{'max'} = $class if ($class > $self->{'max'});
233         return $class;
234     }
235 }
236
237
238 =head2 $c->signature
239
240 Returns a vector of all the glyph ids covered by this coverage table or class
241
242 =cut
243
244 sub signature
245 {
246     my ($self) = @_;
247     my ($vec, $range, $size);
248
249 if (0)
250 {
251     if ($self->{'cover'})
252     { $range = 1; $size = 1; }
253     else
254     {
255         $range = $self->{'max'};
256         $size = 1;
257         while ($range > 1)
258         {
259             $size = $size << 1;
260             $range = $range >> 1;
261         }
262         $range = $self->{'max'} + 1;
263     }
264     foreach (keys %{$self->{'val'}})
265     { vec($vec, $_, $size) = $self->{'val'}{$_} > $range ? $range : $self->{'val'}{$_}; }
266     length($vec) . ":" . $vec;
267 }
268     $vec = join(";", map{"$_,$self->{'val'}{$_}"} keys %{$self->{'val'}});
269 }
270
271 =head2 @map=$c->sort
272
273 Sorts the coverage table so that indexes are in ascending order of glyphid.
274 Returns a map such that $map[$new_index]=$old_index.
275
276 =cut
277
278 sub sort
279 {
280     my ($self) = @_;
281     my (@res, $i);
282
283     foreach (sort {$a <=> $b} keys %{$self->{'val'}})
284     {
285         push(@res, $self->{'val'}{$_});
286         $self->{'val'}{$_} = $i++;
287     }
288     @res;
289 }
290
291 =head2 $c->out_xml($context)
292
293 Outputs this coverage/class in XML
294
295 =cut
296
297 sub out_xml
298 {
299     my ($self, $context, $depth) = @_;
300     my ($fh) = $context->{'fh'};
301
302     $fh->print("$depth<" . ($self->{'cover'} ? 'coverage' : 'class') . ">\n");
303     foreach $gid (sort {$a <=> $b} keys %{$self->{'val'}})
304     {
305         $fh->printf("$depth$context->{'indent'}<gref glyph='%s' val='%s'/>\n", $gid, $self->{'val'}{$gid});
306     }
307     $fh->print("$depth</" . ($self->{'cover'} ? 'coverage' : 'class') . ">\n");
308     $self;
309 }
310
311 sub release
312 { }
313
314
315 =head1 AUTHOR
316
317 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
318 licensing.
319
320 =cut
321
322 1;
323