b3eeef0078722d39861548a57c0d2e9947015da6
[librarian.git] / src / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Ttc.pm
1 package Font::TTF::Ttc;
2
3 =head1 NAME
4
5 Font::TTF::Ttc - Truetype Collection class
6
7 =head1 DESCRIPTION
8
9 A TrueType collection is a collection of TrueType fonts in one file in which
10 tables may be shared between different directories. In order to support this,
11 the TTC introduces the concept of a table being shared by different TrueType
12 fonts. This begs the question of what should happen to the ' PARENT' property
13 of a particular table. It is made to point to the first directory object which
14 refers to it. It is therefore up to the application to sort out any confusion.
15 Confusion only occurs if shared tables require access to non-shared tables.
16 This should not happen since the shared tables are dealing with glyph
17 information only and the private tables are dealing with encoding and glyph
18 identification. Thus the general direction is from identification to glyph and
19 not the other way around (at least not without knowledge of the particular
20 context).
21
22 =head1 INSTANCE VARIABLES
23
24 The following instance variables are preceded by a space
25
26 =over 4
27
28 =item fname (P)
29
30 Filename for this TrueType Collection
31
32 =item INFILE (P)
33
34 The filehandle of this collection
35
36 =back
37
38 The following instance variable does not start with a space
39
40 =over 4
41
42 =item directs
43
44 An array of directories (Font::TTF::Font objects) for each sub-font in the directory
45
46 =back
47
48 =head1 METHODS
49
50 =cut
51
52 use strict;
53 use vars qw($VERSION);
54
55 use IO::File;
56
57 $VERSION = 0.0001;
58
59 =head2 Font::TTF::Ttc->open($fname)
60
61 Opens and reads the given filename as a TrueType Collection. Reading a collection
62 involves reading each of the directories which go to make up the collection.
63
64 =cut
65
66 sub open
67 {
68     my ($class, $fname) = @_;
69     my ($self) = {};
70     my ($fh);
71
72     unless (ref($fname))
73     {
74         $fh = IO::File->new($fname) or return undef;
75         binmode $fh;
76     } else
77     { $fh = $fname; }
78     
79     bless $self, $class;
80     $self->{' INFILE'} = $fh;
81     $self->{' fname'} = $fname;
82     $fh->seek(0, 0);
83     $self->read;
84 }
85
86
87 =head2 $c->read
88
89 Reads a Collection by reading all the directories in the collection
90
91 =cut
92
93 sub read
94 {
95     my ($self) = @_;
96     my ($fh) = $self->{' INFILE'};
97     my ($dat, $ttc, $ver, $num, $i, $loc);
98
99     $fh->read($dat, 12);
100     ($ttc, $ver, $num) = unpack("A4N2", $dat);
101
102     return undef unless $ttc eq "ttcf";
103     $fh->read($dat, $num << 2);
104     for ($i = 0; $i < $num; $i++)
105     {
106         $loc = unpack("N", substr($dat, $i << 2, 4));       
107         $self->{'directs'}[$i] = Font::TTF::Font->new('INFILE' => $fh,
108                                                 'PARENT' => $self,
109                                                 'OFFSET' => $loc) || return undef;
110     }
111     for ($i = 0; $i < $num; $i++)
112     { $self->{'directs'}[$i]->read; }
113     $self;
114 }
115
116
117 =head2 $c->find($direct, $name, $check, $off, $len)
118
119 Hunts around to see if a table with the given characteristics of name, checksum,
120 offset and length has been associated with a directory earlier in the list.
121 Actually on checks the offset since no two tables can share the same offset in
122 a TrueType font, collection or otherwise.
123
124 =cut
125
126 sub find
127 {
128     my ($self, $direct, $name, $check, $off, $len) = @_;
129     my ($d);
130
131     foreach $d (@{$self->{'directs'}})
132     {
133         return undef if $d eq $direct;
134         next unless defined $d->{$name};
135         return $d->{$name} if ($d->{$name}{' OFFSET'} == $off);
136     }
137     undef;              # wierd that the font passed is not in the list!
138 }
139
140
141 =head2 $c->DESTROY
142
143 Closees any opened files by us
144
145 =cut
146
147 sub DESTROY
148 {
149     my ($self) = @_;
150     close ($self->{' INFILE'});
151     undef;
152 }
153
154 =head1 BUGS
155
156 No known bugs, but then not ever executed!
157
158 =head1 AUTHOR
159
160 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
161 licensing.
162
163 =cut
164