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