t/300-transform/040-crop.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 66;
   4 use Imager;
   5 use Imager::Test qw(test_image);
   6
   7 #$Imager::DEBUG=1;
   8
   9 -d "testout" or mkdir "testout";
  10
  11 Imager::init('log'=>'testout/t65crop.log');
  12
  13 my $img=Imager->new() || die "unable to create image object\n";
  14
  15 ok($img, "created image ph");
  16
  17 SKIP:
  18 {
  19   skip("couldn't load source image", 2)
  20     unless ok($img->open(file=>'testimg/scale.ppm',type=>'pnm'), "loaded source");
  21   my $nimg = $img->crop(top=>10, left=>10, bottom=>25, right=>25);
  22   ok($nimg, "got an image");
  23   ok($nimg->write(file=>"testout/t65.ppm"), "save to file");
  24 }
  25
  26 { # https://rt.cpan.org/Ticket/Display.html?id=7578
  27   # make sure we get the right type of image on crop
  28   my $src = Imager->new(xsize=>50, ysize=>50, channels=>2, bits=>16);
  29   is($src->getchannels, 2, "check src channels");
  30   is($src->bits, 16, "check src bits");
  31   my $out = $src->crop(left=>10, right=>40, top=>10, bottom=>40);
  32   is($out->getchannels, 2, "check out channels");
  33   is($out->bits, 16, "check out bits");
  34 }
  35 { # https://rt.cpan.org/Ticket/Display.html?id=7578
  36   print "# try it for paletted too\n";
  37   my $src = Imager->new(xsize=>50, ysize=>50, channels=>3, type=>'paletted');
  38   # make sure color index zero is defined so there's something to copy
  39   $src->addcolors(colors=>[Imager::Color->new(0,0,0)]);
  40   is($src->type, 'paletted', "check source type");
  41   my $out = $src->crop(left=>10, right=>40, top=>10, bottom=>40);
  42   is($out->type, 'paletted', 'check output type');
  43 }
  44
  45 { # https://rt.cpan.org/Ticket/Display.html?id=7581
  46   # crop() documentation says width/height takes precedence, but is unclear
  47   # from looking at the existing code, setting width/height will go from
  48   # the left of the image, even if left/top are provided, despite the
  49   # sample in the docs
  50   # Let's make sure that things happen as documented
  51   my $src = test_image();
  52   # make sure we get what we want
  53   is($src->getwidth, 150, "src width");
  54   is($src->getheight, 150, "src height");
  55
  56   # the test data is:
  57   #  - description
  58   #  - hash ref containing args to crop()
  59   #  - expected left, top, right, bottom values
  60   # we call crop using the given arguments then call it using the
  61   # hopefully stable left/top/right/bottom/arguments
  62   # this is kind of lame, but I don't want to include a rewritten
  63   # crop in this file
  64   my @tests =
  65     (
  66      [
  67       "basic",
  68       { left=>10, top=>10, right=>70, bottom=>80 },
  69       10, 10, 70, 80,
  70      ],
  71      [
  72       "middle",
  73       { width=>50, height=>50 },
  74       50, 50, 100, 100,
  75      ],
  76      [
  77       "lefttop",
  78       { left=>20, width=>70, top=>30, height=>90 },
  79       20, 30, 90, 120,
  80      ],
  81      [
  82       "bottomright",
  83       { right=>140, width=>50, bottom=>130, height=>60 },
  84       90, 70, 140, 130,
  85      ],
  86      [
  87       "acrossmiddle",
  88       { top=>40, bottom=>110 },
  89       0, 40, 150, 110,
  90      ],
  91      [
  92       "downmiddle",
  93       { left=>40, right=>110 },
  94       40, 0, 110, 150,
  95      ],
  96      [
  97       "rightside",
  98       { left=>80, },
  99       80, 0, 150, 150,
 100      ],
 101      [
 102       "leftside",
 103       { right=>40 },
 104       0, 0, 40, 150,
 105      ],
 106      [
 107       "topside",
 108       { bottom=>40, },
 109       0, 0, 150, 40,
 110      ],
 111      [
 112       "bottomside",
 113       { top=>90 },
 114       0, 90, 150, 150,
 115      ],
 116      [
 117       "overright",
 118       { left=>100, right=>200 },
 119       100, 0, 150, 150,
 120      ],
 121      [
 122       "overtop",
 123       { bottom=>50, height=>70 },
 124       0, 0, 150, 50,
 125      ],
 126      [
 127       "overleft",
 128       { right=>30, width=>60 },
 129       0, 0, 30, 150,
 130      ],
 131      [
 132       "overbottom",
 133       { top=>120, height=>60 },
 134       0, 120, 150, 150,
 135      ],
 136     );
 137   for my $test (@tests) {
 138     my ($desc, $args, $left, $top, $right, $bottom) = @$test;
 139     my $out = $src->crop(%$args);
 140     ok($out, "got output for $desc");
 141     my $cmp = $src->crop(left=>$left, top=>$top, right=>$right, bottom=>$bottom);
 142     ok($cmp, "got cmp for $desc");
 143     # make sure they're the same
 144     my $diff = Imager::i_img_diff($out->{IMG}, $cmp->{IMG});
 145     is($diff, 0, "difference should be 0 for $desc");
 146   }
 147 }
 148 { # https://rt.cpan.org/Ticket/Display.html?id=7581
 149   # previously we didn't check that the result had some pixels
 150   # make sure we do
 151   my $src = test_image();
 152   ok(!$src->crop(left=>50, right=>50), "nothing across");
 153   cmp_ok($src->errstr, '=~', qr/resulting image would have no content/,
 154          "and message");
 155   ok(!$src->crop(top=>60, bottom=>60), "nothing down");
 156   cmp_ok($src->errstr, '=~', qr/resulting image would have no content/,
 157          "and message");
 158 }
 159
 160 { # http://rt.cpan.org/NoAuth/Bug.html?id=9672
 161   my $warning;
 162   local $SIG{__WARN__} =
 163     sub {
 164       $warning = "@_";
 165       my $printed = $warning;
 166       $printed =~ s/\n$//;
 167       $printed =~ s/\n/\n\#/g;
 168       print "# ",$printed, "\n";
 169     };
 170   my $img = Imager->new(xsize=>10, ysize=>10);
 171   $img->crop(left=>5);
 172   cmp_ok($warning, '=~', 'void', "correct warning");
 173   cmp_ok($warning, '=~', 'crop\\.t', "correct file");
 174 }
 175
 176 {
 177     my $src = test_image();
 178     ok(!$src->crop( top=>1000, bottom=>1500, left=>0, right=>100 ),
 179                 "outside of image" );
 180     cmp_ok($src->errstr, '=~', qr/outside of the image/, "and message");
 181     ok(!$src->crop( top=>100, bottom=>1500, left=>1000, right=>1500 ),
 182                 "outside of image" );
 183     cmp_ok($src->errstr, '=~', qr/outside of the image/, "and message");
 184 }
 185
 186 {
 187   my $empty = Imager->new;
 188   ok(!$empty->crop(left => 10), "can't crop an empty image");
 189   is($empty->errstr, "crop: empty input image", "check message");
 190 }