Font-TTF-Scripts

 view release on metacpan or  search on metacpan

scripts/fret  view on Meta::CPAN

    push (@res, ["RG", @$col], ["s"]);
    return @res;
}

sub normalpt
{
    my ($g, $x, $y) = @_;
    my ($newx) = ($x - $g->{'xMin'}) / ($g->{'xMax'} - $g->{'xMin'});
    my ($newy) = ($y - $g->{'yMin'}) / ($g->{'yMax'} - $g->{'yMin'});
    return ($newx, $newy);
}

sub unnormalpt
{
    my ($g, $x, $y) = @_;
    my ($newx) = $x * $g->{'xMax'} + (1 - $x) * $g->{'xMin'};
    my ($newy) = $y * $g->{'yMax'} + (1 - $y) * $g->{'yMin'};
    return ($newx, $newy);
}

sub unnormald
{
    my ($g, $a, $s) = @_;
    my ($newx) = ($a + $s) * 0.5 * ($g->{'xMax'} - $g->{'xMin'}) + $g->{'xMin'};
    my ($newy) = ($a - $s) * 0.5 * ($g->{'yMax'} - $g->{'yMin'}) + $g->{'yMin'}; 
    return ($newx + $newy, $newx - $newy);
}

sub addpoint
{
    my ($g, $x, $y, $glyph) = @_;

    push (@{$g->{'points'}}, [$x, $y]);
    my ($s) = $x - $y;
    my ($a) = $x + $y;
    # minmaxes
    $g->{'bbox'}[0] = $x if (!defined $g->{'bbox'}[0] || $x < $g->{'bbox'}[0]);
    $g->{'bbox'}[1] = $x if (!defined $g->{'bbox'}[1] || $x > $g->{'bbox'}[1]);
    $g->{'bbox'}[2] = $y if (!defined $g->{'bbox'}[2] || $y < $g->{'bbox'}[2]);
    $g->{'bbox'}[3] = $y if (!defined $g->{'bbox'}[3] || $y > $g->{'bbox'}[3]);
    $g->{'dbox'}[0] = $a if (!defined $g->{'dbox'}[0] || $a < $g->{'dbox'}[0]);
    $g->{'dbox'}[1] = $a if (!defined $g->{'dbox'}[1] || $a > $g->{'dbox'}[1]);
    $g->{'dbox'}[2] = $s if (!defined $g->{'dbox'}[2] || $s < $g->{'dbox'}[2]);
    $g->{'dbox'}[3] = $s if (!defined $g->{'dbox'}[3] || $s > $g->{'dbox'}[3]);
    if ($glyph)
    {
        $glyph->{'dbox'}[0] = $a if (!defined $glyph->{'dbox'}[0] || $a < $glyph->{'dbox'}[0]);
        $glyph->{'dbox'}[1] = $a if (!defined $glyph->{'dbox'}[1] || $a > $glyph->{'dbox'}[1]);
        $glyph->{'dbox'}[2] = $s if (!defined $glyph->{'dbox'}[2] || $s < $glyph->{'dbox'}[2]);
        $glyph->{'dbox'}[3] = $s if (!defined $glyph->{'dbox'}[3] || $s > $glyph->{'dbox'}[3]);
    }
}

sub addminmax
{
    my ($e, $v) = @_;
    $e->[0] = $v if (!defined $e->[0] || $v < $e->[0]);
    $e->[1] = $v if (!defined $e->[1] || $v > $e->[1]);
}

sub overlay
{
    my ($class, $cid, $gid, $glyph, $uid, $font) = @_;
    my (@res, @grid, $i, $j, $ei, $oldx, $oldy, $oldgx, $oldgy);
    return () unless ($opts->{'b'});

    if ($specialfh)
    { printf $specialfh "  <glyph gid='%d' uid='%04X' name='%s'>\n", $gid, $uid, $font->{'post'}{'VAL'}[$gid]; }

    foreach $i (0 .. 3)
    {
        foreach $j (0 .. 3)
        {
            $grid[$i][$j] = {'cutsi' => [[], [], [], []], 'cutso' => [[], [], [], []]};
        }
    }

    $glyph->get_points();
    $ei = 0;
    if (defined $glyph->{'x'})
    {
        for ($i = 0; $i < @{$glyph->{'x'}}; $i++)
        {
            my ($x, $y) = ($glyph->{'x'}[$i], $glyph->{'y'}[$i]);
            my ($x1, $y1) = normalpt($glyph, $x, $y);
            my ($gx, $gy) = (int($x1 * 4 - .001), int($y1 * 4 - .001));
            addpoint($grid[$gx][$gy], $x, $y, $glyph);
            if (defined $oldgx)
            {
                # handle curve lines crossing grid lines
                while ($oldgx < $gx)
                {
                    my ($nbx) = ($oldgx + 1) / 4.;
                    my ($t) = ($nbx - $oldx) / ($x1 - $oldx);
                    my ($nby) = $t * $y1 + (1 - $t) * $oldy;
                    my ($bgy) = int($nby * 4 - .001);
                    my ($bx, $by) = unnormalpt($glyph, $nbx, $nby);
                    addpoint($grid[$oldgx][$bgy], $bx, $by);
                    addminmax($grid[$oldgx][$bgy]{'cutso'}[1], $by);
                    ++$oldgx;
                    addpoint($grid[$oldgx][$bgy], $bx, $by);
                    addminmax($grid[$oldgx][$bgy]{'cutsi'}[0], $by);
                }
                while ($oldgx > $gx)
                {
                    my ($nbx) = $oldgx / 4.;
                    my ($t) = ($nbx - $oldx) / ($x1 - $oldx);
                    my ($nby) = $t * $y1 + (1 - $t) * $oldy;
                    my ($bgy) = int($nby * 4 - .001);
                    my ($bx, $by) = unnormalpt($glyph, $nbx, $nby);
                    addpoint($grid[$oldgx][$bgy], $bx, $by);
                    addminmax($grid[$oldgx][$bgy]{'cutso'}[0], $by);
                    --$oldgx;
                    addpoint($grid[$oldgx][$bgy], $bx, $by);
                    addminmax($grid[$oldgx][$bgy]{'cutsi'}[1], $by);
                }
                while ($oldgy < $gy)
                {
                    my ($nby) = ($oldgy + 1) / 4.;
                    my ($t) = ($nby - $oldy) / ($y1 - $oldy);
                    my ($nbx) = $t * $x1 + (1 - $t) * $oldx;



( run in 1.240 second using v1.01-cache-2.11-cpan-39bf76dae61 )