--- /dev/null
+package Font::TTF::Kern;
+
+=head1 NAME
+
+Font::TTF::Kern - Kerning tables
+
+=head1 DESCRIPTION
+
+Kerning tables are held as an ordered collection of subtables each giving
+incremental information regarding the kerning of various pairs of glyphs.
+
+The basic structure of the kerning data structure is:
+
+ $kern = $f->{'kern'}{'tables'}[$tnum]{'kerns'}{$leftnum}{$rightnum};
+
+Due to the possible complexity of some kerning tables the above information
+is insufficient. Reference also needs to be made to the type of the table and
+the coverage field.
+
+=head1 INSTANCE VARIABLES
+
+The instance variables for a kerning table are relatively straightforward.
+
+=over 4
+
+=item Version
+
+Version number of the kerning table
+
+=item Num
+
+Number of subtables in the kerning table
+
+=item tables
+
+Array of subtables in the kerning table
+
+=over 4
+
+Each subtable has a number of instance variables.
+
+=item kern
+
+A two level hash array containing kerning values. The indexing is left
+value and then right value. In the case of type 2 tables, the indexing
+is via left class and right class. It may seem using hashes is strange,
+but most tables are not type 2 and this method saves empty array values.
+
+=item type
+
+Stores the table type. Only type 0 and type 2 tables are specified for
+TrueType so far.
+
+=item coverage
+
+A bit field of coverage information regarding the kerning value. See the
+TrueType specification for details.
+
+=item Version
+
+Contains the version number of the table.
+
+=item Num
+
+Number of kerning pairs in this type 0 table.
+
+=item left
+
+An array indexed by glyph - left_first which returns a class number for
+the glyph in type 2 tables.
+
+=item right
+
+An array indexed by glyph - right_first which returns a class number for
+the glyph in type 2 tables.
+
+=item left_first
+
+the glyph number of the first element in the left array for type 2 tables.
+
+=item right_first
+
+the glyph number of the first element in the right array for type 2 tables.
+
+=item num_left
+
+Number of left classes
+
+=item num_right
+
+Number of right classes
+
+=back
+
+=back
+
+=head1 METHODS
+
+=cut
+
+use strict;
+use vars qw(@ISA);
+use Font::TTF::Utils;
+use Font::TTF::Table;
+
+@ISA = qw(Font::TTF::Table);
+
+=head2 $t->read
+
+Reads the whole kerning table into structures
+
+=cut
+
+sub read
+{
+ my ($self) = @_;
+ my ($fh) = $self->{' INFILE'};
+ my ($dat, $i, $numt, $len, $cov, $t);
+
+ $self->SUPER::read or return $self;
+
+ $fh->read($dat, 4);
+ ($self->{'Version'}, $numt) = unpack("n2", $dat);
+ $self->{'Num'} = $numt;
+
+ for ($i = 0; $i < $numt; $i++)
+ {
+ $t = {};
+ $fh->read($dat, 6);
+ ($t->{'Version'}, $len, $cov) = unpack("n3", $dat);
+ $t->{'coverage'} = $cov & 255;
+ $t->{'type'} = $cov >> 8;
+ $fh->read($dat, $len - 6);
+ if ($t->{'Version'} == 0)
+ {
+ $t->{'Num'} = unpack("n", $dat);
+ my (@vals) = unpack("n*", substr($dat, 8, $t->{'Num'} * 6));
+ for (0 .. ($t->{'Num'} - 1))
+ {
+ my ($f, $l, $v);
+ $f = shift @vals;
+ $l = shift @vals;
+ $v = shift @vals;
+ $v -= 65536 if ($v > 32767);
+ $t->{'kern'}{$f}{$l} = $v;
+ }
+ } elsif ($t->{'Version'} == 2)
+ {
+ my ($wid, $off, $numg, $maxl, $maxr, $j);
+
+ $wid = unpack("n", $dat);
+ $off = unpack("n", substr($dat, 2));
+ ($t->{'left_first'}, $numg) = unpack("n2", substr($dat, $off));
+ $t->{'left'} = [unpack("C$numg", substr($dat, $off + 4))];
+ foreach (@{$t->{'left'}})
+ {
+ $_ /= $wid;
+ $maxl = $_ if ($_ > $maxl);
+ }
+ $t->{'left_max'} = $maxl;
+
+ $off = unpack("n", substr($dat, 4));
+ ($t->{'right_first'}, $numg) = unpack("n2", substr($dat, $off));
+ $t->{'right'} = [unpack("C$numg", substr($dat, $off + 4))];
+ foreach (@{$t->{'right'}})
+ {
+ $_ >>= 1;
+ $maxr = $_ if ($_ > $maxr);
+ }
+ $t->{'right_max'} = $maxr;
+
+ $off = unpack("n", substr($dat, 6));
+ for ($j = 0; $j <= $maxl; $j++)
+ {
+ my ($k) = 0;
+
+ map { $t->{'kern'}{$j}{$k} = $_ if $_; $k++; }
+ unpack("n$maxr", substr($dat, $off + $wid * $j));
+ }
+ }
+ push (@{$self->{'tables'}}, $t);
+ }
+ $self;
+}
+
+
+=head2 $t->out($fh)
+
+Outputs the kerning tables to the given file
+
+=cut
+
+sub out
+{
+ my ($self, $fh) = @_;
+ my ($i, $l, $r, $loc, $loc1, $t);
+
+ return $self->SUPER::out($fh) unless ($self->{' read'});
+
+ $fh->print(pack("n2", $self->{'Version'}, $self->{'Num'}));
+ for ($i = 0; $i < $self->{'Num'}; $i++)
+ {
+ $t = $self->{'tables'}[$i];
+ $loc = $fh->tell();
+
+ $fh->print(pack("nnn", $t->{'Version'}, 0, $t->{'coverage'}));
+ if ($t->{'Version'} == 0)
+ {
+ my ($dat);
+ foreach $l (sort {$a <=> $b} keys %{$t->{'kern'}})
+ {
+ foreach $r (sort {$a <=> $b} keys %{$t->{'kern'}{$l}})
+ { $dat .= TTF_Pack("SSs", $l, $r, $t->{'kern'}{$l}{$r}); }
+ }
+ $fh->print(TTF_Pack("SSSS", Font::TTF::Utils::TTF_bininfo(length($dat) / 6, 6)));
+ $fh->print($dat);
+ } elsif ($t->{'Version'} == 2)
+ {
+ my ($arr);
+
+ $fh->print(pack("nnnn", $t->{'right_max'} << 1, 8, ($#{$t->{'left'}} + 7) << 1,
+ ($#{$t->{'left'}} + $#{$t->{'right'}} + 10) << 1));
+
+ $fh->print(pack("nn", $t->{'left_first'}, $#{$t->{'left'}} + 1));
+ foreach (@{$t->{'left'}})
+ { $fh->print(pack("C", $_ * (($t->{'left_max'} + 1) << 1))); }
+
+ $fh->print(pack("nn", $t->{'right_first'}, $#{$t->{'right'}} + 1));
+ foreach (@{$t->{'right'}})
+ { $fh->print(pack("C", $_ << 1)); }
+
+ $arr = "\000\000" x (($t->{'left_max'} + 1) * ($t->{'right_max'} + 1));
+ foreach $l (keys %{$t->{'kern'}})
+ {
+ foreach $r (keys %{$t->{'kern'}{$l}})
+ { substr($arr, ($l * ($t->{'left_max'} + 1) + $r) << 1, 2)
+ = pack("n", $t->{'kern'}{$l}{$r}); }
+ }
+ $fh->print($arr);
+ }
+ $loc1 = $fh->tell();
+ $fh->seek($loc + 2, 0);
+ $fh->print(pack("n", $loc1 - $loc));
+ $fh->seek($loc1, 0);
+ }
+ $self;
+}
+
+
+=head2 $t->XML_element($context, $depth, $key, $value)
+
+Handles outputting the kern hash into XML a little more tidily
+
+=cut
+
+sub XML_element
+{
+ my ($self) = shift;
+ my ($context, $depth, $key, $value) = @_;
+ my ($fh) = $context->{'fh'};
+ my ($f, $l);
+
+ return $self->SUPER::XML_element(@_) unless ($key eq 'kern');
+ $fh->print("$depth<kern-table>\n");
+ foreach $f (sort {$a <=> $b} keys %{$value})
+ {
+ foreach $l (sort {$a <=> $b} keys %{$value->{$f}})
+ { $fh->print("$depth$context->{'indent'}<adjust first='$f' last='$l' dist='$value->{$f}{$l}'/>\n"); }
+ }
+ $fh->print("$depth</kern-table>\n");
+ $self;
+}
+
+1;
+
+=head1 BUGS
+
+=over 4
+
+=item *
+
+Only supports kerning table types 0 & 2.
+
+=item *
+
+No real support functions to I<do> anything with the kerning tables yet.
+
+=back
+
+=head1 AUTHOR
+
+Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
+licensing.
+
+=cut
+
fnp / librarian.git / blobdiff