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

   1 package Font::TTF::Kern::OrderedList;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Kern::OrderedList - Ordered List 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
  16 @ISA = qw(Font::TTF::Kern::Subtable);
  17
  18 sub new
  19 {
  20     my ($class, @options) = @_;
  21     my ($self) = {};
  22
  23     $class = ref($class) || $class;
  24     bless $self, $class;
  25 }
  26
  27 =head2 $t->read
  28
  29 Reads the table into memory
  30
  31 =cut
  32
  33 sub read
  34 {
  35     my ($self, $fh) = @_;
  36
  37     my $dat;
  38     $fh->read($dat, 8);
  39     my ($nPairs, $searchRange, $entrySelector, $rangeShift) = unpack("nnnn", $dat);
  40
  41     my $pairs = [];
  42     foreach (1 .. $nPairs) {
  43         $fh->read($dat, 6);
  44         my ($left, $right, $kern) = TTF_Unpack("SSs", $dat);
  45         push @$pairs, { 'left' => $left, 'right' => $right, 'kern' => $kern } if $kern != 0;
  46     }
  47
  48     $self->{'kernPairs'} = $pairs;
  49
  50     $self;
  51 }
  52
  53 =head2 $t->out_sub($fh)
  54
  55 Writes the table to a file
  56
  57 =cut
  58
  59 sub out_sub
  60 {
  61     my ($self, $fh) = @_;
  62
  63     my $pairs = $self->{'kernPairs'};
  64     $fh->print(pack("nnnn", TTF_bininfo(scalar @$pairs, 6)));
  65
  66     foreach (sort { $a->{'left'} <=> $b->{'left'} or $a->{'right'} <=> $b->{'right'} } @$pairs) {
  67         $fh->print(TTF_Pack("SSs", $_->{'left'}, $_->{'right'}, $_->{'kern'}));
  68     }
  69 }
  70
  71 =head2 $t->print($fh)
  72
  73 Prints a human-readable representation of the table
  74
  75 =cut
  76
  77 sub dumpXML
  78 {
  79     my ($self, $fh) = @_;
  80
  81     my $postVal = $self->post()->{'VAL'};
  82
  83     $fh = 'STDOUT' unless defined $fh;
  84     foreach (@{$self->{'kernPairs'}}) {
  85         $fh->printf("<pair l=\"%s\" r=\"%s\" v=\"%s\"/>\n", $postVal->[$_->{'left'}], $postVal->[$_->{'right'}], $_->{'kern'});
  86     }
  87 }
  88
  89
  90 sub type
  91 {
  92     return 'kernOrderedList';
  93 }
  94
  95
  96 1;
  97
  98 =head1 BUGS
  99
 100 None known
 101
 102 =head1 AUTHOR
 103
 104 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 105 licensing.
 106
 107 =cut
 108