Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

280 lines (231 sloc) 7.432 kb
#!perl -w
use strict;
use Test::More tests => 18;
use Imager qw/NC/;
use Imager::Test qw(is_image is_color3);
sub PI () { 3.14159265358979323846 }
-d "testout" or mkdir "testout";
Imager::init_log("testout/t75aapolyaa.log",1);
my $red = Imager::Color->new(255,0,0);
my $green = Imager::Color->new(0,255,0);
my $blue = Imager::Color->new(0,0,255);
my $white = Imager::Color->new(255,255,255);
{ # artifacts with multiple vertical lobes
# https://rt.cpan.org/Ticket/Display.html?id=43518
# previously this would have a full coverage pixel at (0,0) caused
# by the (20,0.5) point in the right lobe
my @pts =
(
[ 0.5, -9 ],
[ 10, -9 ],
[ 10, 11 ],
[ 15, 11 ],
[ 15, -9 ],
[ 17, -9 ],
[ 20, 0.5 ],
[ 17, 11 ],
[ 0.5, 11 ],
);
my $im = Imager->new(xsize => 10, ysize => 2);
ok($im->polygon(points => \@pts,
color => $white),
"draw with inside point");
ok($im->write(file => "testout/t75inside.ppm"), "save to file");
# both scanlines should be the same
my $line0 = $im->crop(top => 0, height => 1);
my $line1 = $im->crop(top => 1, height => 1);
is_image($line0, $line1, "both scanlines should be the same");
}
{ # check vertical edges are consistent
my $im = Imager->new(xsize => 10, ysize => 10);
ok($im->polygon(points => [ [ 0.5, 0 ], [ 9.25, 0 ],
[ 9.25, 10 ], [ 0.5, 10 ] ],
color => $white,
aa => 1),
"draw polygon with mid pixel vertical edges")
or diag $im->errstr;
my @line0 = $im->getscanline(y => 0);
my $im2 = Imager->new(xsize => 10, ysize => 10);
for my $y (0..9) {
$im2->setscanline(y => $y, pixels => \@line0);
}
is_image($im, $im2, "all scan lines should be the same");
is_color3($line0[0], 128, 128, 128, "(0,0) should be 50% coverage");
is_color3($line0[9], 64, 64, 64, "(9,0) should be 25% coverage");
}
{ # check horizontal edges are consistent
my $im = Imager->new(xsize => 10, ysize => 10);
ok($im->polygon(points => [ [ 0, 0.5 ], [ 0, 9.25 ],
[ 10, 9.25 ], [ 10, 0.5 ] ],
color => $white,
aa => 1),
"draw polygon with mid-pixel horizontal edges");
is_deeply([ $im->getsamples(y => 0, channels => [ 0 ]) ],
[ (128) x 10 ],
"all of line 0 should be 50% coverage");
is_deeply([ $im->getsamples(y => 9, channels => [ 0 ]) ],
[ (64) x 10 ],
"all of line 9 should be 25% coverage");
}
{
my $img = Imager->new(xsize=>20, ysize=>10);
my @data = translate(5.5,5,
rotate(0,
scale(5, 5,
get_polygon(n_gon => 5)
)
)
);
my ($x, $y) = array_to_refpair(@data);
ok(Imager::i_poly_aa($img->{IMG}, $x, $y, $white), "primitive poly");
ok($img->write(file=>"testout/t75.ppm"), "write to file")
or diag $img->errstr;
my $zoom = make_zoom($img, 8, \@data, $red);
ok($zoom, "make zoom of primitive");
$zoom->write(file=>"testout/t75zoom.ppm") or die $zoom->errstr;
}
{
my $img = Imager->new(xsize=>300, ysize=>100);
my $good = 1;
for my $n (0..55) {
my @data = translate(20+20*($n%14),18+20*int($n/14),
rotate(15*$n/PI,
scale(15, 15,
get_polygon('box')
)
)
);
my ($x, $y) = array_to_refpair(@data);
Imager::i_poly_aa($img->{IMG}, $x, $y, NC(rand(255), rand(255), rand(255)))
or $good = 0;
}
$img->write(file=>"testout/t75big.ppm") or die $img->errstr;
ok($good, "primitive squares");
}
{
my $img = Imager->new(xsize => 300, ysize => 300);
ok($img -> polygon(color=>$white,
points => [
translate(150,150,
rotate(45*PI/180,
scale(70,70,
get_polygon('wavycircle', 32*8, sub { 1.2+1*cos(4*$_) }))))
],
), "method call")
or diag $img->errstr();
$img->write(file=>"testout/t75wave.ppm") or die $img->errstr;
}
{
my $img = Imager->new(xsize=>10,ysize=>6);
my @data = translate(165,5,
scale(80,80,
get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })));
ok($img -> polygon(color=>$white,
points => [
translate(165,5,
scale(80,80,
get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })))
],
), "bug check")
or diag $img->errstr();
make_zoom($img,20,\@data, $blue)->write(file=>"testout/t75wavebug.ppm") or die $img->errstr;
}
{
my $img = Imager->new(xsize=>300, ysize=>300);
ok($img->polygon(fill=>{ hatch=>'cross1', fg=>'00FF00', bg=>'0000FF', dx=>3 },
points => [
translate(150,150,
scale(70,70,
get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })))
],
), "poly filled with hatch")
or diag $img->errstr();
$img->write(file=>"testout/t75wave_fill.ppm") or die $img->errstr;
}
{
my $img = Imager->new(xsize=>300, ysize=>300, bits=>16);
ok($img->polygon(fill=>{ hatch=>'cross1', fg=>'00FF00', bg=>'0000FF' },
points => [
translate(150,150,
scale(70,70,
get_polygon('wavycircle', 32*8, sub { 1+1*cos(5*$_) })))
],
), "hatched to 16-bit image")
or diag $img->errstr();
$img->write(file=>"testout/t75wave_fill16.ppm") or die $img->errstr;
}
Imager::malloc_state();
#initialized in a BEGIN, later
my %primitives;
my %polygens;
sub get_polygon {
my $name = shift;
if (exists $primitives{$name}) {
return @{$primitives{$name}};
}
if (exists $polygens{$name}) {
return $polygens{$name}->(@_);
}
die "polygon spec: $name unknown\n";
}
sub make_zoom {
my ($img, $sc, $polydata, $linecolor) = @_;
# scale with nearest neighboor sampling
my $timg = $img->scale(scalefactor=>$sc, qtype=>'preview');
# draw the grid
for(my $lx=0; $lx<$timg->getwidth(); $lx+=$sc) {
$timg->line(color=>$green, x1=>$lx, x2=>$lx, y1=>0, y2=>$timg->getheight(), antialias=>0);
}
for(my $ly=0; $ly<$timg->getheight(); $ly+=$sc) {
$timg->line(color=>$green, y1=>$ly, y2=>$ly, x1=>0, x2=>$timg->getwidth(), antialias=>0);
}
my @data = scale($sc, $sc, @$polydata);
push(@data, $data[0]);
my ($x, $y) = array_to_refpair(@data);
$timg->polyline(color=>$linecolor, 'x'=>$x, 'y'=>$y, antialias=>0);
return $timg;
}
# utility functions to manipulate point data
sub scale {
my ($x, $y, @data) = @_;
return map { [ $_->[0]*$x , $_->[1]*$y ] } @data;
}
sub translate {
my ($x, $y, @data) = @_;
map { [ $_->[0]+$x , $_->[1]+$y ] } @data;
}
sub rotate {
my ($rad, @data) = @_;
map { [ $_->[0]*cos($rad)+$_->[1]*sin($rad) , $_->[1]*cos($rad)-$_->[0]*sin($rad) ] } @data;
}
sub array_to_refpair {
my (@x, @y);
for (@_) {
push(@x, $_->[0]);
push(@y, $_->[1]);
}
return \@x, \@y;
}
BEGIN {
%primitives = (
box => [ [-0.5,-0.5], [0.5,-0.5], [0.5,0.5], [-0.5,0.5] ],
triangle => [ [0,0], [1,0], [1,1] ],
);
%polygens = (
wavycircle => sub {
my $numv = shift;
my $radfunc = shift;
my @radians = map { $_*2*PI/$numv } 0..$numv-1;
my @radius = map { $radfunc->($_) } @radians;
map {
[ $radius[$_] * cos($radians[$_]), $radius[$_] * sin($radians[$_]) ]
} 0..$#radians;
},
n_gon => sub {
my $N = shift;
map {
[ cos($_*2*PI/$N), sin($_*2*PI/$N) ]
} 0..$N-1;
},
);
}
Jump to Line
Something went wrong with that request. Please try again.