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

   1 package Font::TTF::Mort;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Mort - Glyph Metamorphosis table in a font
   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::Mort::Chain;
  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     my ($dat, $fh, $numChains);
  29
  30     $self->SUPER::read or return $self;
  31
  32     $fh = $self->{' INFILE'};
  33
  34     $fh->read($dat, 8);
  35     ($self->{'version'}, $numChains) = TTF_Unpack("vL", $dat);
  36
  37     my $chains = [];
  38     foreach (1 .. $numChains) {
  39         my $chain = new Font::TTF::Mort::Chain->new;
  40         $chain->read($fh);
  41         $chain->{' PARENT'} = $self;
  42         push @$chains, $chain;
  43     }
  44
  45     $self->{'chains'} = $chains;
  46
  47     $self;
  48 }
  49
  50 =head2 $t->out($fh)
  51
  52 Writes the table to a file either from memory or by copying
  53
  54 =cut
  55
  56 sub out
  57 {
  58     my ($self, $fh) = @_;
  59
  60     return $self->SUPER::out($fh) unless $self->{' read'};
  61
  62     my $chains = $self->{'chains'};
  63     $fh->print(TTF_Pack("vL", $self->{'version'}, scalar @$chains));
  64
  65     foreach (@$chains) {
  66         $_->out($fh);
  67     }
  68 }
  69
  70 =head2 $t->print($fh)
  71
  72 Prints a human-readable representation of the table
  73
  74 =cut
  75
  76 sub print
  77 {
  78     my ($self, $fh) = @_;
  79
  80     $self->read unless $self->{' read'};
  81     my $feat = $self->{' PARENT'}->{'feat'};
  82     $feat->read;
  83     my $post = $self->{' PARENT'}->{'post'};
  84     $post->read;
  85
  86     $fh = 'STDOUT' unless defined $fh;
  87
  88     $fh->printf("version %f\n", $self->{'version'});
  89
  90     my $chains = $self->{'chains'};
  91     foreach (@$chains) {
  92         $_->print($fh);
  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