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