epub fix
[librarian.git] / 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