8f5cc50f9dafa4e039d5776eb91dfc5dc1d1e889
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Font.pm
1 package Font::TTF::Font;
2
3 =head1 NAME
4
5 Font::TTF::Font - Memory representation of a font
6
7 =head1 SYNOPSIS
8
9 Here is the regression test (you provide your own font). Run it once and then
10 again on the output of the first run. There should be no differences between
11 the outputs of the two runs.
12
13     $f = Font::TTF::Font->open($ARGV[0]);
14
15     # force a read of all the tables
16     $f->tables_do(sub { $_[0]->read; });
17
18     # force read of all glyphs (use read_dat to use lots of memory!)
19     # $f->{'loca'}->glyphs_do(sub { $_[0]->read; });
20     $f->{'loca'}->glyphs_do(sub { $_[0]->read_dat; });
21     # NB. no need to $g->update since $f->{'glyf'}->out will do it for us
22
23     $f->out($ARGV[1]);
24     $f->release;            # clear up memory forcefully!
25
26 =head1 DESCRIPTION
27
28 A Truetype font consists of a header containing a directory of tables which
29 constitute the rest of the file. This class holds that header and directory and
30 also creates objects of the appropriate type for each table within the font.
31 Note that it does not read each table into memory, but creates a short reference
32 which can be read using the form:
33
34     $f->{$tablename}->read;
35
36 Classes are included that support many of the different TrueType tables. For
37 those for which no special code exists, the table type C<table> is used, which
38 defaults to L<Font::TTF::Table>. The current tables which are supported are:
39
40     table       Font::TTF::Table      - for unknown tables
41     EBDT        Font::TTF::EBDT
42     EBLC        Font::TTF::EBLC
43     Feat        Font::TTF::GrFeat
44     GDEF        Font::TTF::GDEF
45     GPOS        Font::TTF::GPOS
46     GSUB        Font::TTF::GSUB
47     LTSH        Font::TTF::LTSH
48     OS/2        Font::TTF::OS_2
49     PCLT        Font::TTF::PCLT
50     Sill        Font::TTF::Sill
51     bsln        Font::TTF::Bsln
52     cmap        Font::TTF::Cmap       - see also Font::TTF::OldCmap
53     cvt         Font::TTF::Cvt_
54     fdsc        Font::TTF::Fdsc
55     feat        Font::TTF::Feat
56     fmtx        Font::TTF::Fmtx
57     fpgm        Font::TTF::Fpgm
58     glyf        Font::TTF::Glyf       - see also Font::TTF::Glyph
59     hdmx        Font::TTF::Hdmx
60     head        Font::TTF::Head
61     hhea        Font::TTF::Hhea
62     hmtx        Font::TTF::Hmtx
63     kern        Font::TTF::Kern       - see alternative Font::TTF::AATKern
64     loca        Font::TTF::Loca
65     maxp        Font::TTF::Maxp
66     mort        Font::TTF::Mort       - see also Font::TTF::OldMort
67     name        Font::TTF::Name
68     post        Font::TTF::Post
69     prep        Font::TTF::Prep
70     prop        Font::TTF::Prop
71     vhea        Font::TTF::Vhea
72     vmtx        Font::TTF::Vmtx
73
74 Links are:
75
76 L<Font::TTF::Table> 
77 L<Font::TTF::EBDT> L<Font::TTF::EBLC> L<Font::TTF::GrFeat>
78 L<Font::TTF::GDEF> L<Font::TTF::GPOS> L<Font::TTF::GSUB> L<Font::TTF::LTSH>
79 L<Font::TTF::OS_2> L<Font::TTF::PCLT> L<Font::TTF::Sill> L<Font::TTF::Bsln> L<Font::TTF::Cmap> L<Font::TTF::Cvt_>
80 L<Font::TTF::Fdsc> L<Font::TTF::Feat> L<Font::TTF::Fmtx> L<Font::TTF::Fpgm> L<Font::TTF::Glyf>
81 L<Font::TTF::Hdmx> L<Font::TTF::Head> L<Font::TTF::Hhea> L<Font::TTF::Hmtx> L<Font::TTF::Kern>
82 L<Font::TTF::Loca> L<Font::TTF::Maxp> L<Font::TTF::Mort> L<Font::TTF::Name> L<Font::TTF::Post>
83 L<Font::TTF::Prep> L<Font::TTF::Prop> L<Font::TTF::Vhea> L<Font::TTF::Vmtx> L<Font::TTF::OldCmap>
84 L<Font::TTF::Glyph> L<Font::TTF::AATKern> L<Font::TTF::OldMort>
85
86
87 =head1 INSTANCE VARIABLES
88
89 Instance variables begin with a space (and have lengths greater than the 4
90 characters which make up table names).
91
92 =over
93
94 =item nocsum
95
96 This is used during output to disable the creation of the file checksum in the
97 head table. For example, during DSIG table creation, this flag will be set to
98 ensure that the file checksum is left at zero.
99
100 =item noharmony
101
102 If set, do not harmonize the script and lang trees of GPOS and GSUB tables. See L<Font::TTF::Ttopen> for more info.
103
104 =item fname (R)
105
106 Contains the filename of the font which this object was read from.
107
108 =item INFILE (P)
109
110 The file handle which reflects the source file for this font.
111
112 =item OFFSET (P)
113
114 Contains the offset from the beginning of the read file of this particular
115 font directory, thus providing support for TrueType Collections.
116
117 =back
118
119 =head1 METHODS
120
121 =cut
122
123 use IO::File;
124
125 use strict;
126 use vars qw(%tables $VERSION $dumper);
127 use Symbol();
128
129 require 5.004;
130
131 $VERSION = 0.38;    # MJPH       2-FEB-2008     Add Sill table
132 # $VERSION = 0.37;    # MJPH       7-OCT-2005     Force hhea update if dirty, give more OS/2 stuff in update
133 # $VERSION = 0.36;    # MJPH      19-AUG-2005     Change cmap::reverse api to be opts based
134 # $VERSION = 0.35;    # MJPH       4-MAY-2004     Various fixes to OpenType stuff, separate off scripts
135 # $VERSION = 0.34;    # MJPH      22-MAY-2003     Update PSNames to latest AGL
136 # $VERSION = 0.33;    # MJPH       9-OCT-2002     Support CFF OpenType (just by version=='OTTO'?!)
137 # $VERSION = 0.32;    # MJPH       2-OCT-2002     Bug fixes to TTFBuilder, new methods and some
138 #                                                 extension table support in Ttopen and Coverage
139 # $VERSION = 0.31;    # MJPH       1-JUL-2002     fix read format 12 cmap (bart@cs.pdx.edu) 
140 #                                                 improve surrogate support in ttfremap
141 #                                                 fix return warn to return warn,undef
142 #                                                 ensure correct indexToLocFormat
143 # $VERSION = 0.30;    # MJPH      28-MAY-2002     add updated release
144 # $VERSION = 0.29;    # MJPH       9-APR-2002     update ttfbuilder, sort out surrogates
145 # $VERSION = 0.28;    # MJPH      13-MAR-2002     update ttfbuilder, add Font::TTF::Cmap::ms_enc()
146 # $VERSION = 0.27;    # MJPH       6-FEB-2002     update ttfbuilder, support no fpgm, no more __DATA__
147 # $VERSION = 0.26;    # MJPH      19-SEP-2001     Update ttfbuilder
148 # $VERSION = 0.25;    # MJPH      18-SEP-2001     problems in update of head
149 # $VERSION = 0.24;    # MJPH       1-AUG-2001     Sort out update
150 # $VERSION = 0.23;    # GST       30-MAY-2001     Memory leak fixed
151 # $VERSION = 0.22;    # MJPH      09-APR-2001     Ensure all of AAT stuff included
152 # $VERSION = 0.21;    # MJPH      23-MAR-2001     Improve Opentype support
153 # $VERSION = 0.20;    # MJPH      13-JAN-2001     Add XML output and some of XML input, AAT & OT tables
154 # $VERSION = 0.19;    # MJPH      29-SEP-2000     Add cmap::is_unicode, debug makefile.pl
155 # $VERSION = 0.18;    # MJPH      21-JUL-2000     Debug Utils::TTF_bininfo
156 # $VERSION = 0.17;    # MJPH      16-JUN-2000     Add utf8 support to names
157 # $VERSION = 0.16;    # MJPH      26-APR-2000     Mark read tables as read, tidy up POD
158 # $VERSION = 0.15;    # MJPH       5-FEB-2000     Ensure right versions released
159 # $VERSION = 0.14;    # MJPH      11-SEP-1999     Sort out Unixisms, agian!
160 # $VERSION = 0.13;    # MJPH       9-SEP-1999     Add empty, debug update_bbox
161 # $VERSION = 0.12;    # MJPH      22-JUL-1999     Add update_bbox
162 # $VERSION = 0.11;    # MJPH       7-JUL-1999     Don't store empties in cmaps
163 # $VERSION = 0.10;    # MJPH      21-JUN-1999     Use IO::File
164 # $VERSION = 0.09;    # MJPH       9-JUN-1999     Add 5.004 require, minor tweeks in cmap
165 # $VERSION = 0.08;    # MJPH      19-MAY-1999     Sort out line endings for Unix
166 # $VERSION = 0.07;    # MJPH      28-APR-1999     Get the regression tests to work
167 # $VERSION = 0.06;    # MJPH      26-APR-1999     Start to add to CVS, correct MANIFEST.SKIP
168 # $VERSION = 0.05;    # MJPH      13-APR-1999     See changes for 0.05
169 # $VERSION = 0.04;    # MJPH      13-MAR-1999     Tidy up Tarball
170 # $VERSION = 0.03;    # MJPH       9-MAR-1999     Move to Font::TTF for CPAN
171 # $VERSION = 0.02;    # MJPH      12-FEB-1999     Add support for ' nocsum' for DSIGS
172 # $VERSION = 0.0001;
173
174 %tables = (
175         'table' => 'Font::TTF::Table',
176         'EBDT' => 'Font::TTF::EBDT',
177         'EBLC' => 'Font::TTF::EBLC',
178         'Feat' => 'Font::TTF::GrFeat',
179         'GDEF' => 'Font::TTF::GDEF',
180         'GPOS' => 'Font::TTF::GPOS',
181         'GSUB' => 'Font::TTF::GSUB',
182         'LTSH' => 'Font::TTF::LTSH',
183         'OS/2' => 'Font::TTF::OS_2',
184         'PCLT' => 'Font::TTF::PCLT',
185         'Sill' => 'Font::TTF::Sill',
186         'bsln' => 'Font::TTF::Bsln',
187         'cmap' => 'Font::TTF::Cmap',
188         'cvt ' => 'Font::TTF::Cvt_',
189         'fdsc' => 'Font::TTF::Fdsc',
190         'feat' => 'Font::TTF::Feat',
191         'fmtx' => 'Font::TTF::Fmtx',
192         'fpgm' => 'Font::TTF::Fpgm',
193         'glyf' => 'Font::TTF::Glyf',
194         'hdmx' => 'Font::TTF::Hdmx',
195         'head' => 'Font::TTF::Head',
196         'hhea' => 'Font::TTF::Hhea',
197         'hmtx' => 'Font::TTF::Hmtx',
198         'kern' => 'Font::TTF::Kern',
199         'loca' => 'Font::TTF::Loca',
200         'maxp' => 'Font::TTF::Maxp',
201         'mort' => 'Font::TTF::Mort',
202         'name' => 'Font::TTF::Name',
203         'post' => 'Font::TTF::Post',
204         'prep' => 'Font::TTF::Prep',
205         'prop' => 'Font::TTF::Prop',
206         'vhea' => 'Font::TTF::Vhea',
207         'vmtx' => 'Font::TTF::Vmtx',
208           );
209
210 # This is special code because I am fed up of every time I x a table in the debugger
211 # I get the whole font printed. Thus substitutes my 3 line change to dumpvar into
212 # the debugger. Clunky, but nice. You are welcome to a copy if you want one.
213           
214 BEGIN {
215     my ($p);
216
217     foreach $p (@INC)
218     {
219         if (-f "$p/mydumpvar.pl")
220         {
221             $dumper = 'mydumpvar.pl';
222             last;
223         }
224     }
225     $dumper ||= 'dumpvar.pl';
226 }
227
228 sub main::dumpValue
229 { do $dumper; &main::dumpValue; }
230     
231
232 =head2 Font::TTF::Font->AddTable($tablename, $class)
233
234 Adds the given class to be used when representing the given table name. It also
235 'requires' the class for you.
236
237 =cut
238
239 sub AddTable
240 {
241     my ($class, $table, $useclass) = @_;
242
243     $tables{$table} = $useclass;
244 #    $useclass =~ s|::|/|oig;
245 #    require "$useclass.pm";
246 }
247
248
249 =head2 Font::TTF::Font->Init
250
251 For those people who like making fonts without reading them. This subroutine
252 will require all the table code for the various table types for you. Not
253 needed if using Font::TTF::Font::read before using a table.
254
255 =cut
256
257 sub Init
258 {
259     my ($class) = @_;
260     my ($t);
261
262     foreach $t (values %tables)
263     {
264         $t =~ s|::|/|oig;
265         require "$t.pm";
266     }
267 }
268
269 =head2 Font::TTF::Font->new(%props)
270
271 Creates a new font object and initialises with the given properties. This is
272 primarily for use when a TTF is embedded somewhere. Notice that the properties
273 are automatically preceded by a space when inserted into the object. This is in
274 order that fields do not clash with tables.
275
276 =cut
277
278 sub new
279 {
280     my ($class, %props) = @_;
281     my ($self) = {};
282
283     bless $self, $class;
284
285     foreach (keys %props)
286     { $self->{" $_"} = $props{$_}; }
287     $self;
288 }
289
290
291 =head2 Font::TTF::Font->open($fname)
292
293 Reads the header and directory for the given font file and creates appropriate
294 objects for each table in the font.
295
296 =cut
297
298 sub open
299 {
300     my ($class, $fname) = @_;
301     my ($fh);
302     my ($self) = {};
303     
304     unless (ref($fname))
305     {
306         $fh = IO::File->new($fname) or return undef;
307         binmode $fh;
308     } else
309     { $fh = $fname; }
310
311     $self->{' INFILE'} = $fh;
312     $self->{' fname'} = $fname;
313     $self->{' OFFSET'} = 0;
314     bless $self, $class;
315     
316     $self->read;
317 }
318
319 =head2 $f->read
320
321 Reads a Truetype font directory starting from the current location in the file.
322 This has been separated from the C<open> function to allow support for embedded
323 TTFs for example in TTCs. Also reads the C<head> and C<maxp> tables immediately.
324
325 =cut
326
327 sub read
328 {
329     my ($self) = @_;
330     my ($fh) = $self->{' INFILE'};
331     my ($dat, $i, $ver, $dir_num, $type, $name, $check, $off, $len, $t);
332
333     $fh->seek($self->{' OFFSET'}, 0);
334     $fh->read($dat, 12);
335     ($ver, $dir_num) = unpack("Nn", $dat);
336     $ver == 1 << 16 || $ver == unpack('N', 'OTTO') || $ver == 0x74727565 or return undef;  # support Mac sfnts
337     
338     for ($i = 0; $i < $dir_num; $i++)
339     {
340         $fh->read($dat, 16) || die "Reading table entry";
341         ($name, $check, $off, $len) = unpack("a4NNN", $dat);
342         $self->{$name} = $self->{' PARENT'}->find($self, $name, $check, $off, $len) && next
343                 if (defined $self->{' PARENT'});
344         $type = $tables{$name} || 'Font::TTF::Table';
345         $t = $type;
346         if ($^O eq "MacOS")
347         { $t =~ s/^|::/:/oig; }
348         else
349         { $t =~ s|::|/|oig; }
350         require "$t.pm";
351         $self->{$name} = $type->new(PARENT  => $self,
352                                     NAME    => $name,
353                                     INFILE  => $fh,
354                                     OFFSET  => $off,
355                                     LENGTH  => $len,
356                                     CSUM    => $check);
357     }
358     
359     foreach $t ('head', 'maxp')
360     { $self->{$t}->read if defined $self->{$t}; }
361
362     $self;
363 }
364
365
366 =head2 $f->out($fname [, @tablelist])
367
368 Writes a TTF file consisting of the tables in tablelist. The list is checked to
369 ensure that only tables that exist are output. (This means that you can't have
370 non table information stored in the font object with key length of exactly 4)
371
372 In many cases the user simply wants to output all the tables in alphabetical order.
373 This can be done by not including a @tablelist, in which case the subroutine will
374 output all the defined tables in the font in alphabetical order.
375
376 Returns $f on success and undef on failure, including warnings.
377
378 All output files must include the C<head> table.
379
380 =cut
381
382 sub out
383 {
384     my ($self, $fname, @tlist) = @_;
385     my ($fh);
386     my ($dat, $numTables, $sRange, $eSel);
387     my (%dir, $k, $mloc, $count);
388     my ($csum, $lsum, $msum, $loc, $oldloc, $len, $shift);
389
390     unless (ref($fname))
391     {
392         $fh = IO::File->new("+>$fname") || return warn("Unable to open $fname for writing"), undef;
393         binmode $fh;
394     } else
395     { $fh = $fname; }
396     
397     $self->{' oname'} = $fname;
398     $self->{' outfile'} = $fh;
399
400     if ($self->{' wantsig'})
401     {
402         $self->{' nocsum'} = 1;
403 #        $self->{'head'}{'checkSumAdjustment'} = 0;
404         $self->{' tempDSIG'} = $self->{'DSIG'};
405         $self->{' tempcsum'} = $self->{'head'}{' CSUM'};
406         delete $self->{'DSIG'};
407         @tlist = sort {$self->{$a}{' OFFSET'} <=> $self->{$b}{' OFFSET'}}
408             grep (length($_) == 4 && defined $self->{$_}, keys %$self) if ($#tlist < 0);
409     }
410     elsif ($#tlist < 0)
411     { @tlist = sort keys %$self; }
412     
413     @tlist = grep(length($_) == 4 && defined $self->{$_}, @tlist);
414     $numTables = $#tlist + 1;
415     $numTables++ if ($self->{' wantsig'});
416     
417     ($numTables, $sRange, $eSel, $shift) = Font::TTF::Utils::TTF_bininfo($numTables, 16);
418     $dat = pack("Nnnnn", 1 << 16, $numTables, $sRange, $eSel, $shift);
419     $fh->print($dat);
420     $msum = unpack("%32N*", $dat);
421
422 # reserve place holders for each directory entry
423     foreach $k (@tlist)
424     {
425         $dir{$k} = pack("A4NNN", $k, 0, 0, 0);
426         $fh->print($dir{$k});
427     }
428
429     $fh->print(pack('A4NNN', '', 0, 0, 0)) if ($self->{' wantsig'});
430
431     $loc = $fh->tell();
432     if ($loc & 3)
433     {
434         $fh->print(substr("\000" x 4, $loc & 3));
435         $loc += 4 - ($loc & 3);
436     }
437
438     foreach $k (@tlist)
439     {
440         $oldloc = $loc;
441         $self->{$k}->out($fh);
442         $loc = $fh->tell();
443         $len = $loc - $oldloc;
444         if ($loc & 3)
445         {
446             $fh->print(substr("\000" x 4, $loc & 3));
447             $loc += 4 - ($loc & 3);
448         }
449         $fh->seek($oldloc, 0);
450         $csum = 0; $mloc = $loc;
451         while ($mloc > $oldloc)
452         {
453             $count = ($mloc - $oldloc > 4096) ? 4096 : $mloc - $oldloc;
454             $fh->read($dat, $count);
455             $csum += unpack("%32N*", $dat);
456 # this line ensures $csum stays within 32 bit bounds, clipping as necessary
457             if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum--; }
458             $mloc -= $count;
459         }
460         $dir{$k} = pack("A4NNN", $k, $csum, $oldloc, $len);
461         $msum += $csum + unpack("%32N*", $dir{$k});
462         while ($msum > 0xffffffff) { $msum -= 0xffffffff; $msum--; }
463         $fh->seek($loc, 0);
464     }
465
466     unless ($self->{' nocsum'})             # assuming we want a file checksum
467     {
468 # Now we need to sort out the head table's checksum
469         if (!defined $dir{'head'})
470         {                                   # you have to have a head table
471             $fh->close();
472             return warn("No 'head' table to output in $fname"), undef;
473         }
474         ($csum, $loc, $len) = unpack("x4NNN", $dir{'head'});
475         $fh->seek($loc + 8, 0);
476         $fh->read($dat, 4);
477         $lsum = unpack("N", $dat);
478         if ($lsum != 0)
479         {
480             $csum -= $lsum;
481             if ($csum < 0) { $csum += 0xffffffff; $csum++; }
482             $msum -= $lsum * 2;                     # twice (in head and in csum)
483             while ($msum < 0) { $msum += 0xffffffff; $msum++; }
484         }
485         $lsum = 0xB1B0AFBA - $msum;
486         $fh->seek($loc + 8, 0);
487         $fh->print(pack("N", $lsum));
488         $dir{'head'} = pack("A4NNN", 'head', $csum, $loc, $len);
489     } elsif ($self->{' wantsig'})
490     {
491         if (!defined $dir{'head'})
492         {                                   # you have to have a head table
493             $fh->close();
494             return warn("No 'head' table to output in $fname"), undef;
495         }
496         ($csum, $loc, $len) = unpack("x4NNN", $dir{'head'});
497         $fh->seek($loc + 8, 0);
498         $fh->print(pack("N", 0));
499 #        $dir{'head'} = pack("A4NNN", 'head', $self->{' tempcsum'}, $loc, $len);
500     }
501
502 # Now we can output the directory again
503     if ($self->{' wantsig'})
504     { @tlist = sort @tlist; }
505     $fh->seek(12, 0);
506     foreach $k (@tlist)
507     { $fh->print($dir{$k}); }
508     $fh->print(pack('A4NNN', '', 0, 0, 0)) if ($self->{' wantsig'});
509     $fh->close();
510     $self;
511 }
512
513
514 =head2 $f->out_xml($filename [, @tables])
515
516 Outputs the font in XML format
517
518 =cut
519
520 sub out_xml
521 {
522     my ($self, $fname, @tlist) = @_;
523     my ($fh, $context, $numTables, $k);
524
525     $context->{'indent'} = ' ' x 4;
526
527     unless (ref($fname))
528     {
529         $fh = IO::File->new("+>$fname") || return warn("Unable to open $fname"), undef;
530         binmode $fh;
531     } else
532     { $fh = $fname; }
533
534     unless (scalar @tlist > 0)
535     {
536         @tlist = sort keys %$self;
537         @tlist = grep(length($_) == 4 && defined $self->{$_}, @tlist);
538     }
539     $numTables = $#tlist + 1;
540
541     $context->{'fh'} = $fh;
542     $fh->print("<?xml version='1.0' encoding='UTF-8'?>\n");
543     $fh->print("<font tables='$numTables'>\n\n");
544     
545     foreach $k (@tlist)
546     {
547         $fh->print("<table name='$k'>\n");
548         $self->{$k}->out_xml($context, $context->{'indent'});
549         $fh->print("</table>\n");
550     }
551
552     $fh->print("</font>\n");
553     $fh->close;
554     $self;
555 }
556
557
558 =head2 $f->XML_start($context, $tag, %attrs)
559
560 Handles start messages from the XML parser. Of particular interest to us are <font> and
561 <table>.
562
563 =cut
564
565 sub XML_start
566 {
567     my ($self, $context, $tag, %attrs) = @_;
568     my ($name, $type, $t);
569
570     if ($tag eq 'font')
571     { $context->{'tree'}[-1] = $self; }
572     elsif ($tag eq 'table')
573     {
574         $name = $attrs{'name'};
575         unless (defined $self->{$name})
576         {
577             $type = $tables{$name} || 'Font::TTF::Table';
578             $t = $type;
579             if ($^O eq "MacOS")
580             { $t =~ s/^|::/:/oig; }
581             else
582             { $t =~ s|::|/|oig; }
583             require "$t.pm";
584             $self->{$name} = $type->new('PARENT' => $self, 'NAME' => $name, 'read' => 1);
585         }
586         $context->{'receiver'} = ($context->{'tree'}[-1] = $self->{$name});
587     }
588     $context;
589 }
590
591
592 sub XML_end
593 {
594     my ($self) = @_;
595     my ($context, $tag, %attrs) = @_;
596     my ($i);
597
598     return undef unless ($tag eq 'table' && $attrs{'name'} eq 'loca');
599     if (defined $context->{'glyphs'} && $context->{'glyphs'} ne $self->{'loca'}{'glyphs'})
600     {
601         for ($i = 0; $i <= $#{$context->{'glyphs'}}; $i++)
602         { $self->{'loca'}{'glyphs'}[$i] = $context->{'glyphs'}[$i] if defined $context->{'glyphs'}[$i]; }
603         $context->{'glyphs'} = $self->{'loca'}{'glyphs'};
604     }
605     return undef;
606 }
607
608 =head2 $f->update
609
610 Sends update to all the tables in the font and then resets all the isDirty
611 flags on each table. The data structure in now consistent as a font (we hope).
612
613 =cut
614
615 sub update
616 {
617     my ($self) = @_;
618     
619     $self->tables_do(sub { $_[0]->update; });
620
621     $self;
622 }
623
624 =head2 $f->dirty
625
626 Dirties all the tables in the font
627
628 =cut
629
630 sub dirty
631 { $_[0]->tables_do(sub { $_[0]->dirty; }); $_[0]; }
632
633 =head2 $f->tables_do(&func [, tables])
634
635 Calls &func for each table in the font. Calls the table in alphabetical sort
636 order as per the order in the directory:
637
638     &func($table, $name);
639
640 May optionally take a list of table names in which case func is called
641 for each of them in the given order.
642 =cut
643
644 sub tables_do
645 {
646     my ($self, $func, @tables) = @_;
647     my ($t);
648
649     foreach $t (@tables ? @tables : sort grep {length($_) == 4} keys %$self)
650     { &$func($self->{$t}, $t); }
651     $self;
652 }
653
654
655 =head2 $f->release
656
657 Releases ALL of the memory used by the TTF font and all of its component
658 objects.  After calling this method, do B<NOT> expect to have anything left in
659 the C<Font::TTF::Font> object.
660
661 B<NOTE>, that it is important that you call this method on any
662 C<Font::TTF::Font> object when you wish to destruct it and free up its memory.
663 Internally, we track things in a structure that can result in circular
664 references, and without calling 'C<release()>' these will not properly get
665 cleaned up by Perl.  Once you've called this method, though, don't expect to be
666 able to do anything else with the C<Font::TTF::Font> object; it'll have B<no>
667 internal state whatsoever.
668
669 B<Developer note:> As part of the brute-force cleanup done here, this method
670 will throw a warning message whenever unexpected key values are found within
671 the C<Font::TTF::Font> object.  This is done to help ensure that any unexpected
672 and unfreed values are brought to your attention so that you can bug us to keep
673 the module updated properly; otherwise the potential for memory leaks due to
674 dangling circular references will exist.  
675
676 =cut
677
678 sub release
679 {
680     my ($self) = @_;
681
682 # delete stuff that we know we can, here
683
684     my @tofree = map { delete $self->{$_} } keys %{$self};
685
686     while (my $item = shift @tofree)
687     {
688         my $ref = ref($item);
689         if (UNIVERSAL::can($item, 'release'))
690         { $item->release(); }
691         elsif ($ref eq 'ARRAY')
692         { push( @tofree, @{$item} ); }
693         elsif (UNIVERSAL::isa($ref, 'HASH'))
694         { release($item); }
695     }
696
697 # check that everything has gone - it better had!
698     foreach my $key (keys %{$self})
699     { warn ref($self) . " still has '$key' key left after release.\n"; }
700 }
701
702 1;
703
704 =head1 BUGS
705
706 Bugs abound aplenty I am sure. There is a lot of code here and plenty of scope.
707 The parts of the code which haven't been implemented yet are:
708
709 =over 4
710
711 =item Post
712
713 Version 4 format types are not supported yet.
714
715 =item Cmap
716
717 Format type 2 (MBCS) has not been implemented yet and therefore may cause
718 somewhat spurious results for this table type.
719
720 =item Kern
721
722 Only type 0 & type 2 tables are supported (type 1 & type 3 yet to come).
723
724 =item TTC
725
726 The current Font::TTF::Font::out method does not support the writing of TrueType
727 Collections.
728
729 =back
730
731 In addition there are weaknesses or features of this module library
732
733 =over 4
734
735 =item *
736
737 There is very little (or no) error reporting. This means that if you have
738 garbled data or garbled data structures, then you are liable to generate duff
739 fonts.
740
741 =item *
742
743 The exposing of the internal data structures everywhere means that doing
744 radical re-structuring is almost impossible. But it stop the code from becoming
745 ridiculously large.
746
747 =back
748
749 Apart from these, I try to keep the code in a state of "no known bugs", which
750 given the amount of testing this code has had, is not a guarantee of high
751 quality, yet.
752
753 For more details see the appropriate class files.
754
755 =head1 AUTHOR
756
757 Martin Hosken Martin_Hosken@sil.org
758
759 Copyright Martin Hosken 1998.
760
761 No warranty or expression of effectiveness, least of all regarding anyone's
762 safety, is implied in this software or documentation.
763
764 =head2 Licensing
765
766 The Perl TTF module is licensed under the Perl Artistic License.
767