#!perl -w
use strict;
use Imager qw(:handy);
-use Test::More tests => 59;
+use Test::More tests => 113;
+
+-d "testout" or mkdir "testout";
+
Imager::init_log("testout/t61filters.log", 1);
+use Imager::Test qw(is_image_similar test_image is_image is_color4 is_fcolor4);
# meant for testing the filters themselves
-my $imbase = Imager->new;
-$imbase->open(file=>'testout/t104.ppm') or die;
+
+my $imbase = test_image();
+
my $im_other = Imager->new(xsize=>150, ysize=>150);
$im_other->box(xmin=>30, ymin=>60, xmax=>120, ymax=>90, filled=>1);
'testout/t61_contrast.ppm');
# this one's kind of cool
-test($imbase, {type=>'conv', coef=>[ -0.5, 1, -0.5, ], },
- 'testout/t61_conv.ppm');
+test($imbase, {type=>'conv', coef=>[ 0.3, 1, 0.3, ], },
+ 'testout/t61_conv_blur.ppm');
+
+{
+ my $work8 = $imbase->copy;
+ ok(!$work8->filter(type => "conv", coef => "ABC"),
+ "coef not an array");
+}
+{
+ my $work8 = $imbase->copy;
+ ok(!$work8->filter(type => "conv", coef => [ -1, 2, -1 ]),
+ "should fail if sum of coef is 0");
+ is($work8->errstr, "sum of coefficients is zero", "check message");
+}
+
+{
+ my $work8 = $imbase->copy;
+ my $work16 = $imbase->to_rgb16;
+ my $coef = [ -0.2, 1, -0.2 ];
+ ok($work8->filter(type => "conv", coef => $coef),
+ "filter 8 bit image");
+ ok($work16->filter(type => "conv", , coef => $coef),
+ "filter 16 bit image");
+ is_image_similar($work8, $work16, 80000, "8 and 16 bit conv match");
+}
+
+{
+ my $gauss = test($imbase, {type=>'gaussian', stddev=>5 },
+ 'testout/t61_gaussian.ppm');
+
+ my $imbase16 = $imbase->to_rgb16;
+ my $gauss16 = test($imbase16, {type=>'gaussian', stddev=>5 },
+ 'testout/t61_gaussian16.ppm');
+ is_image_similar($gauss, $gauss16, 250000, "8 and 16 gaussian match");
+}
-test($imbase, {type=>'gaussian', stddev=>5 },
- 'testout/t61_gaussian.ppm');
test($imbase, { type=>'gradgen', dist=>1,
xo=>[ 10, 10, 120 ],
test($imbase, {type=>'hardinvert'}, 'testout/t61_hardinvert.ppm');
+{ # invert - 8 bit
+ my $im = Imager->new(xsize => 1, ysize => 1, channels => 4);
+ ok($im, "make test image for invert test");
+ ok($im->setpixel(x => 0, y => 0, color => "000010C0"),
+ "set a test pixel");
+ my $copy = $im->copy;
+ ok($im->filter(type => "hardinvert"), "hardinvert it");
+ is_color4($im->getpixel(x => 0, y => 0), 255, 255, 0xEF, 0xC0,
+ "check only colour inverted");
+ ok($copy->filter(type => "hardinvertall"), "hardinvertall copy");
+ is_color4($copy->getpixel(x => 0, y => 0), 255, 255, 0xEF, 0x3f,
+ "check all inverted");
+}
+
+{ # invert - double image
+ my $im = Imager->new(xsize => 1, ysize => 1, channels => 4, bits => "double");
+ ok($im, "make double test image for invert test");
+ ok($im->setpixel(x => 0, y => 0, color => Imager::Color::Float->new(0, 0, 0.125, 0.75)),
+ "set a test pixel");
+ my $copy = $im->copy;
+ ok($im->filter(type => "hardinvert"), "hardinvert it");
+ is_fcolor4($im->getpixel(x => 0, y => 0, type => "double"),
+ 1.0, 1.0, 0.875, 0.75, 1e-5,
+ "check only colour inverted");
+ ok($copy->filter(type => "hardinvertall"), "hardinvertall copy");
+ is_fcolor4($copy->getpixel(x => 0, y => 0, type =>"double"),
+ 1.0, 1.0, 0.875, 0.25, 1e-5,
+ "check all inverted");
+}
+
test($imbase, {type=>'noise'}, 'testout/t61_noise.ppm');
test($imbase, {type=>'radnoise'}, 'testout/t61_radnoise.ppm');
segments=>$f3, super_sample=>'grid',
ftype=>'radial_square', combine=>'color' },
'testout/t61_fount_gimp.ppm');
+{ # test new fountain with no parameters
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
+ my $f4 = Imager::Fountain->read();
+ ok(!$f4, "read with no parameters does nothing");
+ like($warn, qr/Nothing to do!/, "check the warning");
+}
+{ # test with missing file
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
+ my $f = Imager::Fountain->read(gimp => "no-such-file");
+ ok(!$f, "try to read a fountain defintion that doesn't exist");
+ is($warn, "", "should be no warning");
+ like(Imager->errstr, qr/^Cannot open no-such-file: /, "check message");
+}
+SKIP:
+{
+ my $fh = IO::File->new("testimg/gimpgrad", "r");
+ ok($fh, "opened gradient")
+ or skip "Couldn't open gradient: $!", 1;
+ my $f = Imager::Fountain->read(gimp => $fh);
+ ok($f, "read gradient from file handle");
+}
+{
+ # not a gradient
+ my $f = Imager::Fountain->read(gimp => "t/t61filters.t");
+ ok(!$f, "fail to read non-gradient");
+ is(Imager->errstr, "t/t61filters.t is not a GIMP gradient file",
+ "check error message");
+}
+{ # an invalid gradient file
+ my $f = Imager::Fountain->read(gimp => "testimg/gradbad.ggr");
+ ok(!$f, "fail to read bad gradient (bad seg count)");
+ is(Imager->errstr, "testimg/gradbad.ggr is missing the segment count",
+ "check error message");
+}
+{ # an invalid gradient file
+ my $f = Imager::Fountain->read(gimp => "testimg/gradbad2.ggr");
+ ok(!$f, "fail to read bad gradient (bad segment)");
+ is(Imager->errstr, "Bad segment definition",
+ "check error message");
+}
test($imbase, { type=>'unsharpmask', stddev=>2.0 },
'testout/t61_unsharp.ppm');
test($imbase, {type=>'conv', coef=>[ -1, 3, -1, ], },
'testout/t61_conv_sharp.ppm');
+test($imbase, { type=>'nearest_color', dist=>1,
+ xo=>[ 10, 10, 120 ],
+ yo=>[ 10, 140, 60 ],
+ colors=> [ NC('#FF0000'), NC('#FFFF00'), NC('#00FFFF') ]},
+ 'testout/t61_nearest.ppm');
+
# Regression test: the checking of the segment type was incorrect
# (the comparison was checking the wrong variable against the wrong value)
my $f4 = [ [ 0, 0.5, 1, NC(0,0,0), NC(255,255,255), 5, 0 ] ];
cmp_ok($im->errstr, '=~', 'No color named', "check error message");
}
+{
+ # test simple gradient creation
+ my @colors = map Imager::Color->new($_), qw/white blue red/;
+ my $s = Imager::Fountain->simple(positions => [ 0, 0.3, 1.0 ],
+ colors => \@colors);
+ ok($s, "made simple gradient");
+ my $start = $s->[0];
+ is($start->[0], 0, "check start of first correct");
+ is_color4($start->[3], 255, 255, 255, 255, "check color at start");
+}
+{
+ # simple gradient error modes
+ {
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
+ my $s = Imager::Fountain->simple();
+ ok(!$s, "no parameters to simple()");
+ like($warn, qr/Nothing to do/);
+ }
+ {
+ my $s = Imager::Fountain->simple(positions => [ 0, 1 ],
+ colors => [ NC(0, 0, 0) ]);
+ ok(!$s, "mismatch of positions and colors fails");
+ is(Imager->errstr, "positions and colors must be the same size",
+ "check message");
+ }
+ {
+ my $s = Imager::Fountain->simple(positions => [ 0 ],
+ colors => [ NC(0, 0, 0) ]);
+ ok(!$s, "not enough positions");
+ is(Imager->errstr, "not enough segments");
+ }
+}
+
+{
+ my $im = Imager->new(xsize=>100, ysize=>100);
+ # build the gradient the hard way - linear from black to white,
+ # then back again
+ my @simple =
+ (
+ [ 0, 0.25, 0.5, 'black', 'white', 0, 0 ],
+ [ 0.5. 0.75, 1.0, 'white', 'black', 0, 0 ],
+ );
+ # across
+ my $linear = $im->filter(type => "fountain",
+ ftype => 'linear',
+ repeat => 'sawtooth',
+ xa => 0,
+ ya => $im->getheight / 2,
+ xb => $im->getwidth - 1,
+ yb => $im->getheight / 2);
+ ok($linear, "linear fountain sample");
+ # around
+ my $revolution = $im->filter(type => "fountain",
+ ftype => 'revolution',
+ xa => $im->getwidth / 2,
+ ya => $im->getheight / 2,
+ xb => $im->getwidth / 2,
+ yb => 0);
+ ok($revolution, "revolution fountain sample");
+ # out from the middle
+ my $radial = $im->filter(type => "fountain",
+ ftype => 'radial',
+ xa => $im->getwidth / 2,
+ ya => $im->getheight / 2,
+ xb => $im->getwidth / 2,
+ yb => 0);
+ ok($radial, "radial fountain sample");
+}
+
+{
+ # try a simple custom filter that uses the Perl image interface
+ sub perl_filt {
+ my %args = @_;
+
+ my $im = $args{imager};
+
+ my $channels = $args{channels};
+ unless (@$channels) {
+ $channels = [ reverse(0 .. $im->getchannels-1) ];
+ }
+ my @chans = @$channels;
+ push @chans, 0 while @chans < 4;
+
+ for my $y (0 .. $im->getheight-1) {
+ my $row = $im->getsamples(y => $y, channels => \@chans);
+ $im->setscanline(y => $y, pixels => $row);
+ }
+ }
+ Imager->register_filter(type => 'perl_test',
+ callsub => \&perl_filt,
+ defaults => { channels => [] },
+ callseq => [ qw/imager channels/ ]);
+ test($imbase, { type => 'perl_test' }, 'testout/t61perl.ppm');
+}
+
+{ # check the difference method out
+ my $im1 = Imager->new(xsize => 3, ysize => 2);
+ $im1->box(filled => 1, color => '#FF0000');
+ my $im2 = $im1->copy;
+ $im1->setpixel(x => 1, 'y' => 0, color => '#FF00FF');
+ $im2->setpixel(x => 1, 'y' => 0, color => '#FF01FF');
+ $im1->setpixel(x => 2, 'y' => 0, color => '#FF00FF');
+ $im2->setpixel(x => 2, 'y' => 0, color => '#FF02FF');
+
+ my $diff1 = $im1->difference(other => $im2);
+ my $cmp1 = Imager->new(xsize => 3, ysize => 2, channels => 4);
+ $cmp1->setpixel(x => 1, 'y' => 0, color => '#FF01FF');
+ $cmp1->setpixel(x => 2, 'y' => 0, color => '#FF02FF');
+ is_image($diff1, $cmp1, "difference() - check image with mindist 0");
+
+ my $diff2 = $im1->difference(other => $im2, mindist => 1);
+ my $cmp2 = Imager->new(xsize => 3, ysize => 2, channels => 4);
+ $cmp2->setpixel(x => 2, 'y' => 0, color => '#FF02FF');
+ is_image($diff2, $cmp2, "difference() - check image with mindist 1");
+}
+
+{
+ # and again with large samples
+ my $im1 = Imager->new(xsize => 3, ysize => 2, bits => 'double');
+ $im1->box(filled => 1, color => '#FF0000');
+ my $im2 = $im1->copy;
+ $im1->setpixel(x => 1, 'y' => 0, color => '#FF00FF');
+ $im2->setpixel(x => 1, 'y' => 0, color => '#FF01FF');
+ $im1->setpixel(x => 2, 'y' => 0, color => '#FF00FF');
+ $im2->setpixel(x => 2, 'y' => 0, color => '#FF02FF');
+
+ my $diff1 = $im1->difference(other => $im2);
+ my $cmp1 = Imager->new(xsize => 3, ysize => 2, channels => 4);
+ $cmp1->setpixel(x => 1, 'y' => 0, color => '#FF01FF');
+ $cmp1->setpixel(x => 2, 'y' => 0, color => '#FF02FF');
+ is_image($diff1, $cmp1, "difference() - check image with mindist 0 - large samples");
+
+ my $diff2 = $im1->difference(other => $im2, mindist => 1.1);
+ my $cmp2 = Imager->new(xsize => 3, ysize => 2, channels => 4);
+ $cmp2->setpixel(x => 2, 'y' => 0, color => '#FF02FF');
+ is_image($diff2, $cmp2, "difference() - check image with mindist 1.1 - large samples");
+}
+
sub test {
my ($in, $params, $out) = @_;
or print "# ",$copy->errstr,"\n";
}
else {
+ diag($copy->errstr);
SKIP:
{
skip("couldn't filter", 1);
}
}
+ $copy;
}
sub color_close {
projects / imager.git / blobdiff