#!perl -w
use strict;
use Imager qw(:handy);
-use Test::More tests => 54;
+use lib 't';
+use Test::More tests => 64;
Imager::init_log("testout/t61filters.log", 1);
# meant for testing the filters themselves
my $imbase = Imager->new;
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 ] ];
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");
+}
+
sub test {
my ($in, $params, $out) = @_;
}
}
}
+
+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;
+}