File Coverage

blib/lib/Font/TTF/Cmap.pm
Criterion Covered Total %
statement 114 367 31.0
branch 26 160 16.2
condition 10 75 13.3
subroutine 6 14 42.8
pod 10 10 100.0
total 166 626 26.5


line stmt bran cond sub pod time code
1             package Font::TTF::Cmap;
2              
3             =head1 NAME
4              
5             Font::TTF::Cmap - Character map table
6              
7             =head1 DESCRIPTION
8              
9             Looks after the character map. For ease of use, the actual cmap is held in
10             a hash against codepoint. Thus for a given table:
11              
12             $gid = $font->{'cmap'}{'Tables'}[0]{'val'}{$code};
13              
14             Note that C<$code> should be a true value (0x1234) rather than a string representation.
15              
16             =head1 INSTANCE VARIABLES
17              
18             The instance variables listed here are not preceded by a space due to their
19             emulating structural information in the font.
20              
21             =over 4
22              
23             =item Num
24              
25             Number of subtables in this table
26              
27             =item Tables
28              
29             An array of subtables ([0..Num-1])
30              
31             Each subtable also has its own instance variables which are, again, not
32             preceded by a space.
33              
34             =over 4
35              
36             =item Platform
37              
38             The platform number for this subtable
39              
40             =item Encoding
41              
42             The encoding number for this subtable
43              
44             =item Format
45              
46             Gives the stored format of this subtable
47              
48             =item Ver
49              
50             Gives the version (or language) information for this subtable
51              
52             =item val
53              
54             A hash keyed by the codepoint value (not a string) storing the glyph id
55              
56             =back
57              
58             =back
59              
60             The following cmap options are controlled by instance variables that start with a space:
61              
62             =over 4
63              
64             =item allowholes
65              
66             By default, when generating format 4 cmap subtables character codes that point to glyph zero
67             (normally called .notdef) are not included in the subtable. In some cases including some of these
68             character codes can result in a smaller format 4 subtable. To enable this behavior, set allowholes
69             to non-zero.
70              
71             =back
72              
73             =head1 METHODS
74              
75             =cut
76              
77 1     1   3 use strict;
  1         1  
  1         23  
78 1     1   3 use vars qw(@ISA);
  1         1  
  1         28  
79 1     1   3 use Font::TTF::Table;
  1         1  
  1         12  
80 1     1   3 use Font::TTF::Utils;
  1         0  
  1         2700  
81              
82             @ISA = qw(Font::TTF::Table);
83              
84              
85             =head2 $t->read
86              
87             Reads the cmap into memory. Format 4 subtables read the whole subtable and
88             fill in the segmented array accordingly.
89              
90             =cut
91              
92             sub read
93             {
94 2     2 1 14 my ($self, $keepzeros) = @_;
95 2 50       9 $self->SUPER::read or return $self;
96              
97 2         48 my ($dat, $i, $j, $k, $id, @ids, $s);
98 0         0 my ($start, $end, $range, $delta, $form, $len, $num, $ver, $sg);
99 2         5 my ($fh) = $self->{' INFILE'};
100              
101 2         6 $fh->read($dat, 4);
102 2         20 $self->{'Num'} = unpack("x2n", $dat);
103 2         4 $self->{'Tables'} = [];
104 2         7 for ($i = 0; $i < $self->{'Num'}; $i++)
105             {
106 4         5 $s = {};
107 4         7 $fh->read($dat, 8);
108 4         26 ($s->{'Platform'}, $s->{'Encoding'}, $s->{'LOC'}) = (unpack("nnN", $dat));
109 4         6 $s->{'LOC'} += $self->{' OFFSET'};
110 4         4 push(@{$self->{'Tables'}}, $s);
  4         10  
111             }
112 2         5 for ($i = 0; $i < $self->{'Num'}; $i++)
113             {
114 4         5 $s = $self->{'Tables'}[$i];
115 4         11 $fh->seek($s->{'LOC'}, 0);
116 4         37 $fh->read($dat, 2);
117 4         25 $form = unpack("n", $dat);
118              
119 4         5 $s->{'Format'} = $form;
120 4 50 0     14 if ($form == 0)
    50 0        
    50          
    50          
    0          
    0          
121             {
122 0         0 my $j = 0;
123              
124 0         0 $fh->read($dat, 4);
125 0         0 ($len, $s->{'Ver'}) = unpack('n2', $dat);
126 0         0 $fh->read($dat, 256);
127 0 0       0 $s->{'val'} = {map {$j++; ($_ ? ($j - 1, $_) : ())} unpack("C*", $dat)};
  0         0  
  0         0  
128             } elsif ($form == 6)
129             {
130 0         0 my ($start, $ecount);
131            
132 0         0 $fh->read($dat, 8);
133 0         0 ($len, $s->{'Ver'}, $start, $ecount) = unpack('n4', $dat);
134 0         0 $fh->read($dat, $ecount << 1);
135 0 0       0 $s->{'val'} = {map {$start++; ($_ ? ($start - 1, $_) : ())} unpack("n*", $dat)};
  0         0  
  0         0  
136             } elsif ($form == 2) # Contributed by Huw Rogers
137             {
138 0         0 $fh->read($dat, 4);
139 0         0 ($len, $s->{'Ver'}) = unpack('n2', $dat);
140 0         0 $fh->read($dat, 512);
141 0         0 my ($j, $k, $l, $m, $n, @subHeaderKeys, @subHeaders, $subHeader);
142 0         0 $n = 1;
143 0         0 for ($j = 0; $j < 256; $j++) {
144 0         0 my $k = unpack('@'.($j<<1).'n', $dat)>>3;
145 0 0       0 $n = $k + 1 if $k >= $n;
146 0   0     0 $subHeaders[$subHeaderKeys[$j] = $k] ||= [ ];
147             }
148 0         0 $fh->read($dat, $n<<3); # read subHeaders[]
149 0         0 for ($k = 0; $k < $n; $k++) {
150 0         0 $subHeader = $subHeaders[$k];
151 0         0 $l = $k<<3;
152 0         0 @$subHeader = unpack('@'.$l.'n4', $dat);
153 0 0       0 $subHeader->[2] = unpack('s', pack('S', $subHeader->[2]))
154             if $subHeader->[2] & 0x8000; # idDelta
155 0         0 $subHeader->[3] =
156             ($subHeader->[3] - (($n - $k)<<3) + 6)>>1; # idRangeOffset
157             }
158 0         0 $fh->read($dat, $len - ($n<<3) - 518); # glyphIndexArray[]
159 0         0 for ($j = 0; $j < 256; $j++) {
160 0         0 $k = $subHeaderKeys[$j];
161 0         0 $subHeader = $subHeaders[$k];
162 0 0       0 unless ($k) {
163 0         0 $l = $j - $subHeader->[0];
164 0 0 0     0 if ($l >= 0 && $l < $subHeader->[1]) {
165 0         0 $m = unpack('@'.(($l + $subHeader->[3])<<1).'n', $dat);
166 0 0       0 $m += $subHeader->[2] if $m;
167 0         0 $s->{'val'}{$j} = $m;
168             }
169             } else {
170 0         0 for ($l = 0; $l < $subHeader->[1]; $l++) {
171 0         0 $m = unpack('@'.(($l + $subHeader->[3])<<1).'n', $dat);
172 0 0       0 $m += $subHeader->[2] if $m;
173 0         0 $s->{'val'}{($j<<8) + $l + $subHeader->[0]} = $m;
174             }
175             }
176             }
177             } elsif ($form == 4)
178             {
179 4         7 $fh->read($dat, 12);
180 4         23 ($len, $s->{'Ver'}, $num) = unpack('n3', $dat);
181 4         4 $num >>= 1;
182 4         9 $fh->read($dat, $len - 14);
183 4         23 for ($j = 0; $j < $num; $j++)
184             {
185 8         11 $end = unpack("n", substr($dat, $j << 1, 2));
186 8         10 $start = unpack("n", substr($dat, ($j << 1) + ($num << 1) + 2, 2));
187 8         11 $delta = unpack("n", substr($dat, ($j << 1) + ($num << 2) + 2, 2));
188 8 100       10 $delta -= 65536 if $delta > 32767;
189 8         10 $range = unpack("n", substr($dat, ($j << 1) + $num * 6 + 2, 2));
190 8         16 for ($k = $start; $k <= $end; $k++)
191             {
192 384 50 33     476 if ($range == 0 || $range == 65535) # support the buggy FOG with its range=65535 for final segment
193 384         239 { $id = $k + $delta; }
194             else
195 0         0 { $id = unpack("n", substr($dat, ($j << 1) + $num * 6 +
196             2 + ($k - $start) * 2 + $range, 2)) + $delta; }
197 384 100       383 $id -= 65536 if $id >= 65536;
198 384 100 66     801 $s->{'val'}{$k} = $id if ($id || $keepzeros);
199             }
200             }
201             } elsif ($form == 8 || $form == 12 || $form == 13)
202             {
203 0         0 $fh->read($dat, 10);
204 0         0 ($len, $s->{'Ver'}) = unpack('x2N2', $dat);
205 0 0       0 if ($form == 8)
206             {
207 0         0 $fh->read($dat, 8196);
208 0         0 $num = unpack("N", substr($dat, 8192, 4)); # don't need the map
209             } else
210             {
211 0         0 $fh->read($dat, 4);
212 0         0 $num = unpack("N", $dat);
213             }
214 0         0 $fh->read($dat, 12 * $num);
215 0         0 for ($j = 0; $j < $num; $j++)
216             {
217 0         0 ($start, $end, $sg) = unpack("N3", substr($dat, $j * 12, 12));
218 0         0 for ($k = $start; $k <= $end; $k++)
219 0 0       0 { $s->{'val'}{$k} = $form == 13 ? $sg : $sg++; }
220             }
221             } elsif ($form == 10)
222             {
223 0         0 $fh->read($dat, 18);
224 0         0 ($len, $s->{'Ver'}, $start, $num) = unpack('x2N4', $dat);
225 0         0 $fh->read($dat, $num << 1);
226 0         0 for ($j = 0; $j < $num; $j++)
227 0         0 { $s->{'val'}{$start + $j} = unpack("n", substr($dat, $j << 1, 2)); }
228             }
229             }
230 2         6 $self;
231             }
232              
233              
234             =head2 $t->ms_lookup($uni)
235              
236             Finds a Unicode table, giving preference to the MS one, and looks up the given
237             Unicode codepoint in it to find the glyph id.
238              
239             =cut
240              
241             sub ms_lookup
242             {
243 0     0 1 0 my ($self, $uni) = @_;
244              
245 0 0 0     0 $self->find_ms || return undef unless (defined $self->{' mstable'});
246 0         0 return $self->{' mstable'}{'val'}{$uni};
247             }
248              
249              
250             =head2 $t->find_ms
251              
252             Finds the a Unicode table, giving preference to the Microsoft one, and sets the C instance variable
253             to it if found. Returns the table it finds.
254              
255             =cut
256              
257             sub find_ms
258             {
259 0     0 1 0 my ($self) = @_;
260 0         0 my ($i, $s, $alt, $found);
261              
262 0 0       0 return $self->{' mstable'} if defined $self->{' mstable'};
263 0         0 $self->read;
264 0         0 for ($i = 0; $i < $self->{'Num'}; $i++)
265             {
266 0         0 $s = $self->{'Tables'}[$i];
267 0 0 0     0 if ($s->{'Platform'} == 3)
    0 0        
268             {
269 0         0 $self->{' mstable'} = $s;
270 0 0       0 return $s if ($s->{'Encoding'} == 10);
271 0 0       0 $found = 1 if ($s->{'Encoding'} == 1);
272             } elsif ($s->{'Platform'} == 0 || ($s->{'Platform'} == 2 && $s->{'Encoding'} == 1))
273 0         0 { $alt = $s; }
274             }
275 0 0 0     0 $self->{' mstable'} = $alt if ($alt && !$found);
276 0         0 $self->{' mstable'};
277             }
278              
279              
280             =head2 $t->ms_enc
281              
282             Returns the encoding of the microsoft table (0 => symbol, etc.). Returns undef if there is
283             no Microsoft cmap.
284              
285             =cut
286              
287             sub ms_enc
288             {
289 0     0 1 0 my ($self) = @_;
290 0         0 my ($s);
291            
292             return $self->{' mstable'}{'Encoding'}
293 0 0 0     0 if (defined $self->{' mstable'} && $self->{' mstable'}{'Platform'} == 3);
294            
295 0         0 foreach $s (@{$self->{'Tables'}})
  0         0  
296             {
297 0 0       0 return $s->{'Encoding'} if ($s->{'Platform'} == 3);
298             }
299 0         0 return undef;
300             }
301              
302              
303             =head2 $t->out($fh)
304              
305             Writes out a cmap table to a filehandle. If it has not been read, then
306             just copies from input file to output
307              
308             =cut
309              
310             sub out
311             {
312 2     2 1 4 my ($self, $fh) = @_;
313 2         2 my ($loc, $s, $i, $base_loc, $j, @keys);
314              
315 2 50       6 return $self->SUPER::out($fh) unless $self->{' read'};
316              
317              
318             $self->{'Tables'} = [sort {$a->{'Platform'} <=> $b->{'Platform'}
319             || $a->{'Encoding'} <=> $b->{'Encoding'}
320 2 50 33     2 || $a->{'Ver'} <=> $b->{'Ver'}} @{$self->{'Tables'}}];
  2         12  
  2         13  
321 2         4 $self->{'Num'} = scalar @{$self->{'Tables'}};
  2         4  
322              
323 2         9 $base_loc = $fh->tell();
324 2         13 $fh->print(pack("n2", 0, $self->{'Num'}));
325              
326 2         13 for ($i = 0; $i < $self->{'Num'}; $i++)
327 4         18 { $fh->print(pack("nnN", $self->{'Tables'}[$i]{'Platform'}, $self->{'Tables'}[$i]{'Encoding'}, 0)); }
328              
329 2         12 for ($i = 0; $i < $self->{'Num'}; $i++)
330             {
331 4         16 $s = $self->{'Tables'}[$i];
332 4 50       11 if ($s->{'Format'} < 8)
333 4         6 { @keys = sort {$a <=> $b} grep { $_ <= 0xFFFF} keys %{$s->{'val'}}; }
  2031         1175  
  380         344  
  4         65  
334             else
335 0         0 { @keys = sort {$a <=> $b} keys %{$s->{'val'}}; }
  0         0  
  0         0  
336 4         22 $s->{' outloc'} = $fh->tell();
337 4 50       18 if ($s->{'Format'} < 8)
338 4         15 { $fh->print(pack("n3", $s->{'Format'}, 0, $s->{'Ver'})); } # come back for length
339             else
340 0         0 { $fh->print(pack("n2N2", $s->{'Format'}, 0, 0, $s->{'Ver'})); }
341            
342 4 50 0     29 if ($s->{'Format'} == 0)
    50 0        
    50          
    50          
    0          
    0          
343             {
344 0 0       0 $fh->print(pack("C256", map {defined $_ ? $_ : 0} @{$s->{'val'}}{0 .. 255}));
  0         0  
  0         0  
345             } elsif ($s->{'Format'} == 6)
346             {
347 0         0 $fh->print(pack("n2", $keys[0], $keys[-1] - $keys[0] + 1));
348 0 0       0 $fh->print(pack("n*", map {defined $_ ? $_ : 0} @{$s->{'val'}}{$keys[0] .. $keys[-1]}));
  0         0  
  0         0  
349             } elsif ($s->{'Format'} == 2) # Contributed by Huw Rogers
350             {
351 0         0 my ($g, $k, $h, $l, $m, $n);
352 0         0 my (@subHeaderKeys, @subHeaders, $subHeader, @glyphIndexArray);
353 0         0 $n = 0;
354 0         0 @subHeaderKeys = (-1) x 256;
355 0         0 for $j (@keys) {
356 0 0       0 next unless defined($g = $s->{'val'}{$j});
357 0         0 $h = int($j>>8);
358 0         0 $l = ($j & 0xff);
359 0 0       0 if (($k = $subHeaderKeys[$h]) < 0) {
360 0         0 $subHeader = [ $l, 1, 0, 0, [ $g ] ];
361 0         0 $subHeaders[$k = $n++] = $subHeader;
362 0         0 $subHeaderKeys[$h] = $k;
363             } else {
364 0         0 $subHeader = $subHeaders[$k];
365 0         0 $m = ($l - $subHeader->[0] + 1) - $subHeader->[1];
366 0         0 $subHeader->[1] += $m;
367 0         0 push @{$subHeader->[4]}, (0) x ($m - 1), $g - $subHeader->[2];
  0         0  
368             }
369             }
370 0 0       0 @subHeaderKeys = map { $_ < 0 ? 0 : $_ } @subHeaderKeys;
  0         0  
371 0         0 $subHeader = $subHeaders[0];
372 0         0 $subHeader->[3] = 0;
373 0         0 push @glyphIndexArray, @{$subHeader->[4]};
  0         0  
374 0         0 splice(@$subHeader, 4);
375             {
376 0         0 my @subHeaders_ = sort {@{$a->[4]} <=> @{$b->[4]}} @subHeaders[1..$#subHeaders];
  0         0  
  0         0  
  0         0  
  0         0  
377 0         0 my ($f, $d, $r, $subHeader_);
378 0         0 for ($k = 0; $k < @subHeaders_; $k++) {
379 0         0 $subHeader = $subHeaders_[$k];
380 0         0 $f = $r = shift @{$subHeader->[4]};
  0         0  
381             $subHeader->[5] = join(':',
382             map {
383 0         0 $d = $_ - $r;
384 0         0 $r = $_;
385 0 0       0 $d < 0 ?
386             sprintf('-%04x', -$d) :
387             sprintf('+%04x', $d)
388 0         0 } @{$subHeader->[4]});
  0         0  
389 0         0 unshift @{$subHeader->[4]}, $f;
  0         0  
390             }
391 0         0 for ($k = 0; $k < @subHeaders_; $k++) {
392 0         0 $subHeader = $subHeaders_[$k];
393 0 0       0 next unless $subHeader->[4];
394 0         0 $subHeader->[3] = @glyphIndexArray;
395 0         0 push @glyphIndexArray, @{$subHeader->[4]};
  0         0  
396 0         0 for ($l = $k + 1; $l < @subHeaders_; $l++) {
397 0         0 $subHeader_ = $subHeaders_[$l];
398 0 0       0 next unless $subHeader_->[4];
399 0         0 $d = $subHeader_->[5];
400 0 0       0 if ($subHeader->[5] =~ /\Q$d\E/) {
401 0         0 my $o = length($`)/6; #`
402 0         0 $subHeader_->[2] +=
403             $subHeader_->[4]->[$o] - $subHeader->[4]->[0];
404 0         0 $subHeader_->[3] = $subHeader->[3] + $o;
405 0         0 splice(@$subHeader_, 4);
406             }
407             }
408 0         0 splice(@$subHeader, 4);
409             }
410             }
411 0         0 $fh->print(pack('n*', map { $_<<3 } @subHeaderKeys));
  0         0  
412 0         0 for ($j = 0; $j < 256; $j++) {
413 0         0 $k = $subHeaderKeys[$j];
414 0         0 $subHeader = $subHeaders[$k];
415             }
416 0         0 for ($k = 0; $k < $n; $k++) {
417 0         0 $subHeader = $subHeaders[$k];
418 0 0       0 $fh->print(pack('n4',
419             $subHeader->[0],
420             $subHeader->[1],
421             $subHeader->[2] < 0 ?
422             unpack('S', pack('s', $subHeader->[2])) :
423             $subHeader->[2],
424             ($subHeader->[3]<<1) + (($n - $k)<<3) - 6
425             ));
426             }
427 0         0 $fh->print(pack('n*', @glyphIndexArray));
428             } elsif ($s->{'Format'} == 4)
429             {
430 4         4 my (@starts, @ends, @deltas, @range);
431              
432             # There appears to be a bug in Windows that requires the final 0xFFFF (sentry)
433             # to be in a segment by itself -- otherwise Windows 7 and 8 (at least) won't install
434             # or preview the font, complaining that it doesn't appear to be a valid font.
435             # Therefore we can't just add 0XFFFF to the USV list as we used to do:
436             # push(@keys, 0xFFFF) unless ($keys[-1] == 0xFFFF);
437             # Instead, for now *remove* 0xFFFF from the USV list, and add a segement
438             # for it after all the other segments are computed.
439 4 50       8 pop @keys if $keys[-1] == 0xFFFF;
440            
441             # Step 1: divide into maximal length idDelta runs
442            
443 4         4 my ($prevUSV, $prevgid);
444 4         9 for ($j = 0; $j <= $#keys; $j++)
445             {
446 380         259 my $u = $keys[$j];
447 380         255 my $g = $s->{'val'}{$u};
448 380 50 66     1283 if ($j == 0 || $u != $prevUSV+1 || $g != $prevgid+1)
      66        
449             {
450 4 50       15 push @ends, $prevUSV unless $j == 0;
451 4         4 push @starts, $u;
452 4         2 push @range, 0;
453             }
454 380         226 $prevUSV = $u;
455 380         441 $prevgid = $g;
456             }
457 4         4 push @ends, $prevUSV;
458            
459             # Step 2: find each macro-range
460            
461 4         3 my ($start, $end); # Start and end of macro-range
462 4         8 for ($start = 0; $start < $#starts; $start++)
463             {
464 0 0       0 next if $ends[$start] - $starts[$start] > 7; # if count > 8, we always treat this as a run unto itself
465 0         0 for ($end = $start+1; $end <= $#starts; $end++)
466             {
467 0 0 0     0 last if $starts[$end] - $ends[$end-1] > ($self->{' allowholes'} ? 5 : 1)
    0          
468             || $ends[$end] - $starts[$end] > 7; # gap > 4 or count > 8 so $end is beyond end of macro-range
469             }
470 0         0 $end--; #Ending index of this macro-range
471            
472             # Step 3: optimize this macro-range (from $start through $end)
473 0         0 L1: for ($j = $start; $j < $end; )
474             {
475 0 0       0 my $size1 = ($range[$j] ? 8 + 2 * ($ends[$j] - $starts[$j] + 1) : 8); # size of first range (which may now be idRange type)
476 0         0 for (my $k = $j+1; $k <= $end; $k++)
477             {
478 0 0       0 if (8 + 2 * ($ends[$k] - $starts[$j] + 1) <= $size1 + 8 * ($k - $j))
479             {
480             # Need to coalesce $j..$k into $j:
481 0         0 $ends[$j] = $ends[$k];
482 0         0 $range[$j] = 1; # for now use boolean to indicate this is an idRange segment
483 0         0 splice @starts, $j+1, $k-$j;
484 0         0 splice @ends, $j+1, $k-$j;
485 0         0 splice @range, $j+1, $k-$j;
486 0         0 $end -= ($k-$j);
487 0         0 next L1; # Note that $j isn't incremented so this is a redo
488             }
489             }
490             # Nothing coalesced
491 0         0 $j++;
492             }
493            
494             # Finished with this macro-range
495 0         0 $start = $end;
496             }
497              
498             # Ok, add the final segment containing the sentry value
499 4         6 push(@keys, 0xFFFF);
500 4         3 push @starts, 0xFFFF;
501 4         4 push @ends, 0xFFFF;
502 4         4 push @range, 0;
503            
504             # What is left is a collection of segments that will represent the cmap in mimimum-sized format 4 subtable
505            
506 4         3 my ($num, $count, $sRange, $eSel, $eShift);
507              
508 4         4 $num = scalar(@starts);
509 4         4 $count = 0;
510 4         8 for ($j = 0; $j < $num; $j++)
511             {
512 8 50       10 if ($range[$j])
513             {
514 0         0 $range[$j] = ($count + $num - $j) << 1;
515 0         0 $count += $ends[$j] - $starts[$j] + 1;
516 0         0 push @deltas, 0;
517             }
518             else
519             {
520 8   100     28 push @deltas, ($s->{'val'}{$starts[$j]} || 0) - $starts[$j];
521             }
522             }
523              
524 4         11 ($num, $sRange, $eSel, $eShift) = Font::TTF::Utils::TTF_bininfo($num, 2);
525 4         14 $fh->print(pack("n4", $num * 2, $sRange, $eSel, $eShift));
526 4         22 $fh->print(pack("n*", @ends));
527 4         13 $fh->print(pack("n", 0));
528 4         16 $fh->print(pack("n*", @starts));
529 4         15 $fh->print(pack("n*", @deltas));
530 4         16 $fh->print(pack("n*", @range));
531              
532 4         14 for ($j = 0; $j < $num; $j++)
533             {
534 8 50       24 next if ($range[$j] == 0);
535 0 0       0 $fh->print(pack("n*", map {$_ || 0} @{$s->{'val'}}{$starts[$j] .. $ends[$j]}));
  0         0  
  0         0  
536             }
537             } elsif ($s->{'Format'} == 8 || $s->{'Format'} == 12 || $s->{'Format'} == 13)
538             {
539 0         0 my (@jobs, $start, $current, $curr_glyf, $map);
540            
541 0         0 $current = 0; $curr_glyf = 0;
  0         0  
542 0         0 $map = "\000" x 8192;
543 0         0 foreach $j (@keys)
544             {
545 0 0 0     0 if ($j > 0xFFFF && $s->{'Format'} == 8)
546             {
547 0 0       0 if (defined $s->{'val'}{$j >> 16})
548 0         0 { $s->{'Format'} = 12; }
549 0         0 vec($map, $j >> 16, 1) = 1;
550             }
551 0 0 0     0 if ($j != $current + 1 || $s->{'val'}{$j} != ($s->{'Format'} == 13 ? $curr_glyf : $curr_glyf + 1))
    0          
552             {
553 0 0       0 push (@jobs, [$start, $current, $s->{'Format'} == 13 ? $curr_glyf : $curr_glyf - ($current - $start)]) if (defined $start);
    0          
554 0         0 $start = $j; $current = $j; $curr_glyf = $s->{'val'}{$j};
  0         0  
  0         0  
555             }
556 0         0 $current = $j;
557 0         0 $curr_glyf = $s->{'val'}{$j};
558             }
559 0 0       0 push (@jobs, [$start, $current, $s->{'Format'} == 13 ? $curr_glyf : $curr_glyf - ($current - $start)]) if (defined $start);
    0          
560 0 0       0 $fh->print($map) if ($s->{'Format'} == 8);
561 0         0 $fh->print(pack('N', $#jobs + 1));
562 0         0 foreach $j (@jobs)
563 0         0 { $fh->print(pack('N3', @{$j})); }
  0         0  
564             } elsif ($s->{'Format'} == 10)
565             {
566 0         0 $fh->print(pack('N2', $keys[0], $keys[-1] - $keys[0] + 1));
567 0         0 $fh->print(pack('n*', $s->{'val'}{$keys[0] .. $keys[-1]}));
568             }
569              
570 4         9 $loc = $fh->tell();
571 4 50       18 if ($s->{'Format'} < 8)
572             {
573 4         11 $fh->seek($s->{' outloc'} + 2, 0);
574 4         52 $fh->print(pack("n", $loc - $s->{' outloc'}));
575             } else
576             {
577 0         0 $fh->seek($s->{' outloc'} + 4, 0);
578 0         0 $fh->print(pack("N", $loc - $s->{' outloc'}));
579             }
580 4         22 $fh->seek($base_loc + 8 + ($i << 3), 0);
581 4         31 $fh->print(pack("N", $s->{' outloc'} - $base_loc));
582 4         15 $fh->seek($loc, 0);
583             }
584 2         20 $self;
585             }
586              
587              
588             =head2 $t->XML_element($context, $depth, $name, $val)
589              
590             Outputs the elements of the cmap in XML. We only need to process val here
591              
592             =cut
593              
594             sub XML_element
595             {
596 0     0 1   my ($self, $context, $depth, $k, $val) = @_;
597 0           my ($fh) = $context->{'fh'};
598 0           my ($i);
599              
600 0 0         return $self if ($k eq 'LOC');
601 0 0         return $self->SUPER::XML_element($context, $depth, $k, $val) unless ($k eq 'val');
602              
603 0           $fh->print("$depth\n");
604 0           foreach $i (sort {$a <=> $b} keys %{$val})
  0            
  0            
605 0           { $fh->printf("%s\n", $depth . $context->{'indent'}, $i, $val->{$i}); }
606 0           $fh->print("$depth\n");
607 0           $self;
608             }
609              
610              
611             =head2 $t->minsize()
612              
613             Returns the minimum size this table can be in bytes. If it is smaller than this, then the table
614             must be bad and should be deleted or whatever.
615              
616             =cut
617              
618             sub minsize
619             {
620 0     0 1   return 4;
621             }
622              
623              
624             =head2 $t->update
625              
626             Tidies the cmap table.
627              
628             Removes MS Fmt12 cmap if it is no longer needed.
629              
630             Removes from all cmaps any codepoint that map to GID=0. Note that such entries will
631             be re-introduced as necessary depending on the cmap format.
632              
633             =cut
634              
635             sub update
636             {
637 0     0 1   my ($self) = @_;
638 0           my ($max, $code, $gid, @keep);
639            
640 0 0         return undef unless ($self->SUPER::update);
641              
642 0           foreach my $s (@{$self->{'Tables'}})
  0            
643             {
644 0           $max = 0;
645 0           while (($code, $gid) = each %{$s->{'val'}})
  0            
646             {
647 0 0         if ($gid)
648             {
649             # remember max USV
650 0 0         $max = $code if $max < $code;
651             }
652             else
653             {
654             # Remove unneeded key
655 0           delete $s->{'val'}{$code}; # nb: this is a safe delete according to perldoc perlfunc.
656             }
657             }
658 0 0 0       push @keep, $s unless $s->{'Platform'} == 3 && $s->{'Encoding'} == 10 && $s->{'Format'} == 12 && $max <= 0xFFFF;
      0        
      0        
659             }
660            
661 0           $self->{'Tables'} = [ @keep ];
662            
663 0           delete $self->{' mstable'}; # Force rediscovery of this.
664            
665 0           $self;
666             }
667              
668             =head2 @map = $t->reverse(%opt)
669              
670             Returns a reverse map of the Unicode cmap. I.e. given a glyph gives the Unicode value for it. Options are:
671              
672             =over 4
673              
674             =item tnum
675              
676             Table number to use rather than the default Unicode table
677              
678             =item array
679              
680             Returns each element of reverse as an array since a glyph may be mapped by more
681             than one Unicode value. The arrays are unsorted. Otherwise store any one unicode value for a glyph.
682              
683             =back
684              
685             =cut
686              
687             sub reverse
688             {
689 0     0 1   my ($self, %opt) = @_;
690 0 0         my ($table) = defined $opt{'tnum'} ? $self->{'Tables'}[$opt{'tnum'}] : $self->find_ms;
691 0           my (@res, $code, $gid);
692              
693 0           while (($code, $gid) = each(%{$table->{'val'}}))
  0            
694             {
695 0 0         if ($opt{'array'})
696 0           { push (@{$res[$gid]}, $code); }
  0            
697             else
698 0 0 0       { $res[$gid] = $code unless (defined $res[$gid] && $res[$gid] > 0 && $res[$gid] < $code); }
      0        
699             }
700 0           @res;
701             }
702              
703              
704             =head2 is_unicode($index)
705              
706             Returns whether the table of a given index is known to be a unicode table
707             (as specified in the specifications)
708              
709             =cut
710              
711             sub is_unicode
712             {
713 0     0 1   my ($self, $index) = @_;
714 0           my ($pid, $eid) = ($self->{'Tables'}[$index]{'Platform'}, $self->{'Tables'}[$index]{'Encoding'});
715              
716 0   0       return ($pid == 3 || $pid == 0 || ($pid == 2 && $eid == 1));
717             }
718              
719             1;
720              
721             =head1 BUGS
722              
723             =over 4
724              
725             =item *
726              
727             Format 14 (Unicode Variation Sequences) cmaps are not supported.
728              
729             =back
730              
731             =head1 AUTHOR
732              
733             Martin Hosken L.
734              
735              
736             =head1 LICENSING
737              
738             Copyright (c) 1998-2016, SIL International (http://www.sil.org)
739              
740             This module is released under the terms of the Artistic License 2.0.
741             For details, see the full text of the license in the file LICENSE.
742              
743              
744              
745             =cut
746