t/t22flood.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 15;
   4 use Imager;
   5 use Imager::Test qw(is_image);
   6
   7 { # flood_fill wouldn't fill to the right if the area was just a
   8   # single scan-line
   9   my $im = Imager->new(xsize => 5, ysize => 3);
  10   ok($im, "make flood_fill test image");
  11   ok($im->line(x1 => 0, y1 => 1, x2 => 4, y2 => 1, color => "white"),
  12      "create fill area");
  13   ok($im->flood_fill(x => 3, y => 1, color => "blue"),
  14      "fill it");
  15   my $cmp = Imager->new(xsize => 5, ysize => 3);
  16   ok($cmp, "make test image");
  17   ok($cmp->line(x1 => 0, y1 => 1, x2 => 4, y2 => 1, color => "blue"),
  18      "synthezied filled area");
  19   is_image($im, $cmp, "flood_fill filled horizontal line");
  20 }
  21
  22 SKIP:
  23 { # flood_fill won't fill entire line below if line above is shorter
  24   my $im = Imager->new(file => "testimg/filltest.ppm");
  25   ok($im, "Load test image")
  26     or skip("Couldn't load test image: " . Imager->errstr, 3);
  27
  28   # fill from first bad place
  29   my $fill1 = $im->copy;
  30   ok($fill1->flood_fill(x => 8, y => 2, color => "#000000"),
  31      "fill from a top most spot");
  32   my $cmp = Imager->new(xsize => $im->getwidth, ysize => $im->getheight);
  33   is_image($fill1, $cmp, "check it filled the lot");
  34   ok($fill1->write(file => "testout/t22fill1.ppm"), "save");
  35
  36   # second bad place
  37   my $fill2 = $im->copy;
  38   ok($fill2->flood_fill(x => 17, y => 3, color => "#000000"),
  39      "fill from not quite top most spot");
  40   is_image($fill2, $cmp, "check it filled the lot");
  41   ok($fill2->write(file => "testout/t22fill2.ppm"), "save");
  42 }
  43
  44 { # verticals
  45   my $im = vimage("FFFFFF");
  46   my $cmp = vimage("FF0000");
  47
  48   ok($im->flood_fill(x => 4, y=> 8, color => "FF0000"),
  49      "fill at bottom of vertical well");
  50   is_image($im, $cmp, "check the result");
  51 }
  52
  53 unless ($ENV{IMAGER_KEEP_FILES}) {
  54   unlink "testout/t22fill1.ppm";
  55   unlink "testout/t22fill2.ppm";
  56 }
  57
  58 # make a vertical test image
  59 sub vimage {
  60   my $c = shift;
  61
  62   my $im = Imager->new(xsize => 10, ysize => 10);
  63   $im->line(x1 => 1, y1 => 1, x2 => 8, y2 => 1, color => $c);
  64   $im->line(x1 => 4, y1 => 2, x2 => 4, y2 => 8, color => $c);
  65
  66   return $im;
  67 }