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

   1 package Font::TTF::Mort::Rearrangement;
   2
   3 =head1 NAME
   4
   5 Font::TTF::Mort::Rearrangement - Rearrangement Mort 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::Mort::Subtable);
  17
  18 sub new
  19 {
  20     my ($class, $direction, $orientation, $subFeatureFlags) = @_;
  21     my ($self) = {
  22                     'direction'            => $direction,
  23                     'orientation'        => $orientation,
  24                     'subFeatureFlags'    => $subFeatureFlags
  25                 };
  26
  27     $class = ref($class) || $class;
  28     bless $self, $class;
  29 }
  30
  31 =head2 $t->read
  32
  33 Reads the table into memory
  34
  35 =cut
  36
  37 sub read
  38 {
  39     my ($self, $fh) = @_;
  40
  41     my ($classes, $states) = AAT_read_state_table($fh, 0);
  42     $self->{'classes'} = $classes;
  43     $self->{'states'} = $states;
  44
  45     $self;
  46 }
  47
  48 =head2 $t->pack_sub()
  49
  50 =cut
  51
  52 sub pack_sub
  53 {
  54     my ($self) = @_;
  55
  56     return AAT_pack_state_table($self->{'classes'}, $self->{'states'}, 0);
  57 }
  58
  59 =head2 $t->print($fh)
  60
  61 Prints a human-readable representation of the table
  62
  63 =cut
  64
  65 sub print
  66 {
  67     my ($self, $fh) = @_;
  68
  69     my $post = $self->post();
  70
  71     $fh = 'STDOUT' unless defined $fh;
  72
  73     $self->print_classes($fh);
  74
  75     $fh->print("\n");
  76     my $states = $self->{'states'};
  77     my @verbs = (    "0", "Ax->xA", "xD->Dx", "AxD->DxA",
  78                     "ABx->xAB", "ABx->xBA", "xCD->CDx", "xCD->DCx",
  79                     "AxCD->CDxA", "AxCD->DCxA", "ABxD->DxAB", "ABxD->DxBA",
  80                     "ABxCD->CDxAB", "ABxCD->CDxBA", "ABxCD->DCxAB", "ABxCD->DCxBA");
  81     foreach (0 .. $#$states) {
  82         $fh->printf("\t\tState %d:", $_);
  83         my $state = $states->[$_];
  84         foreach (@$state) {
  85             my $flags;
  86             $flags .= "!" if ($_->{'flags'} & 0x4000);
  87             $flags .= "<" if ($_->{'flags'} & 0x8000);
  88             $flags .= ">" if ($_->{'flags'} & 0x2000);
  89             $fh->printf("\t(%s%d,%s)", $flags, $_->{'nextState'}, $verbs[($_->{'flags'} & 0x000f)]);
  90         }
  91         $fh->print("\n");
  92     }
  93 }
  94
  95 1;
  96
  97 =head1 BUGS
  98
  99 None known
 100
 101 =head1 AUTHOR
 102
 103 Jonathan Kew L<Jonathan_Kew@sil.org>. See L<Font::TTF::Font> for copyright and
 104 licensing.
 105
 106 =cut
 107