File Coverage

blib/lib/Font/TTF/Head.pm
Criterion Covered Total %
statement 25 83 30.1
branch 5 36 13.8
condition 1 15 6.6
subroutine 6 11 54.5
pod 7 8 87.5
total 44 153 28.7


line stmt bran cond sub pod time code
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.
12              
13             =head1 INSTANCE VARIABLES
14              
15             The C 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 1     1   4 use strict;
  1         1  
  1         38  
43 1     1   5 use vars qw(@ISA %fields @field_info);
  1         2  
  1         69  
44              
45             require Font::TTF::Table;
46 1     1   4 use Font::TTF::Utils;
  1         1  
  1         701  
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 2     2 0 2 my ($k, $v, $c, $i);
71 2         7 for ($i = 0; $i < $#field_info; $i += 2)
72             {
73 34         74 ($k, $v, $c) = TTF_Init_Fields($field_info[$i], $c, $field_info[$i + 1]);
74 34 50 33     109 next unless defined $k && $k ne "";
75 34         88 $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 4     4 1 19 my ($self) = @_;
89 4         6 my ($dat);
90              
91 4 100       24 $self->SUPER::read || return $self;
92              
93 2 50       10 init unless defined $fields{'Ascender'};
94 2         12 $self->{' INFILE'}->read($dat, 54);
95              
96 2         41 TTF_Read_Fields($self, $dat, \%fields);
97 2         6 $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 2     2 1 6 my ($self, $fh) = @_;
112              
113 2 50       10 return $self->SUPER::out($fh) unless $self->{' read'}; # this is never true
114             # $self->{'checkSumAdjustment'} = 0 unless $self->{' PARENT'}{' wantsig'};
115 2         14 $fh->print(TTF_Out_Fields($self, \%fields, 54));
116 2         19 $self;
117             }
118              
119              
120             =head2 $t->minsize()
121              
122             Returns the minimum size this table can be. If it is smaller than this, then the table
123             must be bad and should be deleted or whatever.
124              
125             =cut
126              
127             sub minsize
128             {
129 0     0 1   return 54;
130             }
131              
132              
133             =head2 $t->XML_element($context, $depth, $key, $value)
134              
135             Handles date process for the XML exporter
136              
137             =cut
138              
139             sub XML_element
140             {
141 0     0 1   my ($self) = shift;
142 0           my ($context, $depth, $key, $value) = @_;
143 0           my ($fh) = $context->{'fh'};
144 0           my ($output, @time);
145 0           my (@month) = qw(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC);
146              
147 0 0 0       return $self->SUPER::XML_element(@_) unless ($key eq 'created' || $key eq 'modified');
148              
149 0           @time = gmtime($self->getdate($key eq 'created'));
150 0           $output = sprintf("%d/%s/%d %d:%d:%d", $time[3], $month[$time[4]], $time[5] + 1900,
151             $time[2], $time[1], $time[0]);
152 0           $fh->print("$depth<$key>$output\n");
153 0           $self;
154             }
155            
156              
157             =head2 $t->update
158              
159             Updates the head table based on the glyph data and the hmtx table
160              
161             =cut
162              
163             sub update
164             {
165 0     0 1   my ($self) = @_;
166 0           my ($num, $i, $loc, $hmtx);
167 0           my ($xMin, $yMin, $xMax, $yMax, $lsbx);
168              
169 0 0         return undef unless ($self->SUPER::update);
170              
171 0           $num = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
172 0 0 0       return undef unless (defined $self->{' PARENT'}{'hmtx'} && defined $self->{' PARENT'}{'loca'});
173 0           $hmtx = $self->{' PARENT'}{'hmtx'}->read;
174            
175 0           $self->{' PARENT'}{'loca'}->update;
176 0           $hmtx->update; # if we updated, then the flags will be set anyway.
177 0           $lsbx = 1;
178 0           for ($i = 0; $i < $num; $i++)
179             {
180 0           $loc = $self->{' PARENT'}{'loca'}{'glyphs'}[$i];
181 0 0         next unless defined $loc;
182 0           $loc->read->update_bbox;
183 0 0 0       $xMin = $loc->{'xMin'} if ($loc->{'xMin'} < $xMin || $i == 0);
184 0 0 0       $yMin = $loc->{'yMin'} if ($loc->{'yMin'} < $yMin || $i == 0);
185 0 0         $xMax = $loc->{'xMax'} if ($loc->{'xMax'} > $xMax);
186 0 0         $yMax = $loc->{'yMax'} if ($loc->{'yMax'} > $yMax);
187 0           $lsbx &= ($loc->{'xMin'} == $hmtx->{'lsb'}[$i]);
188             }
189 0           $self->{'xMin'} = $xMin;
190 0           $self->{'yMin'} = $yMin;
191 0           $self->{'xMax'} = $xMax;
192 0           $self->{'yMax'} = $yMax;
193 0 0         if ($lsbx)
194 0           { $self->{'flags'} |= 2; }
195             else
196 0           { $self->{'flags'} &= ~2; }
197 0           $self;
198             }
199              
200              
201             =head2 $t->getdate($is_create)
202              
203             Converts font modification time (or creation time if $is_create is set) to a 32-bit integer as returned
204             from time(). Returns undef if the value is out of range, either before the epoch or after the maximum
205             storable time.
206              
207             =cut
208              
209             sub getdate
210             {
211 0     0 1   my ($self, $is_create) = @_;
212 0 0         my (@arr) = (@{$self->{$is_create ? 'created' : 'modified'}});
  0            
213              
214 0           $arr[1] -= 2082844800; # seconds between 1/Jan/1904 and 1/Jan/1970 (midnight)
215 0 0         if ($arr[1] < 0)
216             {
217 0           $arr[1] += 0xFFFFFFF; $arr[1]++;
  0            
218 0           $arr[0]--;
219             }
220 0 0         return undef if $arr[0] != 0;
221 0           return $arr[1];
222             }
223              
224              
225             =head2 $t->setdate($time, $is_create)
226              
227             Sets the time information for modification (or creation time if $is_create is set) according to the 32-bit
228             time information.
229              
230             =cut
231              
232             sub setdate
233             {
234 0     0 1   my ($self, $time, $is_create) = @_;
235 0           my (@arr);
236              
237 0           $arr[1] = $time;
238 0 0         if ($arr[1] >= 0x83DA4F80)
239             {
240 0           $arr[1] -= 0xFFFFFFFF;
241 0           $arr[1]--;
242 0           $arr[0]++;
243             }
244 0           $arr[1] += 2082844800;
245 0 0         $self->{$is_create ? 'created' : 'modified'} = \@arr;
246 0           $self;
247             }
248            
249              
250             1;
251              
252              
253             =head1 BUGS
254              
255             None known
256              
257             =head1 AUTHOR
258              
259             Martin Hosken L.
260              
261              
262             =head1 LICENSING
263              
264             Copyright (c) 1998-2014, SIL International (http://www.sil.org)
265              
266             This module is released under the terms of the Artistic License 2.0.
267             For details, see the full text of the license in the file LICENSE.
268              
269              
270              
271             =cut
272              
273