also dont add tuples to lists sleepy man.
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Hmtx.pm
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 use strict;
36 use vars qw(@ISA);
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     my ($self) = @_;
51     my ($numh, $numg);
52
53     $numh = $self->{' PARENT'}{'hhea'}->read->{'numberOfHMetrics'};
54     $numg = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
55     $self->_read($numg, $numh, "advance", "lsb");
56 }
57
58 sub _read
59 {
60     my ($self, $numg, $numh, $tAdv, $tLsb) = @_;
61     my ($fh) = $self->{' INFILE'};
62     my ($i, $dat);
63     
64     $self->SUPER::read or return $self;
65
66     for ($i = 0; $i < $numh; $i++)
67     {
68         $fh->read($dat, 4);
69         ($self->{$tAdv}[$i], $self->{$tLsb}[$i]) = unpack("nn", $dat);
70         $self->{$tLsb}[$i] -= 65536 if ($self->{$tLsb}[$i] >= 32768);
71     }
72     
73     $i--;
74     while (++$i < $numg)
75     {
76         $fh->read($dat, 2);
77         $self->{$tAdv}[$i] = $self->{$tAdv}[$numh - 1];
78         $self->{$tLsb}[$i] = unpack("n", $dat);
79         $self->{$tLsb}[$i] -= 65536 if ($self->{$tLsb}[$i] >= 32768);
80     }
81     $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     my ($self) = @_;
94     my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
95     my ($i);
96
97     return undef unless $self->{' read'};
98
99     for ($i = $numg - 2; $i >= 0; $i--)
100     { last if ($self->{'advance'}[$i] != $self->{'advance'}[$i + 1]); }
101
102     return $i + 2;
103 }
104
105
106 =head2 $t->out($fh)
107
108 Writes the metrics to a TTF file. Assumes that the C<hhea> has updated the
109 numHMetrics from here
110
111 =cut
112
113 sub out
114 {
115     my ($self, $fh) = @_;
116     my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
117     my ($numh) = $self->{' PARENT'}{'hhea'}->read->{'numberOfHMetrics'};
118     $self->_out($fh, $numg, $numh, "advance", "lsb");
119 }
120
121 sub _out
122 {
123     my ($self, $fh, $numg, $numh, $tAdv, $tLsb) = @_;
124     my ($i, $lsb);
125
126     return $self->SUPER::out($fh) unless ($self->{' read'});
127
128     for ($i = 0; $i < $numg; $i++)
129     {
130         $lsb = $self->{$tLsb}[$i];
131         $lsb += 65536 if $lsb < 0;
132         if ($i >= $numh)
133         { $fh->print(pack("n", $lsb)); }
134         else
135         { $fh->print(pack("n2", $self->{$tAdv}[$i], $lsb)); }
136     }
137     $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     my ($self) = @_;
150     my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
151     my ($i);
152
153     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     $self->{' PARENT'}{'loca'}->update;
158     for ($i = 0; $i < $numg; $i++)
159     {
160         my ($g) = $self->{' PARENT'}{'loca'}{'glyphs'}[$i];
161         if ($g)
162         { $self->{'lsb'}[$i] = $g->read->update_bbox->{'xMin'}; }
163         else
164         { $self->{'lsb'}[$i] = 0; }
165     }
166     $self->{' PARENT'}{'head'}{'flags'} |= 2;
167     $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     my ($self, $context, $depth) = @_;
180     my ($fh) = $context->{'fh'};
181     my ($numg) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
182     my ($addr) = ($self =~ m/\((.+)\)$/o);
183     my ($i);
184
185     if ($context->{'addresses'}{$addr})
186     {
187         $fh->printf("%s<%s id_ref='%s'/>\n", $depth, $context->{'name'}, $addr);
188         return $self;
189     }
190     else
191     { $fh->printf("%s<%s id='%s'>\n", $depth, $context->{'name'}, $addr); }
192
193     $self->read;
194
195     for ($i = 0; $i < $numg; $i++)
196     { $fh->print("$depth$context->{'indent'}<width adv='$self->{'advance'}[$i]' lsb='$self->{'lsb'}[$i]'/>\n"); }
197
198     $fh->print("$depth</$context->{'name'}>\n");
199     $self;
200 }
201
202 1;
203
204 =head1 BUGS
205
206 None known
207
208 =head1 AUTHOR
209
210 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
211 licensing.
212
213 =cut
214