also dont add tuples to lists sleepy man.
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Maxp.pm
1 package Font::TTF::Maxp;
2
3 =head1 NAME
4
5 Font::TTF::Maxp - Maximum Profile table in a font
6
7 =head1 DESCRIPTION
8
9 A collection of useful instance variables following the TTF standard. Probably
10 the most used being C<numGlyphs>. Note that this particular value is
11 foundational and should be kept up to date by the application, it is not updated
12 by C<update>.
13
14 Handles table versions 0.5, 1.0
15
16 =head1 INSTANCE VARIABLES
17
18 No others beyond those specified in the standard:
19
20     numGlyphs
21     maxPoints
22     maxContours
23     maxCompositePoints
24     maxCompositeContours
25     maxZones
26     maxTwilightPoints
27     maxStorage
28     maxFunctionDefs
29     maxInstructionDefs
30     maxStackElements
31     maxSizeOfInstructions
32     maxComponentElements
33     maxComponentDepth
34
35
36 =head1 METHODS
37
38 =cut
39
40 use strict;
41 use vars qw(@ISA %fields @field_info);
42 use Font::TTF::Utils;
43
44 @ISA = qw(Font::TTF::Table);
45 @field_info = (
46     'numGlyphs' => 'S',
47     'maxPoints' => 'S',
48     'maxContours' => 'S',
49     'maxCompositePoints' => 'S',
50     'maxCompositeContours' => 'S',
51     'maxZones' => 'S',
52     'maxTwilightPoints' => 'S',
53     'maxStorage' => 'S',
54     'maxFunctionDefs' => 'S',
55     'maxInstructionDefs' => 'S',
56     'maxStackElements' => 'S',
57     'maxSizeOfInstructions' => 'S',
58     'maxComponentElements' => 'S',
59     'maxComponentDepth' => 'S');
60
61 sub init
62 {
63     my ($k, $v, $c, $i);
64     for ($i = 0; $i < $#field_info; $i += 2)
65     {
66         ($k, $v, $c) = TTF_Init_Fields($field_info[$i], $c, $field_info[$i + 1]);
67         next unless defined $k && $k ne "";
68         $fields{$k} = $v;
69     }
70 }
71
72
73 =head2 $t->read
74
75 Reads the table into memory
76
77 =cut
78
79 sub read
80 {
81     my ($self) = @_;
82     my ($dat);
83
84     $self->SUPER::read or return $self;
85
86     init unless defined $fields{'numGlyphs'};    # any key would do
87     $self->{' INFILE'}->read($dat, 4);
88     $self->{'version'} = TTF_Unpack("v", $dat);
89
90     if ($self->{'version'} == 0.5)
91     {
92         $self->{' INFILE'}->read($dat, 2);
93         $self->{'numGlyphs'} = unpack("n", $dat);
94     } else
95     {
96         $self->{' INFILE'}->read($dat, 28);
97         TTF_Read_Fields($self, $dat, \%fields);
98     }
99     $self;
100 }
101
102
103 =head2 $t->out($fh)
104
105 Writes the table to a file either from memory or by copying.
106
107 =cut
108
109 sub out
110 {
111     my ($self, $fh) = @_;
112
113     return $self->SUPER::out($fh) unless $self->{' read'};
114     $fh->print(TTF_Pack("v", $self->{'version'}));
115     
116     if ($self->{'version'} == 0.5)
117     { $fh->print(pack("n", $self->{'numGlyphs'})); }
118     else
119     { $fh->print(TTF_Out_Fields($self, \%fields, 28)); }
120     $self;
121 }
122
123
124 =head2 $t->update
125
126 Calculates all the maximum values for a font based on the glyphs in the font.
127 Only those fields which require hinting code interpretation are ignored and
128 left as they were read.
129
130 =cut
131
132 sub update
133 {
134     my ($self) = @_;
135     my ($i, $num, @n, @m, $j);
136     my (@name) = qw(maxPoints maxContours maxCompositePoints maxCompositeContours
137                     maxSizeOfInstructions maxComponentElements maxComponentDepth);
138
139     return undef unless ($self->SUPER::update);
140     return undef if ($self->{'version'} == 0.5);        # only got numGlyphs
141     return undef unless (defined $self->{' PARENT'}{'loca'});
142     $self->{' PARENT'}{'loca'}->update;
143     $num = $self->{'numGlyphs'};
144
145     for ($i = 0; $i < $num; $i++)
146     {
147         my ($g) = $self->{' PARENT'}{'loca'}{'glyphs'}[$i] || next;
148
149         @n = $g->maxInfo;
150
151         for ($j = 0; $j <= $#n; $j++)
152         { $m[$j] = $n[$j] if $n[$j] > $m[$j]; }
153     }
154
155     foreach ('prep', 'fpgm')
156     { $m[4] = length($self->{' PARENT'}{$_}{' dat'})
157             if (defined $self->{' PARENT'}{$_} 
158                 && length($self->{' PARENT'}{$_}{' dat'}) > $m[4]);
159     }
160
161     for ($j = 0; $j <= $#name; $j++)
162     { $self->{$name[$j]} = $m[$j]; }
163     $self;
164 }
165 1;
166
167
168 =head1 BUGS
169
170 None known
171
172 =head1 AUTHOR
173
174 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
175 licensing.
176
177 =cut