t/t64copyflip.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 77;
   4 use Imager;
   5 use Imager::Test qw(is_color3 is_image is_imaged test_image_double test_image isnt_image);
   6
   7 #$Imager::DEBUG=1;
   8
   9 -d "testout" or mkdir "testout";
  10
  11 Imager::init('log'=>'testout/t64copyflip.log');
  12
  13 my $img=Imager->new() or die "unable to create image object\n";
  14
  15 $img->open(file=>'testimg/scale.ppm',type=>'pnm');
  16 my $nimg = $img->copy();
  17 ok($nimg, "copy returned something");
  18
  19 # test if ->copy() works
  20
  21 my $diff = Imager::i_img_diff($img->{IMG}, $nimg->{IMG});
  22 is_image($img, $nimg, "copy matches source");
  23
  24 # test if ->flip(dir=>'h')->flip(dir=>'h') doesn't alter the image
  25 $nimg->flip(dir=>"h")->flip(dir=>"h");
  26 is_image($nimg, $img, "double horiz flipped matches original");
  27
  28 # test if ->flip(dir=>'v')->flip(dir=>'v') doesn't alter the image
  29 $nimg->flip(dir=>"v")->flip(dir=>"v");
  30 is_image($nimg, $img, "double vertically flipped image matches original");
  31
  32
  33 # test if ->flip(dir=>'h')->flip(dir=>'v') is same as ->flip(dir=>'hv')
  34 $nimg->flip(dir=>"v")->flip(dir=>"h")->flip(dir=>"hv");;
  35 is_image($img, $nimg, "check flip with hv matches flip v then flip h");
  36
  37 {
  38   my $imsrc = test_image_double;
  39   my $imcp = $imsrc->copy;
  40   is_imaged($imsrc, $imcp, "copy double image");
  41   $imcp->flip(dir=>"v")->flip(dir=>"v");
  42   is_imaged($imsrc, $imcp, "flip v twice");
  43   $imcp->flip(dir=>"h")->flip(dir=>"h");
  44   is_imaged($imsrc, $imcp, "flip h twice");
  45   $imcp->flip(dir=>"h")->flip(dir=>"v")->flip(dir=>"hv");
  46   is_imaged($imsrc, $imcp, "flip h,v,hv twice");
  47 }
  48
  49 {
  50   my $impal = test_image()->to_paletted;
  51   my $imcp = $impal->copy;
  52   is($impal->type, "paletted", "check paletted test image is");
  53   is($imcp->type, "paletted", "check copy test image is paletted");
  54   ok($impal->flip(dir => "h"), "flip paletted h");
  55   isnt_image($impal, $imcp, "check it changed");
  56   ok($impal->flip(dir => "v"), "flip paletted v");
  57   ok($impal->flip(dir => "hv"), "flip paletted hv");
  58   is_image($impal, $imcp, "should be back to original image");
  59   is($impal->type, "paletted", "and still paletted");
  60 }
  61
  62 rot_test($img, 90, 4);
  63 rot_test($img, 180, 2);
  64 rot_test($img, 270, 4);
  65 rot_test($img, 0, 1);
  66
  67 my $pimg = $img->to_paletted();
  68 rot_test($pimg, 90, 4);
  69 rot_test($pimg, 180, 2);
  70 rot_test($pimg, 270, 4);
  71 rot_test($pimg, 0, 1);
  72
  73 my $timg = $img->rotate(right=>90)->rotate(right=>270);
  74 is(Imager::i_img_diff($img->{IMG}, $timg->{IMG}), 0,
  75    "check rotate 90 then 270 matches original");
  76 $timg = $img->rotate(right=>90)->rotate(right=>180)->rotate(right=>90);
  77 is(Imager::i_img_diff($img->{IMG}, $timg->{IMG}), 0,
  78      "check rotate 90 then 180 then 90 matches original");
  79
  80 # this could use more tests
  81 my $rimg = $img->rotate(degrees=>10);
  82 ok($rimg, "rotation by 10 degrees gave us an image");
  83 if (!$rimg->write(file=>"testout/t64_rot10.ppm")) {
  84   print "# Cannot save: ",$rimg->errstr,"\n";
  85 }
  86
  87 # rotate with background
  88 $rimg = $img->rotate(degrees=>10, back=>Imager::Color->new(builtin=>'red'));
  89 ok($rimg, "rotate with background gave us an image");
  90 if (!$rimg->write(file=>"testout/t64_rot10_back.ppm")) {
  91   print "# Cannot save: ",$rimg->errstr,"\n";
  92 }
  93
  94 {
  95   # rotate with text background
  96   my $rimg = $img->rotate(degrees => 45, back => '#FF00FF');
  97   ok($rimg, "rotate with background as text gave us an image");
  98
  99   # check the color set correctly
 100   my $c = $rimg->getpixel(x => 0, 'y' => 0);
 101   is_deeply([ 255, 0, 255 ], [ ($c->rgba)[0, 1, 2] ],
 102             "check background set correctly");
 103
 104   # check error handling for background color
 105   $rimg = $img->rotate(degrees => 45, back => "some really unknown color");
 106   ok(!$rimg, "should fail due to bad back color");
 107   cmp_ok($img->errstr, '=~', "^No color named ", "check error message");
 108 }
 109
 110 my $trimg = $img->matrix_transform(matrix=>[ 1.2, 0, 0,
 111                                              0,   1, 0,
 112                                              0,   0, 1]);
 113 ok($trimg, "matrix_transform() returned an image");
 114 $trimg->write(file=>"testout/t64_trans.ppm")
 115   or print "# Cannot save: ",$trimg->errstr,"\n";
 116
 117 $trimg = $img->matrix_transform(matrix=>[ 1.2, 0, 0,
 118                                              0,   1, 0,
 119                                              0,   0, 1],
 120                                    back=>Imager::Color->new(builtin=>'blue'));
 121 ok($trimg, "matrix_transform() with back returned an image");
 122
 123 $trimg->write(file=>"testout/t64_trans_back.ppm")
 124   or print "# Cannot save: ",$trimg->errstr,"\n";
 125
 126 sub rot_test {
 127   my ($src, $degrees, $count) = @_;
 128
 129   my $cimg = $src->copy();
 130   my $in;
 131   for (1..$count) {
 132     $in = $cimg;
 133     $cimg = $cimg->rotate(right=>$degrees)
 134       or last;
 135   }
 136  SKIP:
 137   {
 138     ok($cimg, "got a rotated image")
 139       or skip("no image to check", 4);
 140     my $diff = Imager::i_img_diff($src->{IMG}, $cimg->{IMG});
 141     is($diff, 0, "check it matches source")
 142       or skip("didn't match", 3);
 143
 144     # check that other parameters match
 145     is($src->type, $cimg->type, "type check");
 146     is($src->bits, $cimg->bits, "bits check");
 147     is($src->getchannels, $cimg->getchannels, "channels check");
 148   }
 149 }
 150
 151 { # http://rt.cpan.org/NoAuth/Bug.html?id=9672
 152   my $warning;
 153   local $SIG{__WARN__} =
 154     sub {
 155       $warning = "@_";
 156       my $printed = $warning;
 157       $printed =~ s/\n$//;
 158       $printed =~ s/\n/\n\#/g;
 159       print "# ",$printed, "\n";
 160     };
 161   my $img = Imager->new(xsize=>10, ysize=>10);
 162   $img->copy();
 163   cmp_ok($warning, '=~', 'void', "correct warning");
 164   cmp_ok($warning, '=~', 't64copyflip\\.t', "correct file");
 165   $warning = '';
 166   $img->rotate(degrees=>5);
 167   cmp_ok($warning, '=~', 'void', "correct warning");
 168   cmp_ok($warning, '=~', 't64copyflip\\.t', "correct file");
 169   $warning = '';
 170   $img->matrix_transform(matrix=>[1, 1, 1]);
 171   cmp_ok($warning, '=~', 'void', "correct warning");
 172   cmp_ok($warning, '=~', 't64copyflip\\.t', "correct file");
 173 }
 174
 175 {
 176   # 29936 - matrix_transform() should use fabs() instead of abs()
 177   # range checking sz
 178
 179   # this meant that when sz was < 1 (which it often is for these
 180   # transformations), it treated the values out of range, producing a
 181   # blank output image
 182
 183   my $src = Imager->new(xsize => 20, ysize => 20);
 184   $src->box(filled => 1, color => 'FF0000');
 185   my $out = $src->matrix_transform(matrix => [ 1, 0, 0,
 186                                                0, 1, 0,
 187                                                0, 0, 0.9999 ])
 188     or print "# ", $src->errstr, "\n";
 189   my $blank = Imager->new(xsize => 20, ysize => 20);
 190   # they have to be different, surely that would be easy
 191   my $diff = Imager::i_img_diff($out->{IMG}, $blank->{IMG});
 192   ok($diff, "RT#29936 - check non-blank output");
 193 }
 194
 195 {
 196   my $im = Imager->new(xsize => 10, ysize => 10, channels => 4);
 197   $im->box(filled => 1, color => 'FF0000');
 198   my $back = Imager::Color->new(0, 0, 0, 0);
 199   my $rot = $im->rotate(degrees => 10, back => $back);
 200   # drop the alpha and make sure there's only 2 colors used
 201   my $work = $rot->convert(preset => 'noalpha');
 202   my $im_pal = $work->to_paletted(make_colors => 'mediancut');
 203   my @colors = $im_pal->getcolors;
 204   is(@colors, 2, "should be only 2 colors")
 205     or do {
 206       print "# ", join(",", $_->rgba), "\n" for @colors;
 207     };
 208   @colors = sort { ($a->rgba)[0] <=> ($b->rgba)[0] } @colors;
 209   is_color3($colors[0], 0, 0, 0, "check we got black");
 210   is_color3($colors[1], 255, 0, 0, "and red");
 211 }