t/t69rubthru.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 76;
   4 use Imager qw(:all :handy);
   5 use Imager::Test qw(is_image);
   6
   7 -d "testout" or mkdir "testout";
   8
   9 init_log("testout/t69rubthru.log", 1);
  10
  11 my $src_height = 80;
  12 my $src_width = 80;
  13
  14 # raw interface
  15 my $targ = Imager::ImgRaw::new(100, 100, 3);
  16 my $src = Imager::ImgRaw::new($src_height, $src_width, 4);
  17 my $halfred = NC(255, 0, 0, 128);
  18 i_box_filled($src, 20, 20, 60, 60, $halfred);
  19 ok(i_rubthru($targ, $src, 10, 10, 0, 0, $src_width, $src_height),
  20    "low level rubthrough");
  21 my $c = Imager::i_get_pixel($targ, 10, 10);
  22 ok($c, "get pixel at (10, 10)");
  23 ok(color_cmp($c, NC(0, 0, 0)) == 0, "check for correct color");
  24 $c = Imager::i_get_pixel($targ, 30, 30);
  25 ok($c, "get pixel at (30, 30)");
  26 ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");
  27
  28 my $black = NC(0, 0, 0);
  29 # reset the target and try a grey+alpha source
  30 i_box_filled($targ, 0, 0, 100, 100, $black);
  31 my $gsrc = Imager::ImgRaw::new($src_width, $src_height, 2);
  32 my $halfwhite = NC(255, 128, 0);
  33 i_box_filled($gsrc, 20, 20, 60, 60, $halfwhite);
  34 ok(i_rubthru($targ, $gsrc, 10, 10, 0, 0, $src_width, $src_height),
  35    "low level with grey/alpha source");
  36 $c = Imager::i_get_pixel($targ, 15, 15);
  37 ok($c, "get at (15, 15)");
  38 ok(color_cmp($c, NC(0, 0, 0)) == 0, "check color");
  39 $c = Imager::i_get_pixel($targ, 30, 30);
  40 ok($c, "get pixel at (30, 30)");
  41 ok(color_cmp($c, NC(128, 128, 128)) == 0, "check color");
  42
  43 # try grey target and grey alpha source
  44 my $gtarg = Imager::ImgRaw::new(100, 100, 1);
  45 ok(i_rubthru($gtarg, $gsrc, 10, 10, 0, 0, $src_width, $src_height),
  46    "low level with grey target and gray/alpha source");
  47 $c = Imager::i_get_pixel($gtarg, 10, 10);
  48 ok($c, "get pixel at 10, 10");
  49 is(($c->rgba)[0], 0, "check grey level");
  50 is((Imager::i_get_pixel($gtarg, 30, 30)->rgba)[0], 128,
  51    "check grey level at 30, 30");
  52
  53 # simple test for 16-bit/sample images
  54 my $targ16 = Imager::i_img_16_new(100, 100, 3);
  55 ok(i_rubthru($targ16, $src, 10, 10, 0, 0, $src_width, $src_height),
  56    "smoke test vs 16-bit/sample image");
  57 $c = Imager::i_get_pixel($targ16, 30, 30);
  58 ok($c, "get pixel at 30, 30");
  59 ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");
  60
  61 # check the OO interface
  62 my $ootarg = Imager->new(xsize=>100, ysize=>100);
  63 my $oosrc = Imager->new(xsize=>80, ysize=>80, channels=>4);
  64 $oosrc->box(color=>$halfred, xmin=>20, ymin=>20, xmax=>60, ymax=>60,
  65             filled=>1);
  66 ok($ootarg->rubthrough(src=>$oosrc, tx=>10, ty=>10),
  67    "oo rubthrough");
  68 ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 10, 10), NC(0, 0, 0)) == 0,
  69    "check pixel at 10, 10");
  70 ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 30, 30), NC(128, 0, 0)) == 0,
  71    "check pixel at 30, 30");
  72
  73 my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1);
  74
  75 { # check empty image errors
  76   my $empty = Imager->new;
  77   ok(!$empty->rubthrough(src => $oosrc), "check empty target");
  78   is($empty->errstr, 'rubthrough: empty input image', "check error message");
  79   ok(!$oogtarg->rubthrough(src=>$empty), "check empty source");
  80   is($oogtarg->errstr, 'rubthrough: empty input image (for src)',
  81      "check error message");
  82 }
  83
  84 {
  85   # alpha source and target
  86   for my $method (qw/rubthrough compose/) {
  87
  88     my $src = Imager->new(xsize => 10, ysize => 1, channels => 4);
  89     my $targ = Imager->new(xsize => 10, ysize => 2, channels => 4);
  90
  91     # simple initialization
  92     $targ->setscanline('y' => 1, x => 1,
  93                        pixels =>
  94                        [
  95                         NC(255, 128, 0, 255),
  96                         NC(255, 128, 0, 128),
  97                         NC(255, 128, 0, 0),
  98                         NC(255, 128, 0, 255),
  99                         NC(255, 128, 0, 128),
 100                         NC(255, 128, 0, 0),
 101                         NC(255, 128, 0, 255),
 102                         NC(255, 128, 0, 128),
 103                         NC(255, 128, 0, 0),
 104                        ]);
 105     $src->setscanline('y' => 0,
 106                       pixels =>
 107                       [
 108                        NC(0, 128, 255, 0),
 109                        NC(0, 128, 255, 0),
 110                        NC(0, 128, 255, 0),
 111                        NC(0, 128, 255, 128),
 112                        NC(0, 128, 255, 128),
 113                        NC(0, 128, 255, 128),
 114                        NC(0, 128, 255, 255),
 115                        NC(0, 128, 255, 255),
 116                        NC(0, 128, 255, 255),
 117                       ]);
 118     ok($targ->$method(src => $src, combine => 'normal',
 119                       tx => 1, ty => 1), "do 4 on 4 $method");
 120     iscolora($targ->getpixel(x => 1, 'y' => 1), NC(255, 128, 0, 255),
 121              "check at zero source coverage on full targ coverage");
 122     iscolora($targ->getpixel(x => 2, 'y' => 1), NC(255, 128, 0, 128),
 123              "check at zero source coverage on half targ coverage");
 124     iscolora($targ->getpixel(x => 3, 'y' => 1), NC(255, 128, 0, 0),
 125              "check at zero source coverage on zero targ coverage");
 126     iscolora($targ->getpixel(x => 4, 'y' => 1), NC(127, 128, 128, 255),
 127              "check at half source_coverage on full targ coverage");
 128     iscolora($targ->getpixel(x => 5, 'y' => 1), NC(85, 128, 170, 191),
 129              "check at half source coverage on half targ coverage");
 130     iscolora($targ->getpixel(x => 6, 'y' => 1), NC(0, 128, 255, 128),
 131              "check at half source coverage on zero targ coverage");
 132     iscolora($targ->getpixel(x => 7, 'y' => 1), NC(0, 128, 255, 255),
 133              "check at full source_coverage on full targ coverage");
 134     iscolora($targ->getpixel(x => 8, 'y' => 1), NC(0, 128, 255, 255),
 135              "check at full source coverage on half targ coverage");
 136     iscolora($targ->getpixel(x => 9, 'y' => 1), NC(0, 128, 255, 255),
 137              "check at full source coverage on zero targ coverage");
 138   }
 139 }
 140
 141 { # https://rt.cpan.org/Ticket/Display.html?id=30908
 142   # we now adapt the source channels to the target
 143   # check each combination works as expected
 144
 145   # various source images
 146   my $src1 = Imager->new(xsize => 50, ysize => 50, channels => 1);
 147   my $g_grey_full = Imager::Color->new(128, 255, 0, 0);
 148   my $g_white_50 = Imager::Color->new(255, 128, 0, 0);
 149   $src1->box(filled => 1, xmax => 24, color => $g_grey_full);
 150
 151   my $src2 = Imager->new(xsize => 50, ysize => 50, channels => 2);
 152   $src2->box(filled => 1, xmax => 24, color => $g_grey_full);
 153   $src2->box(filled => 1, xmin => 25, color => $g_white_50);
 154
 155   my $c_red_full = Imager::Color->new(255, 0, 0);
 156   my $c_blue_full = Imager::Color->new(0, 0, 255);
 157   my $src3 = Imager->new(xsize => 50, ysize => 50, channels => 3);
 158   $src3->box(filled => 1, xmax => 24, color => $c_red_full);
 159   $src3->box(filled => 1, xmin => 25, color => $c_blue_full);
 160
 161   my $c_green_50 = Imager::Color->new(0, 255, 0, 127);
 162   my $src4 = Imager->new(xsize => 50, ysize => 50, channels => 4);
 163   $src4->box(filled => 1, xmax => 24, color => $c_blue_full);
 164   $src4->box(filled => 1, xmin => 25, color => $c_green_50);
 165
 166   my @left_box = ( box => [ 25, 25, 49, 74 ] );
 167   my @right_box = ( box => [ 50, 25, 74, 74 ] );
 168
 169   { # 1 channel output
 170     my $base = Imager->new(xsize => 100, ysize => 100, channels => 1);
 171     $base->box(filled => 1, color => Imager::Color->new(64, 255, 0, 0));
 172
 173     my $work = $base->copy;
 174     ok($work->rubthrough(left => 25, top => 25, src => $src1), "rubthrough 1 to 1");
 175     my $comp = $base->copy;
 176     $comp->box(filled => 1, color => $g_grey_full, @left_box);
 177     $comp->box(filled => 1, color => [ 0, 0, 0, 0 ], @right_box);
 178     is_image($work, $comp, "compare rubthrough target to expected");
 179
 180     $work = $base->copy;
 181     ok($work->rubthrough(left => 25, top => 25, src => $src2), "rubthrough 2 to 1");
 182     $comp = $base->copy;
 183     $comp->box(filled => 1, @left_box, color => $g_grey_full);
 184     $comp->box(filled => 1, @right_box, color => [ 159, 0, 0, 0 ]);
 185     is_image($work, $comp, "compare rubthrough target to expected");
 186
 187     $work = $base->copy;
 188     ok($work->rubthrough(left => 25, top => 25, src => $src3), "rubthrough 3 to 1");
 189      $comp = $base->copy;
 190     $comp->box(filled => 1, @left_box, color => [ 57, 255, 0, 0 ]);
 191     $comp->box(filled => 1, @right_box, color => [ 18, 255, 0, 0 ]);
 192     is_image($work, $comp, "compare rubthrough target to expected");
 193
 194     $work = $base->copy;
 195     ok($work->rubthrough(left => 25, top => 25, src => $src4), "rubthrough 4 to 1");
 196     $comp = $base->copy;
 197     $comp->box(filled => 1, color => [ 18, 255, 0, 0 ], @left_box);
 198     $comp->box(filled => 1, color => [ 121, 255, 0, 0 ], @right_box);
 199     is_image($work, $comp, "compare rubthrough target to expected");
 200   }
 201
 202   { # 2 channel output
 203     my $base = Imager->new(xsize => 100, ysize => 100, channels => 2);
 204     $base->box(filled => 1, color => [ 128, 128, 0, 0 ]);
 205
 206     my $work = $base->copy;
 207     ok($work->rubthrough(top => 25, left => 25, src => $src1), "rubthrough 1 to 2");
 208     my $comp = $base->copy;
 209     $comp->box(filled => 1, color => $g_grey_full, @left_box);
 210     $comp->box(filled => 1, color => [ 0, 255, 0, 0 ], @right_box);
 211     is_image($work, $comp, "compare rubthrough target to expected");
 212
 213     $work = $base->copy;
 214     ok($work->rubthrough(top => 25, left => 25, src => $src2), "rubthrough 2 to 2");
 215     $comp = $base->copy;
 216     $comp->box(filled => 1, color => $g_grey_full, @left_box);
 217     $comp->box(filled => 1, color => [ 213, 191, 0, 0 ], @right_box);
 218     is_image($work, $comp, "compare rubthrough target to expected");
 219
 220     $work = $base->copy;
 221     ok($work->rubthrough(top => 25, left => 25, src => $src3), "rubthrough 3 to 2");
 222     $comp = $base->copy;
 223     $comp->box(filled => 1, color => [ 57, 255, 0, 0 ], @left_box);
 224     $comp->box(filled => 1, color => [ 18, 255, 0, 0 ], @right_box);
 225     is_image($work, $comp, "compare rubthrough target to expected");
 226
 227     $work = $base->copy;
 228     ok($work->rubthrough(top => 25, left => 25, src => $src4), "rubthrough 4 to 2");
 229     $comp = $base->copy;
 230     $comp->box(filled => 1, color => [ 18, 255, 0, 0 ], @left_box);
 231     $comp->box(filled => 1, color => [ 162, 191, 0, 0 ], @right_box);
 232     is_image($work, $comp, "compare rubthrough target to expected");
 233   }
 234
 235   { # 3 channel output
 236     my $base = Imager->new(xsize => 100, ysize => 100, channels => 3);
 237     $base->box(filled => 1, color => [ 128, 255, 0, 0 ]);
 238
 239     my $work = $base->copy;
 240     ok($work->rubthrough(top => 25, left => 25, src => $src1), "rubthrough 1 to 3");
 241     my $comp = $base->copy;
 242     $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
 243     $comp->box(filled => 1, color => [ 0, 0, 0, 0 ], @right_box);
 244     is_image($work, $comp, "compare rubthrough target to expected");
 245
 246     $work = $base->copy;
 247     ok($work->rubthrough(top => 25, left => 25, src => $src2), "rubthrough 2 to 3");
 248     $comp = $base->copy;
 249     $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
 250     $comp->box(filled => 1, color => [ 191, 255, 128, 255 ], @right_box);
 251     is_image($work, $comp, "compare rubthrough target to expected");
 252
 253     $work = $base->copy;
 254     ok($work->rubthrough(top => 25, left => 25, src => $src3), "rubthrough 3 to 3");
 255     $comp = $base->copy;
 256     $comp->box(filled => 1, color => [ 255, 0, 0 ], @left_box);
 257     $comp->box(filled => 1, color => [ 0, 0, 255 ], @right_box);
 258     is_image($work, $comp, "compare rubthrough target to expected");
 259
 260     $work = $base->copy;
 261     ok($work->rubthrough(top => 25, left => 25, src => $src4), "rubthrough 4 to 3");
 262     $comp = $base->copy;
 263     $comp->box(filled => 1, color => [ 0, 0, 255 ], @left_box);
 264     $comp->box(filled => 1, color => [ 64, 255, 0 ], @right_box);
 265     is_image($work, $comp, "compare rubthrough target to expected");
 266   }
 267
 268   { # 4 channel output
 269     my $base = Imager->new(xsize => 100, ysize => 100, channels => 4);
 270     $base->box(filled => 1, color => [ 128, 255, 64, 128 ]);
 271
 272     my $work = $base->copy;
 273     ok($work->rubthrough(top => 25, left => 25, src => $src1), "rubthrough 1 to 4");
 274     my $comp = $base->copy;
 275     $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
 276     $comp->box(filled => 1, color => [ 0, 0, 0, 255 ], @right_box);
 277     is_image($work, $comp, "compare rubthrough target to expected");
 278
 279     $work = $base->copy;
 280     ok($work->rubthrough(top => 25, left => 25, src => $src2), "rubthrough 2 to 4");
 281     $comp = $base->copy;
 282     $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
 283     $comp->box(filled => 1, color => [ 213, 255, 192, 191 ], @right_box);
 284     is_image($work, $comp, "compare rubthrough target to expected");
 285
 286     $work = $base->copy;
 287     ok($work->rubthrough(top => 25, left => 25, src => $src3), "rubthrough 3 to 4");
 288     $comp = $base->copy;
 289     $comp->box(filled => 1, color => [ 255, 0, 0 ], @left_box);
 290     $comp->box(filled => 1, color => [ 0, 0, 255 ], @right_box);
 291     is_image($work, $comp, "compare rubthrough target to expected");
 292
 293     $work = $base->copy;
 294     ok($work->rubthrough(top => 25, left => 25, src => $src4), "rubthrough 4 to 4");
 295     $comp = $base->copy;
 296     $comp->box(filled => 1, color => $c_blue_full, @left_box);
 297     $comp->box(filled => 1, color => [ 43, 255, 21, 191], @right_box);
 298     is_image($work, $comp, "compare rubthrough target to expected");
 299   }
 300 }
 301
 302 sub color_cmp {
 303   my ($l, $r) = @_;
 304   my @l = $l->rgba;
 305   my @r = $r->rgba;
 306   print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
 307   return $l[0] <=> $r[0]
 308     || $l[1] <=> $r[1]
 309       || $l[2] <=> $r[2];
 310 }
 311
 312 sub iscolora {
 313   my ($c1, $c2, $msg) = @_;
 314
 315   my $builder = Test::Builder->new;
 316   my @c1 = $c1->rgba;
 317   my @c2 = $c2->rgba;
 318   if (!$builder->ok($c1[0] == $c2[0] && $c1[1] == $c2[1] && $c1[2] == $c2[2]
 319                     && $c1[3] == $c2[3],
 320                     $msg)) {
 321     $builder->diag(<<DIAG);
 322       got color: [ @c1 ]
 323  expected color: [ @c2 ]
 324 DIAG
 325   }
 326 }
 327