src/librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Kern.pm

   1 package Font::TTF::Kern;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Kern - Kerning tables
   6
   7 =head1 DESCRIPTION
   8
   9 Kerning tables are held as an ordered collection of subtables each giving
  10 incremental information regarding the kerning of various pairs of glyphs.
  11
  12 The basic structure of the kerning data structure is:
  13
  14     $kern = $f->{'kern'}{'tables'}[$tnum]{'kerns'}{$leftnum}{$rightnum};
  15
  16 Due to the possible complexity of some kerning tables the above information
  17 is insufficient. Reference also needs to be made to the type of the table and
  18 the coverage field.
  19
  20 =head1 INSTANCE VARIABLES
  21
  22 The instance variables for a kerning table are relatively straightforward.
  23
  24 =over 4
  25
  26 =item Version
  27
  28 Version number of the kerning table
  29
  30 =item Num
  31
  32 Number of subtables in the kerning table
  33
  34 =item tables
  35
  36 Array of subtables in the kerning table
  37
  38 =over 4
  39
  40 Each subtable has a number of instance variables.
  41
  42 =item kern
  43
  44 A two level hash array containing kerning values. The indexing is left
  45 value and then right value. In the case of type 2 tables, the indexing
  46 is via left class and right class. It may seem using hashes is strange,
  47 but most tables are not type 2 and this method saves empty array values.
  48
  49 =item type
  50
  51 Stores the table type. Only type 0 and type 2 tables are specified for
  52 TrueType so far.
  53
  54 =item coverage
  55
  56 A bit field of coverage information regarding the kerning value. See the
  57 TrueType specification for details.
  58
  59 =item Version
  60
  61 Contains the version number of the table.
  62
  63 =item Num
  64
  65 Number of kerning pairs in this type 0 table.
  66
  67 =item left
  68
  69 An array indexed by glyph - left_first which returns a class number for
  70 the glyph in type 2 tables.
  71
  72 =item right
  73
  74 An array indexed by glyph - right_first which returns a class number for
  75 the glyph in type 2 tables.
  76
  77 =item left_first
  78
  79 the glyph number of the first element in the left array for type 2 tables.
  80
  81 =item right_first
  82
  83 the glyph number of the first element in the right array for type 2 tables.
  84
  85 =item num_left
  86
  87 Number of left classes
  88
  89 =item num_right
  90
  91 Number of right classes
  92
  93 =back
  94
  95 =back
  96
  97 =head1 METHODS
  98
  99 =cut
 100
 101 use strict;
 102 use vars qw(@ISA);
 103 use Font::TTF::Utils;
 104 use Font::TTF::Table;
 105
 106 @ISA = qw(Font::TTF::Table);
 107
 108 =head2 $t->read
 109
 110 Reads the whole kerning table into structures
 111
 112 =cut
 113
 114 sub read
 115 {
 116     my ($self) = @_;
 117     my ($fh) = $self->{' INFILE'};
 118     my ($dat, $i, $numt, $len, $cov, $t);
 119
 120     $self->SUPER::read or return $self;
 121
 122     $fh->read($dat, 4);
 123     ($self->{'Version'}, $numt) = unpack("n2", $dat);
 124     $self->{'Num'} = $numt;
 125
 126     for ($i = 0; $i < $numt; $i++)
 127     {
 128         $t = {};
 129         $fh->read($dat, 6);
 130         ($t->{'Version'}, $len, $cov) = unpack("n3", $dat);
 131         $t->{'coverage'} = $cov & 255;
 132         $t->{'type'} = $cov >> 8;
 133         $fh->read($dat, $len - 6);
 134         if ($t->{'Version'} == 0)
 135         {
 136             $t->{'Num'} = unpack("n", $dat);
 137             my (@vals) = unpack("n*", substr($dat, 8, $t->{'Num'} * 6));
 138             for (0 .. ($t->{'Num'} - 1))
 139             {
 140                 my ($f, $l, $v);
 141                 $f = shift @vals;
 142                 $l = shift @vals;
 143                 $v = shift @vals;
 144                 $v -= 65536 if ($v > 32767);
 145                 $t->{'kern'}{$f}{$l} = $v;
 146             }
 147         } elsif ($t->{'Version'} == 2)
 148         {
 149             my ($wid, $off, $numg, $maxl, $maxr, $j);
 150
 151             $wid = unpack("n", $dat);
 152             $off = unpack("n", substr($dat, 2));
 153             ($t->{'left_first'}, $numg) = unpack("n2", substr($dat, $off));
 154             $t->{'left'} = [unpack("C$numg", substr($dat, $off + 4))];
 155             foreach (@{$t->{'left'}})
 156             {
 157                 $_ /= $wid;
 158                 $maxl = $_ if ($_ > $maxl);
 159             }
 160             $t->{'left_max'} = $maxl;
 161
 162             $off = unpack("n", substr($dat, 4));
 163             ($t->{'right_first'}, $numg) = unpack("n2", substr($dat, $off));
 164             $t->{'right'} = [unpack("C$numg", substr($dat, $off + 4))];
 165             foreach (@{$t->{'right'}})
 166             {
 167                 $_ >>= 1;
 168                 $maxr = $_ if ($_ > $maxr);
 169             }
 170             $t->{'right_max'} = $maxr;
 171
 172             $off = unpack("n", substr($dat, 6));
 173             for ($j = 0; $j <= $maxl; $j++)
 174             {
 175                 my ($k) = 0;
 176
 177                 map { $t->{'kern'}{$j}{$k} = $_ if $_; $k++; }
 178                         unpack("n$maxr", substr($dat, $off + $wid * $j));
 179             }
 180         }
 181         push (@{$self->{'tables'}}, $t);
 182     }
 183     $self;
 184 }
 185
 186
 187 =head2 $t->out($fh)
 188
 189 Outputs the kerning tables to the given file
 190
 191 =cut
 192
 193 sub out
 194 {
 195     my ($self, $fh) = @_;
 196     my ($i, $l, $r, $loc, $loc1, $t);
 197
 198     return $self->SUPER::out($fh) unless ($self->{' read'});
 199
 200     $fh->print(pack("n2", $self->{'Version'}, $self->{'Num'}));
 201     for ($i = 0; $i < $self->{'Num'}; $i++)
 202     {
 203         $t = $self->{'tables'}[$i];
 204         $loc = $fh->tell();
 205
 206         $fh->print(pack("nnn", $t->{'Version'}, 0, $t->{'coverage'}));
 207         if ($t->{'Version'} == 0)
 208         {
 209             my ($dat);
 210             foreach $l (sort {$a <=> $b} keys %{$t->{'kern'}})
 211             {
 212                 foreach $r (sort {$a <=> $b} keys %{$t->{'kern'}{$l}})
 213                 { $dat .= TTF_Pack("SSs", $l, $r, $t->{'kern'}{$l}{$r}); }
 214             }
 215             $fh->print(TTF_Pack("SSSS", Font::TTF::Utils::TTF_bininfo(length($dat) / 6, 6)));
 216             $fh->print($dat);
 217         } elsif ($t->{'Version'} == 2)
 218         {
 219             my ($arr);
 220
 221             $fh->print(pack("nnnn", $t->{'right_max'} << 1, 8, ($#{$t->{'left'}} + 7) << 1,
 222                     ($#{$t->{'left'}} + $#{$t->{'right'}} + 10) << 1));
 223
 224             $fh->print(pack("nn", $t->{'left_first'}, $#{$t->{'left'}} + 1));
 225             foreach (@{$t->{'left'}})
 226             { $fh->print(pack("C", $_ * (($t->{'left_max'} + 1) << 1))); }
 227
 228             $fh->print(pack("nn", $t->{'right_first'}, $#{$t->{'right'}} + 1));
 229             foreach (@{$t->{'right'}})
 230             { $fh->print(pack("C", $_ << 1)); }
 231
 232             $arr = "\000\000" x (($t->{'left_max'} + 1) * ($t->{'right_max'} + 1));
 233             foreach $l (keys %{$t->{'kern'}})
 234             {
 235                 foreach $r (keys %{$t->{'kern'}{$l}})
 236                 { substr($arr, ($l * ($t->{'left_max'} + 1) + $r) << 1, 2)
 237                         = pack("n", $t->{'kern'}{$l}{$r}); }
 238             }
 239             $fh->print($arr);
 240         }
 241         $loc1 = $fh->tell();
 242         $fh->seek($loc + 2, 0);
 243         $fh->print(pack("n", $loc1 - $loc));
 244         $fh->seek($loc1, 0);
 245     }
 246     $self;
 247 }
 248
 249
 250 =head2 $t->XML_element($context, $depth, $key, $value)
 251
 252 Handles outputting the kern hash into XML a little more tidily
 253
 254 =cut
 255
 256 sub XML_element
 257 {
 258     my ($self) = shift;
 259     my ($context, $depth, $key, $value) = @_;
 260     my ($fh) = $context->{'fh'};
 261     my ($f, $l);
 262
 263     return $self->SUPER::XML_element(@_) unless ($key eq 'kern');
 264     $fh->print("$depth<kern-table>\n");
 265     foreach $f (sort {$a <=> $b} keys %{$value})
 266     {
 267         foreach $l (sort {$a <=> $b} keys %{$value->{$f}})
 268         { $fh->print("$depth$context->{'indent'}<adjust first='$f' last='$l' dist='$value->{$f}{$l}'/>\n"); }
 269     }
 270     $fh->print("$depth</kern-table>\n");
 271     $self;
 272 }
 273
 274 1;
 275
 276 =head1 BUGS
 277
 278 =over 4
 279
 280 =item *
 281
 282 Only supports kerning table types 0 & 2.
 283
 284 =item *
 285
 286 No real support functions to I<do> anything with the kerning tables yet.
 287
 288 =back
 289
 290 =head1 AUTHOR
 291
 292 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
 293 licensing.
 294
 295 =cut
 296