-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+#!perl -w
-######################### We start with some black magic to print on failure.
+use strict;
+use Test::More tests => 18;
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..6\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Imager qw(:all);
+use Imager qw/NC/;
+use Imager::Test qw(is_image is_color3);
sub PI () { 3.14159265358979323846 }
-$loaded = 1;
-print "ok 1\n";
-
-init_log("testout/t75aapolyaa.log",1);
-
-$red = Imager::Color->new(255,0,0);
-$green = Imager::Color->new(0,255,0);
-$blue = Imager::Color->new(0,0,255);
-$white = Imager::Color->new(255,255,255);
-
-
-$img = Imager->new(xsize=>20, ysize=>10);
-@data = translate(5.5,5,
- rotate(0,
- scale(5, 5,
- get_polygon(n_gon => 5)
- )
- )
- );
-
-
-my ($x, $y) = array_to_refpair(@data);
-i_poly_aa($img->{IMG}, $x, $y, $white);
-
-
-
-
-print "ok 2\n";
-
-$img->write(file=>"testout/t75.ppm") or die $img->errstr;
-print "ok 3\n";
+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");
+}
-$zoom = make_zoom($img, 8, \@data, $red);
-$zoom->write(file=>"testout/t75zoom.ppm") or die $zoom->errstr;
+{ # 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");
+}
-print "ok 4\n";
+{
+ 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");
-$img = Imager->new(xsize=>300, ysize=>100);
+ ok($img->write(file=>"testout/t75.ppm"), "write to file")
+ or diag $img->errstr;
-for $n (0..55) {
- @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);
- i_poly_aa($img->{IMG}, $x, $y, NC(rand(255), rand(255), rand(255)));
+ my $zoom = make_zoom($img, 8, \@data, $red);
+ ok($zoom, "make zoom of primitive");
+ $zoom->write(file=>"testout/t75zoom.ppm") or die $zoom->errstr;
}
-$img->write(file=>"testout/t75big.ppm") or die $img->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;
-print "ok 5\n";
+ ok($good, "primitive squares");
+}
-$img = Imager->new(xsize => 200, ysize => 200);
+{
+ 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;
+}
-$img -> polygon(color=>$blue,
+{
+ 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(100,100,
- scale(10,10,
- get_polygon('wavycircle', 32*4, sub { 8+0.5*cos(12*$_) })))
+ translate(165,5,
+ scale(80,80,
+ get_polygon('wavycircle', 32*8, sub { 1+1*cos(4*$_) })))
],
- ) or die $img->errstr();
-
-$img->write(file=>"testout/t75wave.ppm") or die $img->errstr;
-
-print "ok 6\n";
-
-malloc_state();
-
-
-
-
-
-
+ ), "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;
my $timg = $img->scale(scalefactor=>$sc, qtype=>'preview');
# draw the grid
- for($lx=0; $lx<$timg->getwidth(); $lx+=$sc) {
+ 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($ly=0; $ly<$timg->getheight(); $ly+=$sc) {
+ 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);
projects / imager.git / blobdiff