also dont add tuples to lists sleepy man.
[librarian.git] / librarian / font-optimizer / ext / Font-TTF / lib / Font / TTF / Glyph.pm
1 package Font::TTF::Glyph;
2
3 =head1 NAME
4
5 Font::TTF::Glyph - Holds a single glyph's information
6
7 =head1 DESCRIPTION
8
9 This is a single glyph description as held in a TT font. On creation only its
10 header is read. Thus you can get the bounding box of each glyph without having
11 to read all the other information.
12
13 =head1 INSTANCE VARIABLES
14
15 In addition to the named variables in a glyph header (C<xMin> etc.), there are
16 also all capital instance variables for holding working information, mostly
17 from the location table.
18
19 The standard attributes each glyph has are:
20
21  numberOfContours
22  xMin
23  yMin
24  xMax
25  yMax
26
27 There are also other, derived, instance variables for each glyph which are read
28 when the whole glyph is read (via C<read_dat>):
29
30 =over 4
31
32 =item instLen
33
34 Number of bytes in the hinting instructions (Warning this variable is deprecated,
35 use C<length($g->{'hints'})> instead).
36
37 =item hints
38
39 The string containing the hinting code for the glyph
40
41 =back
42
43 In addition there are other attribute like instance variables for simple glyphs:
44
45 =over 4
46
47 For each contour there is:
48
49 =over 4
50
51 =item endPoints
52
53 An array of endpoints for each contour in the glyph. There are
54 C<numberOfContours> contours in a glyph. The number of points in a glyph is
55 equal to the highest endpoint of a contour.
56
57 =back
58
59 There are also a number of arrays indexed by point number
60
61 =over 4
62
63 =item flags
64
65 The flags associated with reading this point. The flags for a point are
66 recalculated for a point when it is C<update>d. Thus the flags are not very
67 useful. The only important bit is bit 0 which indicates whether the point is
68 an 'on' curve point, or an 'off' curve point.
69
70 =item x
71
72 The absolute x co-ordinate of the point.
73
74 =item y
75
76 The absolute y co-ordinate of the point
77
78 =back
79
80 =back
81
82 For composite glyphs there are other variables
83
84 =over 4
85
86 =item metric
87
88 This holds the component number (not its glyph number) of the component from
89 which the metrics for this glyph should be taken.
90
91 =item comps
92
93 This is an array of hashes for each component. Each hash has a number of
94 elements:
95
96 =over 4
97
98 =item glyph
99
100 The glyph number of the glyph which comprises this component of the composite.
101 NOTE: In some badly generated fonts, C<glyph> may contain a numerical value
102 but that glyph might not actually exist in the font file.  This could
103 occur in any glyph, but is particularly likely for glyphs that have
104 no strokes, such as SPACE, U+00A0 NO-BREAK SPACE, or 
105 U+200B ZERO WIDTH SPACE.
106
107 =item args
108
109 An array of two arguments which may be an x, y co-ordinate or two attachment
110 points (one on the base glyph the other on the component). See flags for details.
111
112 =item flag
113
114 The flag for this component
115
116 =item scale
117
118 A 4 number array for component scaling. This allows stretching, rotating, etc.
119 Note that scaling applies to placement co-ordinates (rather than attachment points)
120 before locating rather than after.
121
122 =back
123
124 =item numPoints
125
126 This is a generated value which contains the number of components read in for this
127 compound glyph.
128
129 =back
130
131 The private instance variables are:
132
133 =over 4
134
135 =item INFILE (P)
136
137 The input file form which to read any information
138
139 =item LOC (P)
140
141 Location relative to the start of the glyf table in the read file
142
143 =item BASE (P)
144
145 The location of the glyf table in the read file
146
147 =item LEN (P)
148
149 This is the number of bytes required by the glyph. It should be kept up to date
150 by calling the C<update> method whenever any of the glyph content changes.
151
152 =item OUTLOC (P)
153
154 Location relative to the start of the glyf table. This variable is only active
155 whilst the output process is going on. It is used to inform the location table
156 where the glyph's location is, since the glyf table is output before the loca
157 table due to alphabetical ordering.
158
159 =item OUTLEN (P)
160
161 This indicates the length of the glyph data when it is output. This more
162 accurately reflects the internal memory form than the C<LEN> variable which
163 only reflects the read file length. The C<OUTLEN> variable is only set after
164 calling C<out> or C<out_dat>.
165
166 =back
167
168 =head2 Editing
169
170 If you want to edit a glyph in some way, then you should read_dat the glyph, then
171 make your changes and then update the glyph or set the $g->{' isdirty'} variable.
172 It is the application's duty to ensure that the following instance variables are
173 correct, from which update will calculate the rest, including the bounding box
174 information.
175
176     numPoints
177     numberOfContours
178     endPoints
179     x, y, flags         (only flags bit 0)
180     instLen
181     hints
182
183 For components, the numPoints, x, y, endPoints & flags are not required but
184 the following information is required for each component.
185
186     flag                (bits 2, 10, 11, 12)
187     glyph
188     args
189     scale
190     metric              (glyph instance variable)
191     
192
193 =head1 METHODS
194
195 =cut
196
197 use strict;
198 use vars qw(%fields @field_info);
199 use Font::TTF::Utils;
200 use Font::TTF::Table;
201
202 @field_info = (
203     'numberOfContours' => 's', 
204     'xMin' => 's', 
205     'yMin' => 's',
206     'xMax' => 's',
207     'yMax' => 's');
208
209 sub init
210 {
211     my ($k, $v, $c, $i);
212     for ($i = 0; $i < $#field_info; $i += 2)
213     {
214         ($k, $v, $c) = TTF_Init_Fields($field_info[$i], $c, $field_info[$i + 1]);
215         next unless defined $k && $k ne "";
216         $fields{$k} = $v;
217     }
218 }
219
220
221 =head1 Font::TTF::Glyph->new(%parms)
222
223 Creates a new glyph setting various instance variables
224
225 =cut
226
227 sub new
228 {
229     my ($class, %parms) = @_;
230     my ($self) = {};
231     my ($p);
232
233     bless $self, $class;
234     foreach $p (keys %parms)
235     { $self->{" $p"} = $parms{$p}; }
236     init unless defined $fields{'xMin'};
237     $self;
238 }
239
240
241 =head2 $g->read
242
243 Reads the header component of the glyph (bounding box, etc.) and also the
244 glyph content, but into a data field rather than breaking it down into
245 its constituent structures. Use read_dat for this.
246
247 =cut
248
249 sub read
250 {
251     my ($self) = @_;
252     my ($fh) = $self->{' INFILE'};
253     my ($dat);
254
255     return $self if $self->{' read'};
256     $self->{' read'} = 1;
257     $fh->seek($self->{' LOC'} + $self->{' BASE'}, 0);
258     $fh->read($self->{' DAT'}, $self->{' LEN'});
259     TTF_Read_Fields($self, $self->{' DAT'}, \%fields);
260     $self;
261 }
262
263
264 =head2 $g->read_dat
265
266 Reads the contents of the glyph (components and curves, etc.) from the memory
267 store C<DAT> into structures within the object. Then, to indicate where the
268 master form of the data is, it deletes the C<DAT> instance variable.
269
270 =cut
271
272 sub read_dat
273 {
274     my ($self) = @_;
275     my ($dat, $num, $max, $i, $flag, $len, $val, $val1, $fp);
276
277     return $self if (defined $self->{' read'} && $self->{' read'} > 1);
278     $self->read unless $self->{' read'};
279     $dat = $self->{' DAT'};
280     $fp = 10;
281     $num = $self->{'numberOfContours'};
282     if ($num > 0)
283     {
284         $self->{'endPoints'} = [unpack("n*", substr($dat, $fp, $num << 1))];
285         $fp += $num << 1;
286         $max = 0;
287         foreach (@{$self->{'endPoints'}})
288         { $max = $_ if $_ > $max; }
289 #        print STDERR join(",", unpack('C*', $self->{" DAT"}));
290 #        printf STDERR ("(%d,%d in %d=%d @ %d)", scalar @{$self->{'endPoints'}}, $max, length($dat), $self->{' LEN'}, $fp);
291         $max++ if (@{$self->{'endPoints'}});
292         $self->{'numPoints'} = $max;
293         $self->{'instLen'} = unpack("n", substr($dat, $fp));
294         $self->{'hints'} = substr($dat, $fp + 2, $self->{'instLen'});
295         $fp += 2 + $self->{'instLen'};
296 # read the flags array
297         for ($i = 0; $i < $max; $i++)                   
298         {
299             $flag = unpack("C", substr($dat, $fp++));
300             $self->{'flags'}[$i] = $flag;
301             if ($flag & 8)
302             {
303                 $len = unpack("C", substr($dat, $fp++));
304                 while ($len-- > 0)
305                 {
306                     $i++;
307                     $self->{'flags'}[$i] = $flag;
308                 }
309             }
310         }
311 #read the x array
312         for ($i = 0; $i < $max; $i++)
313         {
314             $flag = $self->{'flags'}[$i];
315             if ($flag & 2)
316             {
317                 $val = unpack("C", substr($dat, $fp++));
318                 $val = -$val unless ($flag & 16);
319             } elsif ($flag & 16)
320             { $val = 0; }
321             else
322             {
323                 $val = TTF_Unpack("s", substr($dat, $fp));
324                 $fp += 2;
325             }
326             $self->{'x'}[$i] = $i == 0 ? $val : $self->{'x'}[$i - 1] + $val;
327         }
328 #read the y array
329         for ($i = 0; $i < $max; $i++)
330         {
331             $flag = $self->{'flags'}[$i];
332             if ($flag & 4)
333             {
334                 $val = unpack("C", substr($dat, $fp++));
335                 $val = -$val unless ($flag & 32);
336             } elsif ($flag & 32)
337             { $val = 0; }
338             else
339             {
340                 $val = TTF_Unpack("s", substr($dat, $fp));
341                 $fp += 2;
342             }
343             $self->{'y'}[$i] = $i == 0 ? $val : $self->{'y'}[$i - 1] + $val;
344         }
345     }
346     
347 # compound glyph
348     elsif ($num < 0)
349     {
350         $flag = 1 << 5;             # cheat to get the loop going
351         for ($i = 0; $flag & 32; $i++)
352         {
353             ($flag, $self->{'comps'}[$i]{'glyph'}) = unpack("n2", substr($dat, $fp));
354             $fp += 4;
355             $self->{'comps'}[$i]{'flag'} = $flag;
356             if ($flag & 1)              # ARGS1_AND_2_ARE_WORDS
357             {
358                 $self->{'comps'}[$i]{'args'} = [TTF_Unpack("s2", substr($dat, $fp))];
359                 $fp += 4;
360             } else
361             {
362                 $self->{'comps'}[$i]{'args'} = [unpack("c2", substr($dat, $fp))];
363                 $fp += 2;
364             }
365             
366             if ($flag & 8)
367             {
368                 $val = TTF_Unpack("F", substr($dat, $fp));
369                 $fp += 2;
370                 $self->{'comps'}[$i]{'scale'} = [$val, 0, 0, $val];
371             } elsif ($flag & 64)
372             {
373                 ($val, $val1) = TTF_Unpack("F2", substr($dat, $fp));
374                 $fp += 4;
375                 $self->{'comps'}[$i]{'scale'} = [$val, 0, 0, $val1];
376             } elsif ($flag & 128)
377             {
378                 $self->{'comps'}[$i]{'scale'} = [TTF_Unpack("F4", substr($dat, $fp))];
379                 $fp += 8;
380             }
381             $self->{'metric'} = $i if ($flag & 512);
382         }
383         $self->{'numPoints'} = $i;
384         if ($flag & 256)            # HAVE_INSTRUCTIONS
385         {
386             $self->{'instLen'} = unpack("n", substr($dat, $fp));
387             $self->{'hints'} = substr($dat, $fp + 2, $self->{'instLen'});
388             $fp += 2 + $self->{'instLen'};
389         }
390     }
391     return undef if ($fp > length($dat));
392     $self->{' read'} = 2;
393     $self;
394 }
395
396
397 =head2 $g->out($fh)
398
399 Writes the glyph data to outfile
400
401 =cut
402
403 sub out
404 {
405     my ($self, $fh) = @_;
406
407     $self->read unless $self->{' read'};
408     $self->update if $self->{' isDirty'};
409     $fh->print($self->{' DAT'});
410     $self->{' OUTLEN'} = length($self->{' DAT'});
411     $self;
412 }
413
414
415 =head2 $g->out_xml($context, $depth)
416
417 Outputs an XML description of the glyph
418
419 =cut
420
421 sub out_xml
422 {
423     my ($self, $context, $depth) = @_;
424     my ($addr) = ($self =~ m/\((.+)\)$/o);
425     my ($k, $ndepth);
426
427     if ($context->{'addresses'}{$addr})
428     {
429         $context->{'fh'}->printf("%s<glyph gid='%s' id_ref='%s'/>\n", $depth, $context->{'gid'}, $addr);
430         return $self;
431     }
432     else
433     {
434         $context->{'fh'}->printf("%s<glyph gid='%s' id='%s'>\n", $depth, $context->{'gid'}, $addr);
435     }
436     
437     $ndepth = $depth . $context->{'indent'};
438     $self->read_dat;
439     foreach $k (sort grep {$_ !~ m/^\s/o} keys %{$self})
440     {
441         $self->XML_element($context, $ndepth, $k, $self->{$k});
442     }
443     $context->{'fh'}->print("$depth</glyph>\n");
444     delete $context->{'done_points'};
445     $self;
446 }
447     
448
449 sub XML_element
450 {
451     my ($self, $context, $depth, $key, $val) = @_;
452     my ($fh) = $context->{'fh'};
453     my ($dind) = $depth . $context->{'indent'};
454     my ($i);
455     
456     if ($self->{'numberOfContours'} >= 0 && ($key eq 'x' || $key eq 'y' || $key eq 'flags'))
457     {
458         return $self if ($context->{'done_points'});
459         $context->{'done_points'} = 1;
460
461         $fh->print("$depth<points>\n");
462         for ($i = 0; $i <= $#{$self->{'flags'}}; $i++)
463         { $fh->printf("%s<point x='%s' y='%s' flags='0x%02X'/>\n", $dind,
464                 $self->{'x'}[$i], $self->{'y'}[$i], $self->{'flags'}[$i]); }
465         $fh->print("$depth</points>\n");
466     }
467     elsif ($key eq 'hints')
468     {
469         my ($dat);
470         $fh->print("$depth<hints>\n");
471 #        Font::TTF::Utils::XML_hexdump($context, $depth . $context->{'indent'}, $self->{'hints'});
472         $dat = Font::TTF::Utils::XML_binhint($self->{'hints'}) || "";
473         $dat =~ s/\n(?!$)/\n$depth$context->{'indent'}/mg;
474         $fh->print("$depth$context->{'indent'}$dat");
475         $fh->print("$depth</hints>\n");
476     }
477     else
478     { return Font::TTF::Table::XML_element(@_); }
479
480     $self;    
481 }
482
483
484 =head2 $g->update
485
486 Generates a C<$self->{'DAT'}> from the internal structures, if the data has
487 been read into structures in the first place. If you are building a glyph
488 from scratch you will need to set the instance variable C<' read'> to 2 (or
489 something > 1) for the update to work.
490
491 =cut
492
493 sub update
494 {
495     my ($self) = @_;
496     my ($dat, $loc, $len, $flag, $x, $y, $i, $comp, $num);
497
498     return $self unless (defined $self->{' read'} && $self->{' read'} > 1);
499     $self->update_bbox;
500     $self->{' DAT'} = TTF_Out_Fields($self, \%fields, 10);
501     $num = $self->{'numberOfContours'};
502     if ($num > 0)
503     {
504         $self->{' DAT'} .= pack("n*", @{$self->{'endPoints'}});
505         $len = $self->{'instLen'};
506         $self->{' DAT'} .= pack("n", $len);
507         $self->{' DAT'} .= pack("a" . $len, substr($self->{'hints'}, 0, $len)) if ($len > 0);
508         for ($i = 0; $i < $self->{'numPoints'}; $i++)
509         {
510             $flag = $self->{'flags'}[$i] & 1;
511             if ($i == 0)
512             {
513                 $x = $self->{'x'}[$i];
514                 $y = $self->{'y'}[$i];
515             } else
516             {
517                 $x = $self->{'x'}[$i] - $self->{'x'}[$i - 1];
518                 $y = $self->{'y'}[$i] - $self->{'y'}[$i - 1];
519             }
520             $flag |= 16 if ($x == 0);
521             $flag |= 32 if ($y == 0);
522             if (($flag & 16) == 0 && $x < 256 && $x > -256)
523             {
524                 $flag |= 2;
525                 $flag |= 16 if ($x >= 0);
526             }
527             if (($flag & 32) == 0 && $y < 256 && $y > -256)
528             {
529                 $flag |= 4;
530                 $flag |= 32 if ($y >= 0);
531             }
532             $self->{' DAT'} .= pack("C", $flag);                    # sorry no repeats
533             $self->{'flags'}[$i] = $flag;
534         }
535         for ($i = 0; $i < $self->{'numPoints'}; $i++)
536         {
537             $flag = $self->{'flags'}[$i];
538             $x = $self->{'x'}[$i] - (($i == 0) ? 0 : $self->{'x'}[$i - 1]);
539             if (($flag & 18) == 0)
540             { $self->{' DAT'} .= TTF_Pack("s", $x); }
541             elsif (($flag & 18) == 18)
542             { $self->{' DAT'} .= pack("C", $x); }
543             elsif (($flag & 18) == 2)
544             { $self->{' DAT'} .= pack("C", -$x); }
545         }
546         for ($i = 0; $i < $self->{'numPoints'}; $i++)
547         {
548             $flag = $self->{'flags'}[$i];
549             $y = $self->{'y'}[$i] - (($i == 0) ? 0 : $self->{'y'}[$i - 1]);
550             if (($flag & 36) == 0)
551             { $self->{' DAT'} .= TTF_Pack("s", $y); }
552             elsif (($flag & 36) == 36)
553             { $self->{' DAT'} .= pack("C", $y); }
554             elsif (($flag & 36) == 4)
555             { $self->{' DAT'} .= pack("C", -$y); }
556         }
557     }
558
559     elsif ($num < 0)
560     {
561         for ($i = 0; $i <= $#{$self->{'comps'}}; $i++)
562         {
563             $comp = $self->{'comps'}[$i];
564             $flag = $comp->{'flag'} & 7158;        # bits 2,10,11,12
565             $flag |= 1 unless ($comp->{'args'}[0] > -129 && $comp->{'args'}[0] < 128
566                     && $comp->{'args'}[1] > -129 && $comp->{'args'}[1] < 128);
567             if (defined $comp->{'scale'})
568             {
569                 if ($comp->{'scale'}[1] == 0 && $comp->{'scale'}[2] == 0)
570                 {
571                     if ($comp->{'scale'}[0] == $comp->{'scale'}[3])
572                     { $flag |= 8 unless ($comp->{'scale'}[0] == 0
573                                     || $comp->{'scale'}[0] == 1); }
574                     else
575                     { $flag |= 64; }
576                 } else
577                 { $flag |= 128; }
578             }
579             
580             $flag |= 512 if (defined $self->{'metric'} && $self->{'metric'} == $i);
581             if ($i == $#{$self->{'comps'}})
582             { $flag |= 256 if (defined $self->{'instLen'} && $self->{'instLen'} > 0); }
583             else
584             { $flag |= 32; }
585             
586             $self->{' DAT'} .= pack("n", $flag);
587             $self->{' DAT'} .= pack("n", $comp->{'glyph'});
588             $comp->{'flag'} = $flag;
589
590             if ($flag & 1)
591             { $self->{' DAT'} .= TTF_Pack("s2", @{$comp->{'args'}}); }
592             else
593             { $self->{' DAT'} .= pack("CC", @{$comp->{'args'}}); }
594
595             if ($flag & 8)
596             { $self->{' DAT'} .= TTF_Pack("F", $comp->{'scale'}[0]); }
597             elsif ($flag & 64)
598             { $self->{' DAT'} .= TTF_Pack("F2", $comp->{'scale'}[0], $comp->{'scale'}[3]); }
599             elsif ($flag & 128)
600             { $self->{' DAT'} .= TTF_Pack("F4", @{$comp->{'scale'}}); }
601         }
602         if (defined $self->{'instLen'} && $self->{'instLen'} > 0)
603         {
604             $len = $self->{'instLen'};
605             $self->{' DAT'} .= pack("n", $len);
606             $self->{' DAT'} .= pack("a" . $len, substr($self->{'hints'}, 0, $len));
607         }
608     }
609     my ($olen) = length($self->{' DAT'});
610     $self->{' DAT'} .= ("\000") x (4 - ($olen & 3)) if ($olen & 3);
611     $self->{' OUTLEN'} = length($self->{' DAT'});
612     $self->{' read'} = 2;           # changed from 1 to 2 so we don't read_dat() again
613 # we leave numPoints and instLen since maxp stats use this
614     $self;
615 }
616
617
618 =head2 $g->update_bbox
619
620 Updates the bounding box for this glyph according to the points in the glyph
621
622 =cut
623
624 sub update_bbox
625 {
626     my ($self) = @_;
627     my ($num, $maxx, $minx, $maxy, $miny, $i, $comp, $x, $y, $compg);
628
629     return $self unless $self->{' read'} > 1;       # only if read_dat done
630     $miny = $minx = 65537; $maxx = $maxy = -65537;
631     $num = $self->{'numberOfContours'};
632     if ($num > 0)
633     {
634         for ($i = 0; $i < $self->{'numPoints'}; $i++)
635         {
636             ($x, $y) = ($self->{'x'}[$i], $self->{'y'}[$i]);
637
638             $maxx = $x if ($x > $maxx);
639             $minx = $x if ($x < $minx);
640             $maxy = $y if ($y > $maxy);
641             $miny = $y if ($y < $miny);
642         }
643     }
644
645     elsif ($num < 0)
646     {
647         foreach $comp (@{$self->{'comps'}})
648         {
649             my ($gnx, $gny, $gxx, $gxy);
650             my ($sxx, $sxy, $syx, $syy);
651             
652             my $otherg = $self->{' PARENT'}{'loca'}{'glyphs'}[$comp->{'glyph'}];
653             # work around bad fonts: see documentation for 'comps' above
654             next unless (defined $otherg);
655             $compg = $otherg->read->update_bbox;
656             ($gnx, $gny, $gxx, $gxy) = @{$compg}{'xMin', 'yMin', 'xMax', 'yMax'};
657             if (defined $comp->{'scale'})
658             {
659                 ($sxx, $sxy, $syx, $syy) = @{$comp->{'scale'}};
660                 ($gnx, $gny, $gxx, $gxy) = ($gnx*$sxx+$gny*$syx + $comp->{'args'}[0],
661                                             $gnx*$sxy+$gny*$syy + $comp->{'args'}[1],
662                                             $gxx*$sxx+$gxy*$syx + $comp->{'args'}[0],
663                                             $gxx*$sxy+$gxy*$syy + $comp->{'args'}[1]);
664             } elsif ($comp->{'args'}[0] || $comp->{'args'}[1])
665             {
666                 $gnx += $comp->{'args'}[0];
667                 $gny += $comp->{'args'}[1];
668                 $gxx += $comp->{'args'}[0];
669                 $gxy += $comp->{'args'}[1];
670             }
671             ($gnx, $gxx) = ($gxx, $gnx) if $gnx > $gxx;
672             ($gny, $gxy) = ($gxy, $gny) if $gny > $gxy;
673             $maxx = $gxx if $gxx > $maxx;
674             $minx = $gnx if $gnx < $minx;
675             $maxy = $gxy if $gxy > $maxy;
676             $miny = $gny if $gny < $miny;
677         }
678     }
679     $self->{'xMax'} = $maxx;
680     $self->{'xMin'} = $minx;
681     $self->{'yMax'} = $maxy;
682     $self->{'yMin'} = $miny;
683     $self;
684 }
685
686             
687 =head2 $g->maxInfo
688
689 Returns lots of information about a glyph so that the C<maxp> table can update
690 itself. Returns array containing contributions of this glyph to maxPoints, maxContours, 
691 maxCompositePoints, maxCompositeContours, maxSizeOfInstructions, maxComponentElements, 
692 and maxComponentDepth.
693
694 =cut
695
696 sub maxInfo
697 {
698     my ($self) = @_;
699     my (@res, $i, @n);
700
701     $self->read_dat;            # make sure we've read some data
702     $res[4] = length($self->{'hints'}) if defined $self->{'hints'};
703     $res[6] = 1;
704     if ($self->{'numberOfContours'} > 0)
705     {
706         $res[0] = $self->{'numPoints'};
707         $res[1] = $self->{'numberOfContours'};
708     } elsif ($self->{'numberOfContours'} < 0)
709     {
710         for ($i = 0; $i <= $#{$self->{'comps'}}; $i++)
711         {
712             my $otherg = 
713                 $self->{' PARENT'}{'loca'}{'glyphs'}
714                     [$self->{'comps'}[$i]{'glyph'}];
715             
716             # work around bad fonts: see documentation for 'comps' above
717             next unless (defined $otherg );
718             
719             @n = $otherg->maxInfo;
720
721             $res[2] += $n[2] == 0 ? $n[0] : $n[2];
722             $res[3] += $n[3] == 0 ? $n[1] : $n[3];
723             $res[5]++;
724             $res[6] = $n[6] + 1 if ($n[6] >= $res[6]);
725         }
726     }
727     @res;
728 }
729
730 =head2 $g->empty
731
732 Empties the glyph of all information to the level of not having been read.
733 Useful for saving memory in apps with many glyphs being read
734
735 =cut
736
737 sub empty
738 {
739     my ($self) = @_;
740     my (%keep) = map {(" $_" => 1)} ('LOC', 'OUTLOC', 'PARENT', 'INFILE', 'BASE',
741                                 'OUTLEN', 'LEN');
742     map {delete $self->{$_} unless $keep{$_}} keys %$self;
743     
744     $self;
745 }
746
747
748 =head2 $g->get_points
749
750 This method creates point information for a compound glyph. The information is
751 stored in the same place as if the glyph was not a compound, but since
752 numberOfContours is negative, the glyph is still marked as being a compound
753
754 =cut
755
756 sub get_points
757 {
758     my ($self) = @_;
759     my ($comp, $compg, $nump, $e, $i);
760
761     $self->read_dat;
762     return undef unless ($self->{'numberOfContours'} < 0);
763
764     foreach $comp (@{$self->{'comps'}})
765     {
766         $compg = $self->{' PARENT'}{'loca'}{'glyphs'}[$comp->{'glyph'}];
767         # work around bad fonts: see documentation for 'comps' above
768         next unless (defined $compg );
769         $compg->get_points;
770
771         for ($i = 0; $i < $compg->{'numPoints'}; $i++)
772         {
773             my ($x, $y) = ($compg->{'x'}[$i], $compg->{'y'}[$i]);
774             if (defined $comp->{'scale'})
775             {
776                 ($x, $y) = ($x * $comp->{'scale'}[0] + $y * $comp->{'scale'}[2],
777                             $x * $comp->{'scale'}[1] + $y * $comp->{'scale'}[3]);
778             }
779             if (defined $comp->{'args'})
780             { ($x, $y) = ($x + $comp->{'args'}[0], $y + $comp->{'args'}[1]); }
781             push (@{$self->{'x'}}, $x);
782             push (@{$self->{'y'}}, $y);
783             push (@{$self->{'flags'}}, $compg->{'flags'}[$i]);
784         }
785         foreach $e (@{$compg->{'endPoints'}})
786         { push (@{$self->{'endPoints'}}, $e + $nump); }
787         $nump += $compg->{'numPoints'};
788     }
789     $self->{'numPoints'} = $nump;
790     $self;
791 }
792
793
794 =head2 $g->get_refs
795
796 Returns an array of all the glyph ids that are used to make up this glyph. That
797 is all the compounds and their references and so on. If this glyph is not a
798 compound, then returns an empty array.
799
800 Please note the warning about bad fonts that reference nonexistant glyphs
801 under INSTANCE VARIABLES above.  This function will not attempt to 
802 filter out nonexistant glyph numbers.
803
804 =cut
805
806 sub get_refs
807 {
808     my ($self) = @_;
809     my (@res, $g);
810
811     $self->read_dat;
812     return unless ($self->{'numberOfContours'} < 0);
813     foreach $g (@{$self->{'comps'}})
814     {
815         push (@res, $g->{'glyph'});
816         my $otherg = $self->{' PARENT'}{'loca'}{'glyphs'}[$g->{'glyph'}];
817         # work around bad fonts: see documentation for 'comps' above
818         next unless (defined $otherg);
819         my @list = $otherg->get_refs;
820         push(@res, @list);
821     }
822     return @res;
823 }
824
825 1;
826
827 =head1 BUGS
828
829 =over 4
830
831 =item *
832
833 The instance variables used here are somewhat clunky and inconsistent with
834 the other tables.
835
836 =item *
837
838 C<update> doesn't re-calculate the bounding box or C<numberOfContours>.
839
840 =back
841
842 =head1 AUTHOR
843
844 Martin Hosken Martin_Hosken@sil.org. See L<Font::TTF::Font> for copyright and
845 licensing.
846
847 =cut