Introduce src dir.
[librarian.git] / src / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Loca.pm
diff --git a/src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Loca.pm b/src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Loca.pm
new file mode 100644 (file)
index 0000000..ca641bb
--- /dev/null
@@ -0,0 +1,183 @@
+package Font::TTF::Loca;
+
+=head1 NAME
+
+Font::TTF::Loca - the Locations table, which is intimately tied to the glyf table
+
+=head1 DESCRIPTION
+
+The location table holds the directory of locations of each glyph within the
+glyf table. Due to this relationship and the unimportance of the actual locations
+when it comes to holding glyphs in memory, reading the location table results
+in the creation of glyph objects for each glyph and stores them here.
+So if you are looking for glyphs, don't look in the C<glyf> table, look here
+instead.
+
+Things get complicated if you try to change the glyph list within the one table.
+The recommendation is to create another clean location object to replace this
+table in the font, ensuring that the old table is read first and to transfer
+or copy glyphs across from the read table to the new table.
+
+=head1 INSTANCE VARIABLES
+
+The instance variables do not start with a space
+
+=over 4
+
+=item glyphs
+
+An array of glyph objects for each glyph.
+
+=item glyphtype
+
+A string containing the class name to create for each new glyph. If empty,
+defaults to L<Font::TTF::Glyph>.
+
+=back
+
+=head1 METHODS
+
+=cut
+
+use strict;
+use vars qw(@ISA);
+@ISA = qw(Font::TTF::Table);
+
+require Font::TTF::Glyph;
+
+
+=head2 $t->new
+
+Creates a new location table making sure it has a glyphs array
+
+=cut
+
+sub new
+{
+    my ($class) = shift;
+    my ($res) = $class->SUPER::new(@_);
+    $res->{'glyphs'} = [];
+    $res;
+}
+
+=head2 $t->read
+
+Reads the location table creating glyph objects (L<Font::TTF::Glyph>) for each glyph
+allowing their later reading.
+
+=cut
+
+sub read
+{
+    my ($self) = @_;
+    my ($fh) = $self->{' INFILE'};
+    my ($locFmt) = $self->{' PARENT'}{'head'}{'indexToLocFormat'};
+    my ($numGlyphs) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
+    my ($glyfLoc) = $self->{' PARENT'}{'glyf'}{' OFFSET'};
+    my ($dat, $last, $i, $loc);
+
+    $self->SUPER::read or return $self;
+    $fh->read($dat, $locFmt ? 4 : 2);
+    $last = unpack($locFmt ? "N" : "n", $dat);
+    for ($i = 0; $i < $numGlyphs; $i++)
+    {
+        $fh->read($dat, $locFmt ? 4 : 2);
+        $loc = unpack($locFmt ? "N" : "n", $dat);
+        $self->{'glyphs'}[$i] = ($self->{'glyphtype'} || "Font::TTF::Glyph")->new(
+                LOC => $last << ($locFmt ? 0 : 1),
+                OUTLOC => $last << ($locFmt ? 0 : 1),
+                PARENT => $self->{' PARENT'},
+                INFILE => $fh,
+                BASE => $glyfLoc,
+                OUTLEN => ($loc - $last) << ($locFmt ? 0 : 1),
+                LEN => ($loc - $last) << ($locFmt ? 0 : 1)) if ($loc != $last);
+        $last = $loc;
+    }
+    $self;
+}
+
+
+=head2 $t->out($fh)
+
+Writes the location table out to $fh. Notice that not having read the location
+table implies that the glyf table has not been read either, so the numbers in
+the location table are still valid. Let's hope that C<maxp/numGlyphs> and
+C<head/indexToLocFmt> haven't changed otherwise we are in big trouble.
+
+The function uses the OUTLOC location in the glyph calculated when the glyf
+table was attempted to be output.
+
+=cut
+
+sub out
+{
+    my ($self, $fh) = @_;
+    my ($locFmt) = $self->{' PARENT'}{'head'}{'indexToLocFormat'};
+    my ($numGlyphs) = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
+    my ($count, $i, $offset, $g);
+
+    return $self->SUPER::out($fh) unless ($self->{' read'});
+
+    $count = 0;
+    for ($i = 0; $i < $numGlyphs; $i++)
+    {
+        $g = ($self->{'glyphs'}[$i]) || "";
+        unless ($g)
+        {
+            $count++;
+            next;
+        } else
+        {
+            if ($locFmt)
+            { $fh->print(pack("N", $g->{' OUTLOC'}) x ($count + 1)); }
+            else
+            { $fh->print(pack("n", $g->{' OUTLOC'} >> 1) x ($count + 1)); }
+            $count = 0;
+            $offset = $g->{' OUTLOC'} + $g->{' OUTLEN'};
+        }
+    }
+    $fh->print(pack($locFmt ? "N" : "n", ($locFmt ? $offset: $offset >> 1)) x ($count + 1));
+}
+
+
+=head2 $t->out_xml($context, $depth)
+
+No need to output a loca table, this is dynamically generated
+
+=cut
+
+sub out_xml
+{ return $_[0]; }
+
+
+=head2 $t->glyphs_do(&func)
+
+Calls func for each glyph in this location table in numerical order:
+
+    &func($glyph, $glyph_num)
+
+=cut
+
+sub glyphs_do
+{
+    my ($self, $func) = @_;
+    my ($i);
+
+    for ($i = 0; $i <= $#{$self->{'glyphs'}}; $i++)
+    { &$func($self->{'glyphs'}[$i], $i) if defined $self->{'glyphs'}[$i]; }
+    $self;
+}
+
+1;
+
+=head1 BUGS
+
+None known
+
+=head1 AUTHOR
+
+Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
+licensing.
+
+=cut
+