also dont add tuples to lists sleepy man.
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Hdmx.pm
1 package Font::TTF::Hdmx;
2
3 =head1 NAME
4
5 Font::TTF::Hdmx - Horizontal device metrics
6
7 =head1 DESCRIPTION
8
9 The table consists of an hash of device metric tables indexed by the ppem for
10 that subtable. Each subtable consists of an array of advance widths in pixels
11 for each glyph at that ppem (horizontally).
12
13 =head1 INSTANCE VARIABLES
14
15 Individual metrics are accessed using the following referencing:
16
17     $f->{'hdmx'}{$ppem}[$glyph_num]
18
19 In addition there is one instance variable:
20
21 =over 4
22
23 =item Num
24
25 Number of device tables.
26
27 =back
28
29 =head2 METHODS
30
31 =cut
32
33 use strict;
34 use vars qw(@ISA);
35
36 @ISA = qw(Font::TTF::Table);
37
38
39 =head2 $t->read
40
41 Reads the table into data structures
42
43 =cut
44
45 sub read
46 {
47     my ($self) = @_;
48     my ($fh) = $self->{' INFILE'};
49     my ($numg, $ppem, $i, $numt, $dat, $len);
50
51     $numg = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
52     $self->SUPER::read or return $self;
53
54     $fh->read($dat, 8);
55     ($self->{'Version'}, $numt, $len) = unpack("nnN", $dat);
56     $self->{'Num'} = $numt;
57
58     for ($i = 0; $i < $numt; $i++)
59     {
60         $fh->read($dat, $len);
61         $ppem = unpack("C", $dat);
62         $self->{$ppem} = [unpack("C$numg", substr($dat, 2))];
63     }
64     $self;
65 }
66
67
68 =head2 $t->out($fh)
69
70 Outputs the device metrics for this font
71
72 =cut
73
74 sub out
75 {
76     my ($self, $fh) = @_;
77     my ($numg, $i, $pad, $len, $numt, @ppem, $max);
78
79     return $self->SUPER::out($fh) unless ($self->{' read'});
80
81     $numg = $self->{' PARENT'}{'maxp'}{'numGlyphs'};
82     @ppem = grep(/^\d+$/, sort {$a <=> $b} keys %$self);
83     $pad = "\000" x (3 - ($numg + 1) % 4);
84     $len = $numg + 2 + length($pad);
85     $fh->print(pack("nnN", 0, $#ppem + 1, $len));
86     for $i (@ppem)
87     {
88         $max = 0;
89         foreach (@{$self->{$i}}[0..($numg - 1)])
90         { $max = $_ if $_ > $max; }
91         $fh->print(pack("C*", $i, $max, @{$self->{$i}}[0..($numg - 1)]) . $pad);
92     }
93     $self;
94 }
95
96
97 =head2 $t->tables_do(&func)
98
99 For each subtable it calls &sub($ref, $ppem)
100
101 =cut
102
103 sub tables_do
104 {
105     my ($self, $func) = @_;
106     my ($i);
107
108     foreach $i (grep(/^\d+$/, %$self))
109     { &$func($self->{$i}, $i); }
110     $self;
111 }
112
113
114 =head2 $t->XML_element($context, $depth, $key, $value)
115
116 Outputs device metrics a little more tidily
117
118 =cut
119
120 sub XML_element
121 {
122     my ($self) = shift;
123     my ($context, $depth, $key, $value) = @_;
124     my ($fh) = $context->{'fh'};
125     my ($i);
126
127     return $self->SUPER::XML_element(@_) if (ref($value) ne 'ARRAY');
128     $fh->print("$depth<metrics ppem='$key'>\n");
129     for ($i = 0; $i <= $#{$value}; $i += 25)
130     {
131         $fh->print("$depth$context->{'indent'}". join(' ', @{$value}[$i .. $i + 24]) . "\n");
132     }
133     $fh->print("$depth</metrics>\n");
134     $self;
135 }
136
137 1;
138
139 =head1 BUGS
140
141 None known
142
143 =head1 AUTHOR
144
145 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
146 licensing.
147
148 =cut
149