]> git.imager.perl.org - imager.git/blobdiff - t/t61filters.t
- reword and provide an example for non-proportionally scaling an
[imager.git] / t / t61filters.t
index dcf49d60f53ca53435b405d3a6cf7a6120bf9d5e..52678c91b304ed4a707f94d94fc5e95d76cba12f 100644 (file)
@@ -1,7 +1,8 @@
 #!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;
@@ -81,6 +82,12 @@ test($imbase, { type=>'unsharpmask', stddev=>2.0 },
 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 ] ];
@@ -134,6 +141,70 @@ 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");
+}
+
 sub test {
   my ($in, $params, $out) = @_;
 
@@ -149,3 +220,17 @@ sub test {
     }
   }
 }
+
+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;
+}