librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/AATKern.pm

   1 package Font::TTF::AATKern;
   2
   3 =head1 NAME
   4
   5 Font::TTF::AATKern - AAT Kern table
   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
  17 @ISA = qw(Font::TTF::Table);
  18
  19 =head2 $t->read
  20
  21 Reads the table into memory
  22
  23 =cut
  24
  25 sub read
  26 {
  27     my ($self) = @_;
  28
  29     $self->SUPER::read or return $self;
  30
  31     my ($dat, $fh, $numSubtables);
  32     $fh = $self->{' INFILE'};
  33
  34     $fh->read($dat, 8);
  35     ($self->{'version'}, $numSubtables) = TTF_Unpack("vL", $dat);
  36
  37     my $subtables = [];
  38     foreach (1 .. $numSubtables) {
  39         my $subtableStart = $fh->tell();
  40
  41         $fh->read($dat, 8);
  42         my ($length, $coverage, $tupleIndex) = TTF_Unpack("LSS", $dat);
  43         my $type = $coverage & 0x00ff;
  44
  45         my $subtable = Font::TTF::Kern::Subtable->create($type, $coverage, $length);
  46         $subtable->read($fh);
  47
  48         $subtable->{'tupleIndex'} = $tupleIndex if $subtable->{'variation'};
  49         $subtable->{' PARENT'} = $self;
  50         push @$subtables, $subtable;
  51     }
  52
  53     $self->{'subtables'} = $subtables;
  54
  55     $self;
  56 }
  57
  58 =head2 $t->out($fh)
  59
  60 Writes the table to a file either from memory or by copying
  61
  62 =cut
  63
  64 sub out
  65 {
  66     my ($self, $fh) = @_;
  67
  68     return $self->SUPER::out($fh) unless $self->{' read'};
  69
  70     my $subtables = $self->{'subtables'};
  71     $fh->print(TTF_Pack("vL", $self->{'version'}, scalar @$subtables));
  72
  73     foreach (@$subtables) {
  74         $_->out($fh);
  75     }
  76 }
  77
  78 =head2 $t->print($fh)
  79
  80 Prints a human-readable representation of the table
  81
  82 =cut
  83
  84 sub print
  85 {
  86     my ($self, $fh) = @_;
  87
  88     $self->read unless $self->{' read'};
  89
  90     $fh = 'STDOUT' unless defined $fh;
  91
  92     $fh->printf("version %f\n", $self->{'version'});
  93
  94     my $subtables = $self->{'subtables'};
  95     foreach (@$subtables) {
  96         $_->print($fh);
  97     }
  98 }
  99
 100 sub dumpXML
 101 {
 102     my ($self, $fh) = @_;
 103     $self->read unless $self->{' read'};
 104
 105     my $post = $self->{' PARENT'}->{'post'};
 106     $post->read;
 107
 108     $fh = 'STDOUT' unless defined $fh;
 109     $fh->printf("<kern version=\"%f\">\n", $self->{'version'});
 110
 111     my $subtables = $self->{'subtables'};
 112     foreach (@$subtables) {
 113         $fh->printf("<%s", $_->type);
 114         $fh->printf(" vertical=\"1\"") if $_->{'vertical'};
 115         $fh->printf(" crossStream=\"1\"") if $_->{'crossStream'};
 116         $fh->printf(" variation=\"1\"") if $_->{'variation'};
 117         $fh->printf(" tupleIndex=\"%s\"", $_->{'tupleIndex'}) if exists $_->{'tupleIndex'};
 118         $fh->printf(">\n");
 119
 120         $_->dumpXML($fh);
 121
 122         $fh->printf("</%s>\n", $_->type);
 123     }
 124
 125     $fh->printf("</kern>\n");
 126 }
 127
 128 1;
 129
 130 =head1 BUGS
 131
 132 None known
 133
 134 =head1 AUTHOR
 135
 136 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 137 licensing.
 138
 139 =cut
 140