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