Workaround was bad.
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Loca.pm
1 package Font::TTF::Loca;
2
3 =head1 NAME
4
5 Font::TTF::Loca - the Locations table, which is intimately tied to the glyf table
6
7 =head1 DESCRIPTION
8
9 The location table holds the directory of locations of each glyph within the
10 glyf table. Due to this relationship and the unimportance of the actual locations
11 when it comes to holding glyphs in memory, reading the location table results
12 in the creation of glyph objects for each glyph and stores them here.
13 So if you are looking for glyphs, don't look in the C<glyf> table, look here
14 instead.
15
16 Things get complicated if you try to change the glyph list within the one table.
17 The recommendation is to create another clean location object to replace this
18 table in the font, ensuring that the old table is read first and to transfer
19 or copy glyphs across from the read table to the new table.
20
21 =head1 INSTANCE VARIABLES
22
23 The instance variables do not start with a space
24
25 =over 4
26
27 =item glyphs
28
29 An array of glyph objects for each glyph.
30
31 =item glyphtype
32
33 A string containing the class name to create for each new glyph. If empty,
34 defaults to L<Font::TTF::Glyph>.
35
36 =back
37
38 =head1 METHODS
39
40 =cut
41
42 use strict;
43 use vars qw(@ISA);
44 @ISA = qw(Font::TTF::Table);
45
46 require Font::TTF::Glyph;
47
48
49 =head2 $t->new
50
51 Creates a new location table making sure it has a glyphs array
52
53 =cut
54
55 sub new
56 {
57     my ($class) = shift;
58     my ($res) = $class->SUPER::new(@_);
59     $res->{'glyphs'} = [];
60     $res;
61 }
62
63 =head2 $t->read
64
65 Reads the location table creating glyph objects (L<Font::TTF::Glyph>) for each glyph
66 allowing their later reading.
67
68 =cut
69
70 sub read
71 {
72     my ($self) = @_;
73     my ($fh) = $self->{' INFILE'};
74     my ($locFmt) = $self->{' PARENT'}{'head'}{'indexToLocFormat'};
75     my ($numGlyphs) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
76     my ($glyfLoc) = $self->{' PARENT'}{'glyf'}{' OFFSET'};
77     my ($dat, $last, $i, $loc);
78
79     $self->SUPER::read or return $self;
80     $fh->read($dat, $locFmt ? 4 : 2);
81     $last = unpack($locFmt ? "N" : "n", $dat);
82     for ($i = 0; $i < $numGlyphs; $i++)
83     {
84         $fh->read($dat, $locFmt ? 4 : 2);
85         $loc = unpack($locFmt ? "N" : "n", $dat);
86         $self->{'glyphs'}[$i] = ($self->{'glyphtype'} || "Font::TTF::Glyph")->new(
87                 LOC => $last << ($locFmt ? 0 : 1),
88                 OUTLOC => $last << ($locFmt ? 0 : 1),
89                 PARENT => $self->{' PARENT'},
90                 INFILE => $fh,
91                 BASE => $glyfLoc,
92                 OUTLEN => ($loc - $last) << ($locFmt ? 0 : 1),
93                 LEN => ($loc - $last) << ($locFmt ? 0 : 1)) if ($loc != $last);
94         $last = $loc;
95     }
96     $self;
97 }
98
99
100 =head2 $t->out($fh)
101
102 Writes the location table out to $fh. Notice that not having read the location
103 table implies that the glyf table has not been read either, so the numbers in
104 the location table are still valid. Let's hope that C<maxp/numGlyphs> and
105 C<head/indexToLocFmt> haven't changed otherwise we are in big trouble.
106
107 The function uses the OUTLOC location in the glyph calculated when the glyf
108 table was attempted to be output.
109
110 =cut
111
112 sub out
113 {
114     my ($self, $fh) = @_;
115     my ($locFmt) = $self->{' PARENT'}{'head'}{'indexToLocFormat'};
116     my ($numGlyphs) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
117     my ($count, $i, $offset, $g);
118
119     return $self->SUPER::out($fh) unless ($self->{' read'});
120
121     $count = 0;
122     for ($i = 0; $i < $numGlyphs; $i++)
123     {
124         $g = ($self->{'glyphs'}[$i]) || "";
125         unless ($g)
126         {
127             $count++;
128             next;
129         } else
130         {
131             if ($locFmt)
132             { $fh->print(pack("N", $g->{' OUTLOC'}) x ($count + 1)); }
133             else
134             { $fh->print(pack("n", $g->{' OUTLOC'} >> 1) x ($count + 1)); }
135             $count = 0;
136             $offset = $g->{' OUTLOC'} + $g->{' OUTLEN'};
137         }
138     }
139     $fh->print(pack($locFmt ? "N" : "n", ($locFmt ? $offset: $offset >> 1)) x ($count + 1));
140 }
141
142
143 =head2 $t->out_xml($context, $depth)
144
145 No need to output a loca table, this is dynamically generated
146
147 =cut
148
149 sub out_xml
150 { return $_[0]; }
151
152
153 =head2 $t->glyphs_do(&func)
154
155 Calls func for each glyph in this location table in numerical order:
156
157     &func($glyph, $glyph_num)
158
159 =cut
160
161 sub glyphs_do
162 {
163     my ($self, $func) = @_;
164     my ($i);
165
166     for ($i = 0; $i <= $#{$self->{'glyphs'}}; $i++)
167     { &$func($self->{'glyphs'}[$i], $i) if defined $self->{'glyphs'}[$i]; }
168     $self;
169 }
170
171 1;
172
173 =head1 BUGS
174
175 None known
176
177 =head1 AUTHOR
178
179 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
180 licensing.
181
182 =cut
183