362e8e44d6b3ce7907de356d871e628bfb19754f
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Head.pm
1 package Font::TTF::Head;
2
3 =head1 NAME
4
5 Font::TTF::Head - The head table for a TTF Font
6
7 =head1 DESCRIPTION
8
9 This is a very basic table with just instance variables as described in the
10 TTF documentation, using the same names. One of the most commonly used is
11 C<unitsPerEm>.
12
13 =head1 INSTANCE VARIABLES
14
15 The C<head> table has no internal instance variables beyond those common to all
16 tables and those specified in the standard:
17
18     version
19     fontRevision
20     checkSumAdjustment
21     magicNumber
22     flags
23     unitsPerEm
24     created
25     modified
26     xMin
27     yMin
28     xMax
29     yMax
30     macStyle
31     lowestRecPPEM
32     fontDirectionHint
33     indexToLocFormat
34     glyphDataFormat
35
36 The two dates are held as an array of two unsigned longs (32-bits)
37
38 =head1 METHODS
39
40 =cut
41
42 use strict;
43 use vars qw(@ISA %fields @field_info);
44
45 require Font::TTF::Table;
46 use Font::TTF::Utils;
47
48 @ISA = qw(Font::TTF::Table);
49 @field_info = (
50     'version' => 'v',
51     'fontRevision' => 'f',
52     'checkSumAdjustment' => 'L',
53     'magicNumber' => 'L',
54     'flags' => 'S',
55     'unitsPerEm' => 'S',
56     'created' => 'L2',
57     'modified' => 'L2',
58     'xMin' => 's',
59     'yMin' => 's',
60     'xMax' => 's',
61     'yMax' => 's',
62     'macStyle' => 'S',
63     'lowestRecPPEM' => 'S',
64     'fontDirectionHint' => 's',
65     'indexToLocFormat' => 's',
66     'glyphDataFormat' => 's');
67
68 sub init
69 {
70     my ($k, $v, $c, $i);
71     for ($i = 0; $i < $#field_info; $i += 2)
72     {
73         ($k, $v, $c) = TTF_Init_Fields($field_info[$i], $c, $field_info[$i + 1]);
74         next unless defined $k && $k ne "";
75         $fields{$k} = $v;
76     }
77 }
78
79
80 =head2 $t->read
81
82 Reads the table into memory thanks to some utility functions
83
84 =cut
85
86 sub read
87 {
88     my ($self) = @_;
89     my ($dat);
90
91     $self->SUPER::read || return $self;
92
93     init unless defined $fields{'Ascender'};
94     $self->{' INFILE'}->read($dat, 54);
95
96     TTF_Read_Fields($self, $dat, \%fields);
97     $self;
98 }
99
100
101 =head2 $t->out($fh)
102
103 Writes the table to a file either from memory or by copying. If in memory
104 (which is usually) the checkSumAdjustment field is set to 0 as per the default
105 if the file checksum is not to be considered.
106
107 =cut
108
109 sub out
110 {
111     my ($self, $fh) = @_;
112
113     return $self->SUPER::out($fh) unless $self->{' read'};      # this is never true
114 #    $self->{'checkSumAdjustment'} = 0 unless $self->{' PARENT'}{' wantsig'};
115     $fh->print(TTF_Out_Fields($self, \%fields, 54));
116     $self;
117 }
118
119
120 =head2 $t->XML_element($context, $depth, $key, $value)
121
122 Handles date process for the XML exporter
123
124 =cut
125
126 sub XML_element
127 {
128     my ($self) = shift;
129     my ($context, $depth, $key, $value) = @_;
130     my ($fh) = $context->{'fh'};
131     my ($output, @time);
132     my (@month) = qw(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC);
133
134     return $self->SUPER::XML_element(@_) unless ($key eq 'created' || $key eq 'modified');
135
136     @time = gmtime($self->getdate($key eq 'created'));
137     $output = sprintf("%d/%s/%d %d:%d:%d", $time[3], $month[$time[4]], $time[5] + 1900,
138             $time[2], $time[1], $time[0]);
139     $fh->print("$depth<$key>$output</$key>\n");
140     $self;
141 }
142     
143
144 =head2 $t->update
145
146 Updates the head table based on the glyph data and the hmtx table
147
148 =cut
149
150 sub update
151 {
152     my ($self) = @_;
153     my ($num, $i, $loc, $hmtx);
154     my ($xMin, $yMin, $xMax, $yMax, $lsbx);
155
156     return undef unless ($self->SUPER::update);
157
158     $num = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
159     return undef unless (defined $self->{' PARENT'}{'hmtx'} && defined $self->{' PARENT'}{'loca'});
160     $hmtx = $self->{' PARENT'}{'hmtx'}->read;
161     
162     $self->{' PARENT'}{'loca'}->update;
163     $hmtx->update;              # if we updated, then the flags will be set anyway.
164     $lsbx = 1;
165     for ($i = 0; $i < $num; $i++)
166     {
167         $loc = $self->{' PARENT'}{'loca'}{'glyphs'}[$i];
168         next unless defined $loc;
169         $loc->read->update_bbox;
170         $xMin = $loc->{'xMin'} if ($loc->{'xMin'} < $xMin || $i == 0);
171         $yMin = $loc->{'yMin'} if ($loc->{'yMin'} < $yMin || $i == 0);
172         $xMax = $loc->{'xMax'} if ($loc->{'xMax'} > $xMax);
173         $yMax = $loc->{'yMax'} if ($loc->{'yMax'} > $yMax);
174         $lsbx &= ($loc->{'xMin'} == $hmtx->{'lsb'}[$i]);
175     }
176     $self->{'xMin'} = $xMin;
177     $self->{'yMin'} = $yMin;
178     $self->{'xMax'} = $xMax;
179     $self->{'yMax'} = $yMax;
180     if ($lsbx)
181     { $self->{'flags'} |= 2; }
182     else
183     { $self->{'flags'} &= ~2; }
184     $self;
185 }
186
187
188 =head2 $t->getdate($is_create)
189
190 Converts font modification time (or creation time if $is_create is set) to a 32-bit integer as returned
191 from time(). Returns undef if the value is out of range, either before the epoch or after the maximum
192 storable time.
193
194 =cut
195
196 sub getdate
197 {
198     my ($self, $is_create) = @_;
199     my ($arr) = $self->{$is_create ? 'created' : 'modified'};
200
201     $arr->[1] -= 2082844800;        # seconds between 1/Jan/1904 and 1/Jan/1970 (midnight)
202     if ($arr->[1] < 0)
203     {
204         $arr->[1] += 0xFFFFFFF; $arr->[1]++;
205         $arr->[0]--;
206     }
207     return undef if $arr->[0] != 0;
208     return $arr->[1];
209 }
210
211
212 =head2 $t->setdate($time, $is_create)
213
214 Sets the time information for modification (or creation time if $is_create is set) according to the 32-bit
215 time information.
216
217 =cut
218
219 sub setdate
220 {
221     my ($self, $time, $is_create) = @_;
222     my (@arr);
223
224     $arr[1] = $time;
225     if ($arr[1] >= 0x83DA4F80)
226     {
227         $arr[1] -= 0xFFFFFFFF;
228         $arr[1]--;
229         $arr[0]++;
230     }
231     $arr[1] += 2082844800;
232     $self->{$is_create ? 'created' : 'modified'} = \@arr;
233     $self;
234 }
235     
236
237 1;
238
239
240 =head1 BUGS
241
242 None known
243
244 =head1 AUTHOR
245
246 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
247 licensing.
248
249 =cut
250