fix thumb scale() with a transparent source and a background
authorTony Cook <tony@develop-help.com>
Wed, 23 May 2012 03:45:18 +0000 (13:45 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 23 May 2012 03:45:18 +0000 (13:45 +1000)
MANIFEST
site/cgi-bin/modules/BSE/Thumb/Imager.pm
t/thumb/00load.t [new file with mode: 0644]
t/thumb/10scale.t [new file with mode: 0644]
t/thumb/data/scale40x30.png [new file with mode: 0644]
t/thumb/data/scale40x30fill.png [new file with mode: 0644]
t/thumb/data/simple.png [new file with mode: 0644]

index c95b0d3..c050bef 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -873,5 +873,10 @@ t/templates/preload.tmpl
 t/templates/wrapinner.tmpl
 t/templates/wrapself.tmpl
 t/templates/wraptest.tmpl      Used by t010template.t
+t/thumb/00load.t
+t/thumb/10scale.t
+t/thumb/data/scale40x30.png
+t/thumb/data/scale40x30fill.png
+t/thumb/data/simple.png
 test.cfg-dist
 test.cfg.base
index 8471a62..0d88470 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use constant CFG_SECTION => 'imager thumb driver';
 use Config;
 
-our $VERSION = "1.000";
+our $VERSION = "1.002";
 
 my %handlers =
   (
@@ -454,12 +454,15 @@ sub do {
   
   my $result = $scaled;
   if ($geo->{fill} && 
-      ($scaled->getwidth < $geo->{width} || $scaled->getheight < $geo->{height})) {
+      (($scaled->getwidth < $geo->{width}
+       || $scaled->getheight < $geo->{height})
+       || $scaled->getchannels == 2
+       || $scaled->getchannels == 4)) {
     $result = Imager->new(xsize => $geo->{width}, ysize => $geo->{height});
     $result->box(color => $geo->{fill}, filled => 1);
-    $result->paste(left => ($geo->{width} - $scaled->getwidth) / 2,
-                  top => ($geo->{height} - $scaled->getheight) / 2 ,
-                  img => $scaled);
+    $result->rubthrough(tx => ($geo->{width} - $scaled->getwidth) / 2,
+                       ty => ($geo->{height} - $scaled->getheight) / 2 ,
+                       src => $scaled);
   }
 
   return $result;
diff --git a/t/thumb/00load.t b/t/thumb/00load.t
new file mode 100644 (file)
index 0000000..8ca72be
--- /dev/null
@@ -0,0 +1,11 @@
+#!perl -w
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use Imager; 1"
+    or plan skip_all => "Imager not installed";
+}
+
+plan tests => 1;
+use_ok("BSE::Thumb::Imager");
diff --git a/t/thumb/10scale.t b/t/thumb/10scale.t
new file mode 100644 (file)
index 0000000..dea594e
--- /dev/null
@@ -0,0 +1,116 @@
+#!perl -w
+use strict;
+use Test::More;
+
+BEGIN {
+  eval <<EOS
+use Imager;
+use Imager::File::PNG;
+use Imager::File::GIF;
+use Imager::File::JPEG;
+1;
+EOS
+    or plan skip_all => "Imager or a needed file module not installed";
+}
+
+use BSE::Thumb::Imager;
+use Imager::Test qw(is_image_similar);
+
+my @dimension_tests =
+  ( # input geo, width, height, type, output width, height, type
+   [ "scale(100x100)", 200, 100, "", 100, 50, "" ],
+   [ "scale(100x100,fill:808080)", 200, 100, "", 100, 100, "" ],
+   [ "scale(100x100c)", 150, 80, "", 100, 80, "" ],
+   [ "scale(100x100c)", 150, 110, "", 100, 100, "" ],
+  );
+
+my @image_tests =
+  (
+   # geo, input, reference output, max diff (def: 1000)
+   [ "scale(40x30)", "simple.png", "scale40x30.png" ],
+   [ "scale(40x30,fill:808080)", "simple.png", "scale40x30fill.png" ],
+  );
+
+plan tests => 8 + 3 * @dimension_tests + 4 * @image_tests;
+
+my $cfg = bless
+  {
+  }, "Test::Cfg";
+
+my $th = BSE::Thumb::Imager->new($cfg);
+ok($th, "make driver object");
+
+{ # parsing
+  my $error;
+  ok($th->validate_geometry("scale(100x)", \$error),
+     "validate scale(100x)");
+  ok($th->validate_geometry("scale(100x100)", \$error),
+     "validate scale(100x100)");
+  ok($th->validate_geometry("scale(x100)", \$error),
+     "validate scale(x100)");
+  ok($th->validate_geometry("scale(100x100c)", \$error),
+     "validate scale(100x100c)");
+  ok($th->validate_geometry("scale(100x100,fill:808080)", \$error),
+     "validate scale(100x100,fill:808080)");
+  ok(!$th->validate_geometry("scale(100x,fill:808080)", \$error),
+     "fail validate scale(100x,fill:808080)");
+  is($error, "scale:Both dimensions must be supplied for fill",
+     "check error message");
+}
+
+{ # dimensions
+  for my $test (@dimension_tests) {
+    my ($geo, $in_w, $in_h, $in_type, $out_w, $out_h, $out_type) = @$test;
+
+    my $name = "$geo/$in_w/$in_h";
+    my ($result_w, $result_h, $result_type) =
+      $th->thumb_dimensions_sized($geo, $in_w, $in_h, $in_type);
+    is($result_w, $out_w, "dim $name: check output width");
+    is($result_h, $out_h, "dim $name: check output height");
+    is($result_type, $out_type, "dim $name: check output type");
+  }
+}
+
+{ # image results
+  for my $test (@image_tests) {
+    my ($geo, $infile, $reffile, $maxdiff) = @$test;
+
+    defined $maxdiff or $maxdiff = 1000;
+
+    my $name = "$geo/$infile";
+
+  SKIP:
+    {
+      my $error;
+      my ($data, $type) =
+       $th->thumb_data(filename => "t/thumb/data/$infile",
+                       geometry => $geo,
+                       error => \$error);
+      ok($data, "$name: made a thumb")
+       or skip("no thumb data to check", 3);
+
+      my $outim = Imager->new;
+      ok($outim->read(data => $data),
+        "$name: get the image data back as an image")
+       or skip("can't compare an image I can't read", 2);
+      my $refim = Imager->new;
+      ok($refim->read(file => "t/thumb/data/$reffile"),
+        "$name: get the reference image file as an image")
+       or skip("can't compare an image I can't read", 1);
+      is_image_similar($outim, $refim, $maxdiff,
+                      "$name: compare");
+    }
+  }
+}
+
+package Test::Cfg;
+
+sub entry {
+  my ($self, $section, $key, $default) = @_;
+
+  $section eq "imager thumb driver"
+    or return $default;
+  $self->{$key}
+    and return $self->{$key};
+  return $default;
+}
diff --git a/t/thumb/data/scale40x30.png b/t/thumb/data/scale40x30.png
new file mode 100644 (file)
index 0000000..738349c
Binary files /dev/null and b/t/thumb/data/scale40x30.png differ
diff --git a/t/thumb/data/scale40x30fill.png b/t/thumb/data/scale40x30fill.png
new file mode 100644 (file)
index 0000000..7b78076
Binary files /dev/null and b/t/thumb/data/scale40x30fill.png differ
diff --git a/t/thumb/data/simple.png b/t/thumb/data/simple.png
new file mode 100644 (file)
index 0000000..3c54f38
Binary files /dev/null and b/t/thumb/data/simple.png differ