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

   1 package Font::TTF::Kern::StateTable;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Kern::StateTable - State Table Kern subtable for AAT
   6
   7 =head1 METHODS
   8
   9 =cut
  10
  11 use strict;
  12 use vars qw(@ISA);
  13 use Font::TTF::Utils;
  14 use Font::TTF::AATutils;
  15 use Font::TTF::Kern::Subtable;
  16 use IO::File;
  17
  18 @ISA = qw(Font::TTF::Kern::Subtable);
  19
  20 sub new
  21 {
  22     my ($class) = @_;
  23     my ($self) = {};
  24
  25     $class = ref($class) || $class;
  26     bless $self, $class;
  27 }
  28
  29 =head2 $t->read
  30
  31 Reads the table into memory
  32
  33 =cut
  34
  35 sub read
  36 {
  37     my ($self, $fh) = @_;
  38     my ($dat);
  39
  40     my $stTableStart = $fh->tell();
  41
  42     my ($classes, $states, $entries) = AAT_read_state_table($fh, 0);
  43
  44     foreach (@$entries) {
  45         my $flags = $_->{'flags'};
  46         delete $_->{'flags'};
  47         $_->{'push'} = 1        if $flags & 0x8000;
  48         $_->{'noAdvance'} = 1    if $flags & 0x4000;
  49         $flags &= ~0xC000;
  50         if ($flags != 0) {
  51             my $kernList = [];
  52             $fh->seek($stTableStart + $flags, IO::File::SEEK_SET);
  53             while (1) {
  54                 $fh->read($dat, 2);
  55                 my $k = TTF_Unpack("s", $dat);
  56                 push @$kernList, ($k & ~1);
  57                 last if ($k & 1) != 0;
  58             }
  59             $_->{'kernList'} = $kernList;
  60         }
  61     }
  62
  63     $self->{'classes'} = $classes;
  64     $self->{'states'} = $states;
  65     $self->{'entries'} = $entries;
  66
  67     $fh->seek($stTableStart - 8 + $self->{'length'}, IO::File::SEEK_SET);
  68
  69     $self;
  70 }
  71
  72 =head2 $t->out_sub($fh)
  73
  74 Writes the table to a file
  75
  76 =cut
  77
  78 sub out_sub
  79 {
  80 }
  81
  82 =head2 $t->print($fh)
  83
  84 Prints a human-readable representation of the table
  85
  86 =cut
  87
  88 sub print
  89 {
  90 }
  91
  92 sub dumpXML
  93 {
  94     my ($self, $fh) = @_;
  95
  96     $fh->printf("<classes>\n");
  97     $self->dumpClasses($self->{'classes'}, $fh);
  98     $fh->printf("</classes>\n");
  99
 100     $fh->printf("<states>\n");
 101     my $states = $self->{'states'};
 102     foreach (0 .. $#$states) {
 103         $fh->printf("<state index=\"%s\">\n", $_);
 104         my $members = $states->[$_];
 105         foreach (0 .. $#$members) {
 106             my $m = $members->[$_];
 107             $fh->printf("<m index=\"%s\" nextState=\"%s\"", $_, $m->{'nextState'});
 108             $fh->printf(" push=\"1\"")        if $m->{'push'};
 109             $fh->printf(" noAdvance=\"1\"")    if $m->{'noAdvance'};
 110             if (exists $m->{'kernList'}) {
 111                 $fh->printf(">");
 112                 foreach (@{$m->{'kernList'}}) {
 113                     $fh->printf("<kern v=\"%s\"/>", $_);
 114                 }
 115                 $fh->printf("</m>\n");
 116             }
 117             else {
 118                 $fh->printf("/>\n");
 119             }
 120         }
 121         $fh->printf("</state>\n");
 122     }
 123     $fh->printf("</states>\n");
 124 }
 125
 126 sub type
 127 {
 128     return 'kernStateTable';
 129 }
 130
 131 1;
 132
 133 =head1 BUGS
 134
 135 None known
 136
 137 =head1 AUTHOR
 138
 139 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 140 licensing.
 141
 142 =cut
 143