view release on metacpan or  search on metacpan

lib/Font/TTF/Font.pm  view on Meta::CPAN

}


=head2 $f->XML_start($context, $tag, %attrs)

Handles start messages from the XML parser. Of particular interest to us are <font> and
<table>.

=cut

sub XML_start
{
    my ($self, $context, $tag, %attrs) = @_;
    my ($name, $type, $t);

    if ($tag eq 'font')
    { $context->{'tree'}[-1] = $self; }
    elsif ($tag eq 'table')
    {
        $name = $attrs{'name'};
        unless (defined $self->{$name})
        {
            $type = $tables{$name} || 'Font::TTF::Table';
            $t = $type;
            if ($^O eq "MacOS")
            { $t =~ s/^|::/:/oig; }
            else
            { $t =~ s|::|/|oig; }
            require "$t.pm";
            $self->{$name} = $type->new('PARENT' => $self, 'NAME' => $name, 'read' => 1);
        }
        $context->{'receiver'} = ($context->{'tree'}[-1] = $self->{$name});
    }
    $context;
}


sub XML_end
{
    my ($self) = @_;
    my ($context, $tag, %attrs) = @_;
    my ($i);

    return undef unless ($tag eq 'table' && $attrs{'name'} eq 'loca');
    if (defined $context->{'glyphs'} && $context->{'glyphs'} ne $self->{'loca'}{'glyphs'})
    {
        for ($i = 0; $i <= $#{$context->{'glyphs'}}; $i++)
        { $self->{'loca'}{'glyphs'}[$i] = $context->{'glyphs'}[$i] if defined $context->{'glyphs'}[$i]; }
        $context->{'glyphs'} = $self->{'loca'}{'glyphs'};
    }
    return undef;
}

=head2 $f->update

Sends update to all the tables in the font and then resets all the isDirty
flags on each table. The data structure in now consistent as a font (we hope).

=cut

sub update
{
    my ($self) = @_;
    
    $self->tables_do(sub { $_[0]->update; });

    $self;
}

=head2 $f->dirty

Dirties all the tables in the font

=cut

sub dirty
{ $_[0]->tables_do(sub { $_[0]->dirty; }); $_[0]; }

=head2 $f->tables_do(&func [, tables])

Calls &func for each table in the font. Calls the table in alphabetical sort
order as per the order in the directory:

    &func($table, $name);

May optionally take a list of table names in which case func is called
for each of them in the given order.

=cut

sub tables_do
{
    my ($self, $func, @tables) = @_;
    my ($t);

    foreach $t (@tables ? @tables : sort grep {length($_) == 4} keys %$self)
    { &$func($self->{$t}, $t); }
    $self;
}


=head2 $f->release

Releases ALL of the memory used by the TTF font and all of its component
objects.  After calling this method, do B<NOT> expect to have anything left in
the C<Font::TTF::Font> object.

B<NOTE>, that it is important that you call this method on any
C<Font::TTF::Font> object when you wish to destruct it and free up its memory.
Internally, we track things in a structure that can result in circular
references, and without calling 'C<release()>' these will not properly get
cleaned up by Perl.  Once you've called this method, though, don't expect to be
able to do anything else with the C<Font::TTF::Font> object; it'll have B<no>
internal state whatsoever.

B<Developer note:> As part of the brute-force cleanup done here, this method
will throw a warning message whenever unexpected key values are found within
the C<Font::TTF::Font> object.  This is done to help ensure that any unexpected
and unfreed values are brought to your attention so that you can bug us to keep
the module updated properly; otherwise the potential for memory leaks due to
dangling circular references will exist.