File Coverage

blib/lib/Font/TTF/Hmtx.pm
Criterion Covered Total %
statement 42 73 57.5
branch 9 22 40.9
condition n/a
subroutine 7 9 77.7
pod 5 5 100.0
total 63 109 57.8


line stmt bran cond sub pod time code
1             package Font::TTF::Hmtx;
2              
3             =head1 NAME
4              
5             Font::TTF::Hmtx - Horizontal Metrics
6              
7             =head1 DESCRIPTION
8              
9             Contains the advance width and left side bearing for each glyph. Given the
10             compressability of the data onto disk, this table uses information from
11             other tables, and thus must do part of its output during the output of
12             other tables
13              
14             =head1 INSTANCE VARIABLES
15              
16             The horizontal metrics are kept in two arrays by glyph id. The variable names
17             do not start with a space
18              
19             =over 4
20              
21             =item advance
22              
23             An array containing the advance width for each glyph
24              
25             =item lsb
26              
27             An array containing the left side bearing for each glyph
28              
29             =back
30              
31             =head1 METHODS
32              
33             =cut
34              
35 1     1   3 use strict;
  1         2  
  1         34  
36 1     1   33 use vars qw(@ISA);
  1         1  
  1         755  
37             require Font::TTF::Table;
38              
39             @ISA = qw(Font::TTF::Table);
40              
41              
42             =head2 $t->read
43              
44             Reads the horizontal metrics from the TTF file into memory
45              
46             =cut
47              
48             sub read
49             {
50 2     2 1 15 my ($self) = @_;
51 2         4 my ($numh, $numg);
52              
53 2         18 $numh = $self->{' PARENT'}{'hhea'}->read->{'numberOfHMetrics'};
54 2         9 $numg = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
55 2         38 $self->_read($numg, $numh, "advance", "lsb");
56             }
57              
58             sub _read
59             {
60 2     2   6 my ($self, $numg, $numh, $tAdv, $tLsb) = @_;
61 2 50       14 $self->SUPER::read or return $self;
62              
63 2         7 my ($fh) = $self->{' INFILE'};
64 2         4 my ($i, $dat);
65              
66 2         9 for ($i = 0; $i < $numh; $i++)
67             {
68 196         309 $fh->read($dat, 4);
69 196         1342 ($self->{$tAdv}[$i], $self->{$tLsb}[$i]) = unpack("nn", $dat);
70 196 100       522 $self->{$tLsb}[$i] -= 65536 if ($self->{$tLsb}[$i] >= 32768);
71             }
72            
73 2         6 $i--;
74 2         7 while (++$i < $numg)
75             {
76 0         0 $fh->read($dat, 2);
77 0         0 $self->{$tAdv}[$i] = $self->{$tAdv}[$numh - 1];
78 0         0 $self->{$tLsb}[$i] = unpack("n", $dat);
79 0 0       0 $self->{$tLsb}[$i] -= 65536 if ($self->{$tLsb}[$i] >= 32768);
80             }
81 2         14 $self;
82             }
83            
84             =head2 $t->numMetrics
85              
86             Calculates again the number of long metrics required to store the information
87             here. Returns undef if the table has not been read.
88              
89             =cut
90              
91             sub numMetrics
92             {
93 2     2 1 4 my ($self) = @_;
94 2         10 my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
95 2         4 my ($i);
96              
97 2 50       18 return undef unless $self->{' read'};
98              
99 2         9 for ($i = $numg - 2; $i >= 0; $i--)
100 2 50       15 { last if ($self->{'advance'}[$i] != $self->{'advance'}[$i + 1]); }
101              
102 2         13 return $i + 2;
103             }
104              
105              
106             =head2 $t->out($fh)
107              
108             Writes the metrics to a TTF file. Assumes that the C has updated the
109             numHMetrics from here
110              
111             =cut
112              
113             sub out
114             {
115 2     2 1 6 my ($self, $fh) = @_;
116 2         72 my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
117 2         15 my ($numh) = $self->{' PARENT'}{'hhea'}->read->{'numberOfHMetrics'};
118 2         11 $self->_out($fh, $numg, $numh, "advance", "lsb");
119             }
120              
121             sub _out
122             {
123 2     2   5 my ($self, $fh, $numg, $numh, $tAdv, $tLsb) = @_;
124 2         3 my ($i, $lsb);
125              
126 2 50       7 return $self->SUPER::out($fh) unless ($self->{' read'});
127              
128 2         9 for ($i = 0; $i < $numg; $i++)
129             {
130 196         926 $lsb = $self->{$tLsb}[$i];
131 196 100       276 $lsb += 65536 if $lsb < 0;
132 196 50       212 if ($i >= $numh)
133 0         0 { $fh->print(pack("n", $lsb)); }
134             else
135 196         495 { $fh->print(pack("n2", $self->{$tAdv}[$i], $lsb)); }
136             }
137 2         14 $self;
138             }
139              
140              
141             =head2 $t->update
142              
143             Updates the lsb values from the xMin from the each glyph
144              
145             =cut
146              
147             sub update
148             {
149 0     0 1   my ($self) = @_;
150 0           my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
151 0           my ($i);
152              
153 0 0         return undef unless ($self->SUPER::update);
154             # lsb & xMin must always be the same, regardless of any flags!
155             # return $self unless ($self->{' PARENT'}{'head'}{'flags'} & 2); # lsb & xMin the same
156              
157 0           $self->{' PARENT'}{'loca'}->update;
158 0           for ($i = 0; $i < $numg; $i++)
159             {
160 0           my ($g) = $self->{' PARENT'}{'loca'}{'glyphs'}[$i];
161 0 0         if ($g)
162 0           { $self->{'lsb'}[$i] = $g->read->update_bbox->{'xMin'}; }
163             else
164 0           { $self->{'lsb'}[$i] = 0; }
165             }
166 0           $self->{' PARENT'}{'head'}{'flags'} |= 2;
167 0           $self;
168             }
169            
170              
171             =head2 $t->out_xml($context, $depth)
172              
173             Outputs the table in XML
174              
175             =cut
176              
177             sub out_xml
178             {
179 0     0 1   my ($self, $context, $depth) = @_;
180 0           my ($fh) = $context->{'fh'};
181 0           my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
182 0           my ($addr) = ($self =~ m/\((.+)\)$/o);
183 0           my ($i);
184              
185 0 0         if ($context->{'addresses'}{$addr})
186             {
187 0           $fh->printf("%s<%s id_ref='%s'/>\n", $depth, $context->{'name'}, $addr);
188 0           return $self;
189             }
190             else
191 0           { $fh->printf("%s<%s id='%s'>\n", $depth, $context->{'name'}, $addr); }
192              
193 0           $self->read;
194              
195 0           for ($i = 0; $i < $numg; $i++)
196 0           { $fh->print("$depth$context->{'indent'}\n"); }
197              
198 0           $fh->print("$depth{'name'}>\n");
199 0           $self;
200             }
201              
202             1;
203              
204             =head1 BUGS
205              
206             None known
207              
208             =head1 AUTHOR
209              
210             Martin Hosken L.
211              
212              
213             =head1 LICENSING
214              
215             Copyright (c) 1998-2014, SIL International (http://www.sil.org)
216              
217             This module is released under the terms of the Artistic License 2.0.
218             For details, see the full text of the license in the file LICENSE.
219              
220              
221              
222             =cut
223              
224