#!perl -w
use strict;
use Imager qw(:handy);
-
+use Test::More tests => 79;
Imager::init_log("testout/t61filters.log", 1);
+use Imager::Test qw(is_image_similar test_image is_image);
# 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);
-print "1..37\n";
-
-test($imbase, 1, {type=>'autolevels'}, 'testout/t61_autolev.ppm');
+test($imbase, {type=>'autolevels'}, 'testout/t61_autolev.ppm');
-test($imbase, 3, {type=>'contrast', intensity=>0.5},
+test($imbase, {type=>'contrast', intensity=>0.5},
'testout/t61_contrast.ppm');
# this one's kind of cool
-test($imbase, 5, {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");
+}
-test($imbase, 7, {type=>'gaussian', stddev=>5 },
- 'testout/t61_gaussian.ppm');
+{
+ 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, 9, { type=>'gradgen', dist=>1,
+
+test($imbase, { type=>'gradgen', dist=>1,
xo=>[ 10, 10, 120 ],
yo=>[ 10, 140, 60 ],
colors=> [ NC('#FF0000'), NC('#FFFF00'), NC('#00FFFF') ]},
'testout/t61_gradgen.ppm');
-test($imbase, 11, {type=>'mosaic', size=>8}, 'testout/t61_mosaic.ppm');
+test($imbase, {type=>'mosaic', size=>8}, 'testout/t61_mosaic.ppm');
-test($imbase, 13, {type=>'hardinvert'}, 'testout/t61_hardinvert.ppm');
+test($imbase, {type=>'hardinvert'}, 'testout/t61_hardinvert.ppm');
-test($imbase, 15, {type=>'noise'}, 'testout/t61_noise.ppm');
+test($imbase, {type=>'noise'}, 'testout/t61_noise.ppm');
-test($imbase, 17, {type=>'radnoise'}, 'testout/t61_radnoise.ppm');
+test($imbase, {type=>'radnoise'}, 'testout/t61_radnoise.ppm');
-test($imbase, 19, {type=>'turbnoise'}, 'testout/t61_turbnoise.ppm');
+test($imbase, {type=>'turbnoise'}, 'testout/t61_turbnoise.ppm');
-test($imbase, 21, {type=>'bumpmap', bump=>$im_other, lightx=>30, lighty=>30},
+test($imbase, {type=>'bumpmap', bump=>$im_other, lightx=>30, lighty=>30},
'testout/t61_bumpmap.ppm');
-test($imbase, 23, {type=>'postlevels', levels=>3}, 'testout/t61_postlevels.ppm');
+test($imbase, {type=>'bumpmap_complex', bump=>$im_other}, 'testout/t61_bumpmap_complex.ppm');
+
+test($imbase, {type=>'postlevels', levels=>3}, 'testout/t61_postlevels.ppm');
-test($imbase, 25, {type=>'watermark', wmark=>$im_other },
+test($imbase, {type=>'watermark', wmark=>$im_other },
'testout/t61_watermark.ppm');
-test($imbase, 27, {type=>'fountain', xa=>75, ya=>75, xb=>85, yb=>30,
- repeat=>'triangle', #ftype=>'radial',
- super_sample=>'circle', ssample_param => 16,
- },
+test($imbase, {type=>'fountain', xa=>75, ya=>75, xb=>85, yb=>30,
+ repeat=>'triangle', #ftype=>'radial',
+ super_sample=>'circle', ssample_param => 16,
+ },
'testout/t61_fountain.ppm');
use Imager::Fountain;
my $f1 = Imager::Fountain->new;
$f1->add(end=>0.2, c0=>NC(255, 0,0), c1=>NC(255, 255,0));
$f1->add(start=>0.2, c0=>NC(255,255,0), c1=>NC(0,0,255,0));
-test($imbase, 29, { type=>'fountain', xa=>20, ya=>130, xb=>130, yb=>20,
- #repeat=>'triangle',
- segments=>$f1
- },
+test($imbase, { type=>'fountain', xa=>20, ya=>130, xb=>130, yb=>20,
+ #repeat=>'triangle',
+ segments=>$f1
+ },
'testout/t61_fountain2.ppm');
my $f2 = Imager::Fountain->new
->add(end=>0.5, c0=>NC(255,0,0), c1=>NC(255,0,0), color=>'hueup')
->add(start=>0.5, c0=>NC(255,0,0), c1=>NC(255,0,0), color=>'huedown');
#use Data::Dumper;
#print Dumper($f2);
-test($imbase, 31, { type=>'fountain', xa=>20, ya=>130, xb=>130, yb=>20,
+test($imbase, { type=>'fountain', xa=>20, ya=>130, xb=>130, yb=>20,
segments=>$f2 },
'testout/t61_fount_hsv.ppm');
-my $f3 = Imager::Fountain->read(gimp=>'testimg/gimpgrad')
- or print "not ";
-print "ok 33\n";
-test($imbase, 34, { type=>'fountain', xa=>75, ya=>75, xb=>90, yb=>15,
+my $f3 = Imager::Fountain->read(gimp=>'testimg/gimpgrad');
+ok($f3, "read gimpgrad");
+test($imbase, { type=>'fountain', xa=>75, ya=>75, xb=>90, yb=>15,
segments=>$f3, super_sample=>'grid',
ftype=>'radial_square', combine=>'color' },
'testout/t61_fount_gimp.ppm');
-test($imbase, 36, { type=>'unsharpmask', stddev=>2.0 },
+test($imbase, { type=>'unsharpmask', stddev=>2.0 },
'testout/t61_unsharp.ppm');
+test($imbase, {type=>'conv', coef=>[ -1, 3, -1, ], },
+ 'testout/t61_conv_sharp.ppm');
-sub test {
- my ($in, $num, $params, $out) = @_;
-
- my $copy = $in->copy;
- if ($copy->filter(%$params)) {
- print "ok $num\n";
- if ($copy->write(file=>$out)) {
- print "ok ",$num+1,"\n";
+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 ] ];
+test($imbase, {type=>'fountain', xa=>75, ya=>75, xb=>90, yb=>15,
+ segments=>$f4, super_sample=>'grid',
+ ftype=>'linear', combine=>'color' },
+ 'testout/t61_regress_fount.ppm');
+my $im2 = $imbase->copy;
+$im2->box(xmin=>20, ymin=>20, xmax=>40, ymax=>40, color=>'FF0000', filled=>1);
+$im2->write(file=>'testout/t61_diff_base.ppm');
+my $im3 = Imager->new(xsize=>150, ysize=>150, channels=>3);
+$im3->box(xmin=>20, ymin=>20, xmax=>40, ymax=>40, color=>'FF0000', filled=>1);
+my $diff = $imbase->difference(other=>$im2);
+ok($diff, "got difference image");
+SKIP:
+{
+ skip(1, "missing comp or diff image") unless $im3 && $diff;
+
+ is(Imager::i_img_diff($im3->{IMG}, $diff->{IMG}), 0,
+ "compare test image and diff image");
+}
+
+# newer versions of gimp add a line to the gradient file
+my $name;
+my $f5 = Imager::Fountain->read(gimp=>'testimg/newgimpgrad.ggr',
+ name => \$name);
+ok($f5, "read newer gimp gradient")
+ or print "# ",Imager->errstr,"\n";
+is($name, "imager test gradient", "check name read correctly");
+$f5 = Imager::Fountain->read(gimp=>'testimg/newgimpgrad.ggr');
+ok($f5, "check we handle case of no name reference correctly")
+ or print "# ",Imager->errstr,"\n";
+
+# test writing of gradients
+ok($f2->write(gimp=>'testout/t61grad1.ggr'), "save a gradient")
+ or print "# ",Imager->errstr,"\n";
+undef $name;
+my $f6 = Imager::Fountain->read(gimp=>'testout/t61grad1.ggr',
+ name=>\$name);
+ok($f6, "read what we wrote")
+ or print "# ",Imager->errstr,"\n";
+ok(!defined $name, "we didn't set the name, so shouldn't get one");
+
+# try with a name
+ok($f2->write(gimp=>'testout/t61grad2.ggr', name=>'test gradient'),
+ "write gradient with a name")
+ or print "# ",Imager->errstr,"\n";
+undef $name;
+my $f7 = Imager::Fountain->read(gimp=>'testout/t61grad2.ggr', name=>\$name);
+ok($f7, "read what we wrote")
+ or print "# ",Imager->errstr,"\n";
+is($name, "test gradient", "check the name matches");
+
+# we attempt to convert color names in segments to segments now
+{
+ my @segs =
+ (
+ [ 0.0, 0.5, 1.0, '000000', '#FFF', 0, 0 ],
+ );
+ my $im = Imager->new(xsize=>50, ysize=>50);
+ ok($im->filter(type=>'fountain', segments => \@segs,
+ xa=>0, ya=>30, xb=>49, yb=>30),
+ "fountain with color names instead of objects in segments");
+ my $left = $im->getpixel('x'=>0, 'y'=>20);
+ ok(color_close($left, Imager::Color->new(0,0,0)),
+ "check black converted correctly");
+ my $right = $im->getpixel('x'=>49, 'y'=>20);
+ ok(color_close($right, Imager::Color->new(255,255,255)),
+ "check white converted correctly");
+
+ # check that invalid color names are handled correctly
+ my @segs2 =
+ (
+ [ 0.0, 0.5, 1.0, '000000', 'FxFxFx', 0, 0 ],
+ );
+ ok(!$im->filter(type=>'fountain', segments => \@segs2,
+ xa=>0, ya=>30, xb=>49, yb=>30),
+ "fountain with invalid color name");
+ cmp_ok($im->errstr, '=~', 'No color named', "check error message");
+}
+
+{
+ 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) ];
}
- else {
- print "not ok ",$num+1," # ",$copy->errstr,"\n";
+ 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) = @_;
+
+ my $copy = $in->copy;
+ if (ok($copy->filter(%$params), $params->{type})) {
+ ok($copy->write(file=>$out), "write $params->{type}")
+ or print "# ",$copy->errstr,"\n";
+ }
else {
- print "not ok $num # ",$copy->errstr,"\n";
- print "ok ",$num+1," # skipped\n";
+ diag($copy->errstr);
+ SKIP:
+ {
+ skip("couldn't filter", 1);
+ }
+ }
+ $copy;
+}
+
+sub color_close {
+ my ($c1, $c2) = @_;
+
+ my @c1 = $c1->rgba;
+ my @c2 = $c2->rgba;
+
+ for my $i (0..2) {
+ if (abs($c1[$i]-$c2[$i]) > 2) {
+ return 0;
+ }
}
+ return 1;
}
projects / imager.git / blobdiff