1package Font::TTF::Feat;
2
3=head1 NAME
4
5Font::TTF::Feat - Font Features
6
7=head1 DESCRIPTION
8
9=head1 INSTANCE VARIABLES
10
11=over 4
12
13=item version
14
15=item features
16
17An array of hashes of the following form
18
19=over 8
20
21=item feature
22
23feature id number
24
25=item name
26
27name index in name table
28
29=item exclusive
30
31exclusive flag
32
33=item settings
34
35hash of setting number against name string index
36
37=back
38
39=back
40
41=head1 METHODS
42
43=cut
44
45use strict;
46use vars qw(@ISA);
47
48use Font::TTF::Utils;
49
50require Font::TTF::Table;
51
52@ISA = qw(Font::TTF::Table);
53
54=head2 $t->read
55
56Reads the features from the TTF file into memory
57
58=cut
59
60sub read
61{
62    my ($self) = @_;
63    my ($featureCount, $features);
64
65    $self->SUPER::read_dat or return $self;
66
67    ($self->{'version'}, $featureCount) = TTF_Unpack("vS", $self->{' dat'});
68
69    $features = [];
70    foreach (1 .. $featureCount) {
71        my ($feature, $nSettings, $settingTable, $featureFlags, $nameIndex)
72                = TTF_Unpack("SSLSS", substr($self->{' dat'}, $_ * 12, 12));
73        push @$features,
74            {
75                'feature'    => $feature,
76                'name'        => $nameIndex,
77                'exclusive'    => (($featureFlags & 0x8000) != 0),
78                'settings'    => { TTF_Unpack("S*", substr($self->{' dat'}, $settingTable, $nSettings * 4)) }
79            };
80    }
81    $self->{'features'} = $features;
82
83    delete $self->{' dat'}; # no longer needed, and may become obsolete
84
85    $self;
86}
87
88=head2 $t->out($fh)
89
90Writes the features to a TTF file
91
92=cut
93
94sub out
95{
96    my ($self, $fh) = @_;
97    my ($features, $numFeatures, $settings, $featuresData, $settingsData);
98
99    return $self->SUPER::out($fh) unless $self->{' read'};
100
101    $features = $self->{'features'};
102    $numFeatures = @$features;
103
104    foreach (@$features) {
105        $settings = $_->{'settings'};
106        $featuresData .= TTF_Pack("SSLSS",
107                                    $_->{'feature'},
108                                    scalar keys %$settings,
109                                    12 + 12 * $numFeatures + length $settingsData,
110                                    ($_->{'exclusive'} ? 0x8000 : 0x0000),
111                                    $_->{'name'});
112        foreach (sort {$a <=> $b} keys %$settings) {
113            $settingsData .= TTF_Pack("SS", $_, $settings->{$_});
114        }
115    }
116
117    $fh->print(TTF_Pack("vSSL", $self->{'version'}, $numFeatures, 0, 0));
118    $fh->print($featuresData);
119    $fh->print($settingsData);
120
121    $self;
122}
123
124
125=head2 $t->minsize()
126
127Returns the minimum size this table can be. If it is smaller than this, then the table
128must be bad and should be deleted or whatever.
129
130=cut
131
132sub minsize
133{
134    return 6;
135}
136
137
138=head2 $t->print($fh)
139
140Prints a human-readable representation of the table
141
142=cut
143
144sub print
145{
146    my ($self, $fh) = @_;
147    my ($names, $features, $settings);
148
149    $self->read;
150
151    $names = $self->{' PARENT'}->{'name'};
152    $names->read;
153
154    $fh = 'STDOUT' unless defined $fh;
155
156    $features = $self->{'features'};
157    foreach (@$features) {
158        $fh->printf("Feature %d, %s, name %d # '%s'\n",
159                    $_->{'feature'},
160                    ($_->{'exclusive'} ? "exclusive" : "additive"),
161                    $_->{'name'},
162                    $names->{'strings'}[$_->{'name'}][1][0]{0});
163        $settings = $_->{'settings'};
164        foreach (sort { $a <=> $b } keys %$settings) {
165            $fh->printf("\tSetting %d, name %d # '%s'\n",
166                        $_, $settings->{$_}, $names->{'strings'}[$settings->{$_}][1][0]{0});
167        }
168    }
169
170    $self;
171}
172
173sub settingName
174{
175    my ($self, $feature, $setting) = @_;
176
177    $self->read;
178
179    my $names = $self->{' PARENT'}->{'name'};
180    $names->read;
181
182    my $features = $self->{'features'};
183    my ($featureEntry) = grep { $_->{'feature'} == $feature } @$features;
184    my $featureName = $names->{'strings'}[$featureEntry->{'name'}][1][0]{0};
185    my $settingName = $featureEntry->{'exclusive'}
186            ? $names->{'strings'}[$featureEntry->{'settings'}->{$setting}][1][0]{0}
187            : $names->{'strings'}[$featureEntry->{'settings'}->{$setting & ~1}][1][0]{0}
188                . (($setting & 1) == 0 ? " On" : " Off");
189
190    ($featureName, $settingName);
191}
192
1931;
194
195=head1 BUGS
196
197None known
198
199=head1 AUTHOR
200
201Jonathan Kew L<http://scripts.sil.org/FontUtils>.
202
203
204=head1 LICENSING
205
206Copyright (c) 1998-2016, SIL International (http://www.sil.org)
207
208This module is released under the terms of the Artistic License 2.0.
209For details, see the full text of the license in the file LICENSE.
210
211
212
213=cut
214
215
216