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
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
39
|
|
78
|
1
|
|
|
1
|
|
4
|
use vars qw(@ISA); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
79
|
1
|
|
|
1
|
|
4
|
use Font::TTF::Table; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
13
|
|
80
|
1
|
|
|
1
|
|
3
|
use Font::TTF::Utils; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3185
|
|
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
|
13
|
my ($self, $keepzeros) = @_; |
95
|
2
|
50
|
|
|
|
98
|
$self->SUPER::read or return $self; |
96
|
|
|
|
|
|
|
|
97
|
2
|
|
|
|
|
4
|
my ($dat, $i, $j, $k, $id, @ids, $s); |
98
|
0
|
|
|
|
|
0
|
my ($start, $end, $range, $delta, $form, $len, $num, $ver, $sg); |
99
|
2
|
|
|
|
|
6
|
my ($fh) = $self->{' INFILE'}; |
100
|
|
|
|
|
|
|
|
101
|
2
|
|
|
|
|
6
|
$fh->read($dat, 4); |
102
|
2
|
|
|
|
|
94
|
$self->{'Num'} = unpack("x2n", $dat); |
103
|
2
|
|
|
|
|
5
|
$self->{'Tables'} = []; |
104
|
2
|
|
|
|
|
10
|
for ($i = 0; $i < $self->{'Num'}; $i++) |
105
|
|
|
|
|
|
|
{ |
106
|
4
|
|
|
|
|
5
|
$s = {}; |
107
|
4
|
|
|
|
|
9
|
$fh->read($dat, 8); |
108
|
4
|
|
|
|
|
33
|
($s->{'Platform'}, $s->{'Encoding'}, $s->{'LOC'}) = (unpack("nnN", $dat)); |
109
|
4
|
|
|
|
|
7
|
$s->{'LOC'} += $self->{' OFFSET'}; |
110
|
4
|
|
|
|
|
4
|
push(@{$self->{'Tables'}}, $s); |
|
4
|
|
|
|
|
12
|
|
111
|
|
|
|
|
|
|
} |
112
|
2
|
|
|
|
|
6
|
for ($i = 0; $i < $self->{'Num'}; $i++) |
113
|
|
|
|
|
|
|
{ |
114
|
4
|
|
|
|
|
6
|
$s = $self->{'Tables'}[$i]; |
115
|
4
|
|
|
|
|
12
|
$fh->seek($s->{'LOC'}, 0); |
116
|
4
|
|
|
|
|
39
|
$fh->read($dat, 2); |
117
|
4
|
|
|
|
|
29
|
$form = unpack("n", $dat); |
118
|
|
|
|
|
|
|
|
119
|
4
|
|
|
|
|
11
|
$s->{'Format'} = $form; |
120
|
4
|
50
|
0
|
|
|
17
|
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
|
|
|
|
|
9
|
$fh->read($dat, 12); |
180
|
4
|
|
|
|
|
27
|
($len, $s->{'Ver'}, $num) = unpack('n3', $dat); |
181
|
4
|
|
|
|
|
5
|
$num >>= 1; |
182
|
4
|
|
|
|
|
9
|
$fh->read($dat, $len - 14); |
183
|
4
|
|
|
|
|
26
|
for ($j = 0; $j < $num; $j++) |
184
|
|
|
|
|
|
|
{ |
185
|
8
|
|
|
|
|
14
|
$end = unpack("n", substr($dat, $j << 1, 2)); |
186
|
8
|
|
|
|
|
15
|
$start = unpack("n", substr($dat, ($j << 1) + ($num << 1) + 2, 2)); |
187
|
8
|
|
|
|
|
10
|
$delta = unpack("n", substr($dat, ($j << 1) + ($num << 2) + 2, 2)); |
188
|
8
|
100
|
|
|
|
19
|
$delta -= 65536 if $delta > 32767; |
189
|
8
|
|
|
|
|
15
|
$range = unpack("n", substr($dat, ($j << 1) + $num * 6 + 2, 2)); |
190
|
8
|
|
|
|
|
18
|
for ($k = $start; $k <= $end; $k++) |
191
|
|
|
|
|
|
|
{ |
192
|
384
|
50
|
33
|
|
|
546
|
if ($range == 0 || $range == 65535) # support the buggy FOG with its range=65535 for final segment |
193
|
384
|
|
|
|
|
285
|
{ $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
|
|
|
|
454
|
$id -= 65536 if $id >= 65536; |
198
|
384
|
100
|
66
|
|
|
992
|
$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
|
|
|
|
|
7
|
$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
|
0
|
0
|
0
|
|
|
0
|
return $self->{' mstable'}{'Encoding'} |
293
|
|
|
|
|
|
|
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
|
5
|
my ($self, $fh) = @_; |
313
|
2
|
|
|
|
|
5
|
my ($loc, $s, $i, $base_loc, $j, @keys); |
314
|
|
|
|
|
|
|
|
315
|
2
|
50
|
|
|
|
9
|
return $self->SUPER::out($fh) unless $self->{' read'}; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
|
318
|
2
|
50
|
33
|
|
|
28
|
$self->{'Tables'} = [sort {$a->{'Platform'} <=> $b->{'Platform'} |
|
2
|
|
|
|
|
17
|
|
319
|
|
|
|
|
|
|
|| $a->{'Encoding'} <=> $b->{'Encoding'} |
320
|
2
|
|
|
|
|
4
|
|| $a->{'Ver'} <=> $b->{'Ver'}} @{$self->{'Tables'}}]; |
321
|
2
|
|
|
|
|
7
|
$self->{'Num'} = scalar @{$self->{'Tables'}}; |
|
2
|
|
|
|
|
7
|
|
322
|
|
|
|
|
|
|
|
323
|
2
|
|
|
|
|
8
|
$base_loc = $fh->tell(); |
324
|
2
|
|
|
|
|
23
|
$fh->print(pack("n2", 0, $self->{'Num'})); |
325
|
|
|
|
|
|
|
|
326
|
2
|
|
|
|
|
20
|
for ($i = 0; $i < $self->{'Num'}; $i++) |
327
|
4
|
|
|
|
|
37
|
{ $fh->print(pack("nnN", $self->{'Tables'}[$i]{'Platform'}, $self->{'Tables'}[$i]{'Encoding'}, 0)); } |
328
|
|
|
|
|
|
|
|
329
|
2
|
|
|
|
|
20
|
for ($i = 0; $i < $self->{'Num'}; $i++) |
330
|
|
|
|
|
|
|
{ |
331
|
4
|
|
|
|
|
33
|
$s = $self->{'Tables'}[$i]; |
332
|
4
|
50
|
|
|
|
13
|
if ($s->{'Format'} < 8) |
333
|
4
|
|
|
|
|
6
|
{ @keys = sort {$a <=> $b} grep { $_ <= 0xFFFF} keys %{$s->{'val'}}; } |
|
2046
|
|
|
|
|
1871
|
|
|
380
|
|
|
|
|
559
|
|
|
4
|
|
|
|
|
133
|
|
334
|
|
|
|
|
|
|
else |
335
|
0
|
|
|
|
|
0
|
{ @keys = sort {$a <=> $b} keys %{$s->{'val'}}; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
336
|
4
|
|
|
|
|
54
|
$s->{' outloc'} = $fh->tell(); |
337
|
4
|
50
|
|
|
|
42
|
if ($s->{'Format'} < 8) |
338
|
4
|
|
|
|
|
27
|
{ $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
|
|
|
57
|
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
|
0
|
|
|
|
|
0
|
$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]}); |
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
|
|
|
|
|
7
|
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
|
|
|
|
13
|
pop @keys if $keys[-1] == 0xFFFF; |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# Step 1: divide into maximal length idDelta runs |
442
|
|
|
|
|
|
|
|
443
|
4
|
|
|
|
|
8
|
my ($prevUSV, $prevgid); |
444
|
4
|
|
|
|
|
17
|
for ($j = 0; $j <= $#keys; $j++) |
445
|
|
|
|
|
|
|
{ |
446
|
380
|
|
|
|
|
403
|
my $u = $keys[$j]; |
447
|
380
|
|
|
|
|
457
|
my $g = $s->{'val'}{$u}; |
448
|
380
|
50
|
66
|
|
|
2036
|
if ($j == 0 || $u != $prevUSV+1 || $g != $prevgid+1) |
|
|
|
66
|
|
|
|
|
449
|
|
|
|
|
|
|
{ |
450
|
4
|
50
|
|
|
|
11
|
push @ends, $prevUSV unless $j == 0; |
451
|
4
|
|
|
|
|
10
|
push @starts, $u; |
452
|
4
|
|
|
|
|
8
|
push @range, 0; |
453
|
|
|
|
|
|
|
} |
454
|
380
|
|
|
|
|
358
|
$prevUSV = $u; |
455
|
380
|
|
|
|
|
772
|
$prevgid = $g; |
456
|
|
|
|
|
|
|
} |
457
|
4
|
|
|
|
|
10
|
push @ends, $prevUSV; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
# Step 2: find each macro-range |
460
|
|
|
|
|
|
|
|
461
|
4
|
|
|
|
|
5
|
my ($start, $end); # Start and end of macro-range |
462
|
4
|
|
|
|
|
18
|
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
|
|
|
|
|
14
|
push(@keys, 0xFFFF); |
500
|
4
|
|
|
|
|
6
|
push @starts, 0xFFFF; |
501
|
4
|
|
|
|
|
7
|
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
|
|
|
|
|
5
|
my ($num, $count, $sRange, $eSel, $eShift); |
507
|
|
|
|
|
|
|
|
508
|
4
|
|
|
|
|
6
|
$num = scalar(@starts); |
509
|
4
|
|
|
|
|
5
|
$count = 0; |
510
|
4
|
|
|
|
|
14
|
for ($j = 0; $j < $num; $j++) |
511
|
|
|
|
|
|
|
{ |
512
|
8
|
50
|
|
|
|
16
|
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
|
|
|
55
|
push @deltas, ($s->{'val'}{$starts[$j]} || 0) - $starts[$j]; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
4
|
|
|
|
|
23
|
($num, $sRange, $eSel, $eShift) = Font::TTF::Utils::TTF_bininfo($num, 2); |
525
|
4
|
|
|
|
|
34
|
$fh->print(pack("n4", $num * 2, $sRange, $eSel, $eShift)); |
526
|
4
|
|
|
|
|
45
|
$fh->print(pack("n*", @ends)); |
527
|
4
|
|
|
|
|
26
|
$fh->print(pack("n", 0)); |
528
|
4
|
|
|
|
|
27
|
$fh->print(pack("n*", @starts)); |
529
|
4
|
|
|
|
|
26
|
$fh->print(pack("n*", @deltas)); |
530
|
4
|
|
|
|
|
34
|
$fh->print(pack("n*", @range)); |
531
|
|
|
|
|
|
|
|
532
|
4
|
|
|
|
|
30
|
for ($j = 0; $j < $num; $j++) |
533
|
|
|
|
|
|
|
{ |
534
|
8
|
50
|
|
|
|
37
|
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
|
|
|
|
|
17
|
$loc = $fh->tell(); |
571
|
4
|
50
|
|
|
|
32
|
if ($s->{'Format'} < 8) |
572
|
|
|
|
|
|
|
{ |
573
|
4
|
|
|
|
|
21
|
$fh->seek($s->{' outloc'} + 2, 0); |
574
|
4
|
|
|
|
|
128
|
$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
|
|
|
|
|
38
|
$fh->seek($base_loc + 8 + ($i << 3), 0); |
581
|
4
|
|
|
|
|
71
|
$fh->print(pack("N", $s->{' outloc'} - $base_loc)); |
582
|
4
|
|
|
|
|
31
|
$fh->seek($loc, 0); |
583
|
|
|
|
|
|
|
} |
584
|
2
|
|
|
|
|
47
|
$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-2014, 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
|
|
|
|
|
|
|
|