6aa1e62a28122bb94fe4528d4618ed83060b52b4
[librarian.git] / src / 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