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 )