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