6a17af111a8e8371ac116f64fd8ee953bf20d4f5
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Sill.pm
1 package Font::TTF::Sill;
2
3 =head1 NAME
4
5 Font::TTF::Sill - Graphite language mapping table
6
7 =head1 DESCRIPTION
8
9 =head1 INSTANCE VARIABLES
10
11 =over 4
12
13 =item version
14
15 Table version number.
16
17 =item langs
18
19 Contains a hash where the key is the language id and the value is an array of
20 language records
21
22 =back
23
24 =head2 Language Records
25
26 Each language record is itself an array of two values [fid, val]. fid is the
27 feature id and is held as a long.
28
29 =cut
30
31 use Font::TTF::Utils;
32 require Font::TTF::Table;
33
34 @ISA = qw(Font::TTF::Table);
35
36 sub read
37 {
38     my ($self) = @_;
39     my ($num, $i, $j);
40
41     return $self if ($self->{' read'});
42     $self->SUPER::read_dat or return $self;
43
44     ($self->{'version'}, $num) = TTF_Unpack("vS", $self->{' dat'});
45
46     foreach $i (1 .. $num)        # ignore bogus entry at end
47     {
48         my ($lid, $numf, $offset) = unpack("A4nn", substr($self->{' dat'}, $i * 8 + 4));      # 12 - 8 = 4 since i starts at 1. A4 strips nulls
49         my (@settings);
50
51         foreach $j (1 .. $numf)
52         {
53             my ($fid, $val) = TTF_Unpack("Ls", substr($self->{' dat'}, $offset + $j * 8 - 8));
54             push (@settings, [$fid, $val]);
55         }
56         $self->{'langs'}{$lid} = [@settings];
57     }
58     delete $self->{' dat'};
59     $self->{' read'} = 1;
60     $self;
61 }
62
63 sub out
64 {
65     my ($self, $fh) = @_;
66     my ($num, $range, $select, $shift) = TTF_bininfo(scalar keys %{$self->{'langs'}}, 1);
67     my ($offset) = $num * 8 + 20;   #header = 12, dummy = 8
68     my ($k, $s);
69
70     return $self->SUPER::out($fh) unless ($self->{' read'});
71     $fh->print(TTF_Pack("vSSSS", $self->{'version'}, $num, $range, $select, $shift));
72     foreach $k (sort (keys %{$self->{'langs'}}), '+1')
73     {
74         my ($numf) = scalar @{$self->{'langs'}{$k}} unless ($k eq '+1');
75         $fh->print(pack("a4nn", $k, $numf, $offset));
76         $offset += $numf * 8;
77     }
78
79     foreach $k (sort keys %{$self->{'langs'}})
80     {
81         foreach $s (@{$self->{'langs'}{$k}})
82         { $fh->print(TTF_Pack("LsS", @{$s}, 0)); }
83     }
84     $self;
85 }
86
87 sub XML_element
88 {
89     my ($self) = shift;
90     my ($context, $depth, $key, $dat) = @_;
91     my ($fh) = $context->{'fh'};
92     my ($k, $s);
93
94     return $self->SUPER::XML_element(@_) unless ($key eq 'langs');
95     foreach $k (sort keys %{$self->{'langs'}})
96     {
97         $fh->printf("%s<lang id='%s'>\n", $depth, $k);
98         foreach $s (@{$self->{'langs'}{$k}})
99         {
100             my ($fid) = $s->[0];
101             if ($fid > 0x00FFFFFF)
102             { $fid = unpack("A4", pack ("N", $fid)); }
103             else
104             { $fid = sprintf("%d", $fid); }
105             $fh->printf("%s%s<feature id='%s' value='%d'/>\n",
106                 $depth, $context->{'indent'}, $fid, $s->[1]);
107         }
108         $fh->printf("%s</lang>\n", $depth);
109     }
110     $self;
111 }
112 1;
113         
114