Font-TTF

 view release on metacpan or  search on metacpan

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

    

sub XML_element
{
    my ($self, $context, $depth, $key, $val) = @_;
    my ($fh) = $context->{'fh'};
    my ($dind) = $depth . $context->{'indent'};
    my ($i);
    
    if ($self->{'numberOfContours'} >= 0 && ($key eq 'x' || $key eq 'y' || $key eq 'flags'))
    {
        return $self if ($context->{'done_points'});
        $context->{'done_points'} = 1;

        $fh->print("$depth<points>\n");
        for ($i = 0; $i <= $#{$self->{'flags'}}; $i++)
        { $fh->printf("%s<point x='%s' y='%s' flags='0x%02X'/>\n", $dind,
                $self->{'x'}[$i], $self->{'y'}[$i], $self->{'flags'}[$i]); }
        $fh->print("$depth</points>\n");
    }
    elsif ($key eq 'hints')
    {
        my ($dat);
        $fh->print("$depth<hints>\n");
#        Font::TTF::Utils::XML_hexdump($context, $depth . $context->{'indent'}, $self->{'hints'});
        $dat = Font::TTF::Utils::XML_binhint($self->{'hints'}) || "";
        $dat =~ s/\n(?!$)/\n$depth$context->{'indent'}/mg;
        $fh->print("$depth$context->{'indent'}$dat");
        $fh->print("$depth</hints>\n");
    }
    else
    { return Font::TTF::Table::XML_element(@_); }

    $self;    
}

=head2 $g->dirty($val)

This sets the dirty flag to the given value or 1 if no given value. It returns the
value of the flag

=cut

sub dirty
{
    my ($self, $val) = @_;
    my ($res) = $self->{' isDirty'};

    $self->{' isDirty'} = defined $val ? $val : 1;
    $res;
}

=head2 $g->update

Generates a C<$self->{'DAT'}> from the internal structures, if the data has
been read into structures in the first place. If you are building a glyph
from scratch you will need to set the instance variable C<' isDirty'>.

=cut

sub update
{
    my ($self) = @_;
    my ($dat, $loc, $len, $flag, $x, $y, $i, $comp, $num, @rflags, $repeat);

    return $self unless ($self->{' isDirty'});
    $self->read_dat->update_bbox;
    $self->{' DAT'} = TTF_Out_Fields($self, \%fields, 10);
    $num = $self->{'numberOfContours'};
    if ($num > 0)
    {
        $self->{' DAT'} .= pack("n*", @{$self->{'endPoints'}});
        $len = $self->{'instLen'};
        $self->{' DAT'} .= pack("n", $len);
        $self->{' DAT'} .= pack("a" . $len, substr($self->{'hints'}, 0, $len)) if ($len > 0);
        $repeat = 0;
        for ($i = 0; $i < $self->{'numPoints'}; $i++)
        {
            $flag = $self->{'flags'}[$i] & 1;
            if ($i == 0)
            {
                $x = $self->{'x'}[$i];
                $y = $self->{'y'}[$i];
            } else
            {
                $x = $self->{'x'}[$i] - $self->{'x'}[$i - 1];
                $y = $self->{'y'}[$i] - $self->{'y'}[$i - 1];
            }
            $flag |= 16 if ($x == 0);
            $flag |= 32 if ($y == 0);
            if (($flag & 16) == 0 && $x < 256 && $x > -256)
            {
                $flag |= 2;
                $flag |= 16 if ($x >= 0);
            }
            if (($flag & 32) == 0 && $y < 256 && $y > -256)
            {
                $flag |= 4;
                $flag |= 32 if ($y >= 0);
            }
            if ($i > 0 && $rflags[-1] == $flag && $repeat < 255)
            {
                $repeat++;
            } else
            {
                if ($repeat)
                {
                    $rflags[-1] |= 8;
                    push @rflags, $repeat;
                }
                push @rflags, $flag;
                $repeat = 0;
            } 
            $self->{'flags'}[$i] = $flag;
        }
        # Add final repeat if needed, then pack up the flag bytes:
        if ($repeat)
        {
            $rflags[-1] |= 8;
            push @rflags, $repeat;
        }

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

            $flag = $comp->{'flag'} & 7158;        # bits 2,10,11,12
            $flag |= 1 unless ($comp->{'args'}[0] > -129 && $comp->{'args'}[0] < 128
                    && $comp->{'args'}[1] > -129 && $comp->{'args'}[1] < 128);
            if (defined $comp->{'scale'})
            {
                if ($comp->{'scale'}[1] == 0 && $comp->{'scale'}[2] == 0)
                {
                    if ($comp->{'scale'}[0] == $comp->{'scale'}[3])
                    { $flag |= 8 unless ($comp->{'scale'}[0] == 0
                                    || $comp->{'scale'}[0] == 1); }
                    else
                    { $flag |= 64; }
                } else
                { $flag |= 128; }
            }
            
            $flag |= 512 if (defined $self->{'metric'} && $self->{'metric'} == $i);
            if ($i == $#{$self->{'comps'}})
            { $flag |= 256 if (defined $self->{'instLen'} && $self->{'instLen'} > 0); }
            else
            { $flag |= 32; }
            
            $self->{' DAT'} .= pack("n", $flag);
            $self->{' DAT'} .= pack("n", $comp->{'glyph'});
            $comp->{'flag'} = $flag;

            if ($flag & 1)
            { $self->{' DAT'} .= TTF_Pack("s2", @{$comp->{'args'}}); }
            else
            { $self->{' DAT'} .= pack("CC", @{$comp->{'args'}}); }

            if ($flag & 8)
            { $self->{' DAT'} .= TTF_Pack("F", $comp->{'scale'}[0]); }
            elsif ($flag & 64)
            { $self->{' DAT'} .= TTF_Pack("F2", $comp->{'scale'}[0], $comp->{'scale'}[3]); }
            elsif ($flag & 128)
            { $self->{' DAT'} .= TTF_Pack("F4", @{$comp->{'scale'}}); }
        }
        if (defined $self->{'instLen'} && $self->{'instLen'} > 0)
        {
            $len = $self->{'instLen'};
            $self->{' DAT'} .= pack("n", $len);
            $self->{' DAT'} .= pack("a" . $len, substr($self->{'hints'}, 0, $len));
        }
    }
    my ($olen) = length($self->{' DAT'});
    $self->{' DAT'} .= ("\000") x (4 - ($olen & 3)) if ($olen & 3);
    $self->{' OUTLEN'} = length($self->{' DAT'});
    $self->{' read'} = 2;           # changed from 1 to 2 so we don't read_dat() again
# we leave numPoints and instLen since maxp stats use this
    $self;
}


=head2 $g->update_bbox

Updates the bounding box for this glyph according to the points in the glyph

=cut

sub update_bbox
{
    my ($self) = @_;
    my ($num, $maxx, $minx, $maxy, $miny, $i, $comp, $x, $y, $compg);

    return $self unless (defined $self->{' read'} && $self->{' read'} > 1);       # only if read_dat done
    $miny = $minx = 65537; $maxx = $maxy = -65537;
    $num = $self->{'numberOfContours'};
    if ($num > 0)
    {
        for ($i = 0; $i < $self->{'numPoints'}; $i++)
        {
            ($x, $y) = ($self->{'x'}[$i], $self->{'y'}[$i]);

            $maxx = $x if ($x > $maxx);
            $minx = $x if ($x < $minx);
            $maxy = $y if ($y > $maxy);
            $miny = $y if ($y < $miny);
        }
    }

    elsif ($num < 0)
    {
        foreach $comp (@{$self->{'comps'}})
        {
            my ($gnx, $gny, $gxx, $gxy);
            my ($sxx, $sxy, $syx, $syy);
            
            my $otherg = $self->{' PARENT'}{'loca'}{'glyphs'}[$comp->{'glyph'}];
            # work around bad fonts: see documentation for 'comps' above
            next unless (defined $otherg);
            $compg = $otherg->read->update_bbox;
            ($gnx, $gny, $gxx, $gxy) = @{$compg}{'xMin', 'yMin', 'xMax', 'yMax'};
            if (defined $comp->{'scale'})
            {
                ($sxx, $sxy, $syx, $syy) = @{$comp->{'scale'}};
                ($gnx, $gny, $gxx, $gxy) = ($gnx*$sxx+$gny*$syx + $comp->{'args'}[0],
                                            $gnx*$sxy+$gny*$syy + $comp->{'args'}[1],
                                            $gxx*$sxx+$gxy*$syx + $comp->{'args'}[0],
                                            $gxx*$sxy+$gxy*$syy + $comp->{'args'}[1]);
            } elsif ($comp->{'args'}[0] || $comp->{'args'}[1])
            {
                $gnx += $comp->{'args'}[0];
                $gny += $comp->{'args'}[1];
                $gxx += $comp->{'args'}[0];
                $gxy += $comp->{'args'}[1];
            }
            ($gnx, $gxx) = ($gxx, $gnx) if $gnx > $gxx;
            ($gny, $gxy) = ($gxy, $gny) if $gny > $gxy;
            $maxx = $gxx if $gxx > $maxx;
            $minx = $gnx if $gnx < $minx;
            $maxy = $gxy if $gxy > $maxy;
            $miny = $gny if $gny < $miny;
        }
    }
    $self->{'xMax'} = $maxx;
    $self->{'xMin'} = $minx;
    $self->{'yMax'} = $maxy;
    $self->{'yMin'} = $miny;
    $self;
}



( run in 0.774 second using v1.01-cache-2.11-cpan-5a3173703d6 )