[imager.git] / t / t69rubthru.t

#!perl -w
use strict;
use Test::More tests => 76;
use Imager qw(:all :handy);
use Imager::Test qw(is_image);

-d "testout" or mkdir "testout";

init_log("testout/t69rubthru.log", 1);

my $src_height = 80;
my $src_width = 80;

# raw interface
my $targ = Imager::ImgRaw::new(100, 100, 3);
my $src = Imager::ImgRaw::new($src_height, $src_width, 4);
my $halfred = NC(255, 0, 0, 128);
i_box_filled($src, 20, 20, 60, 60, $halfred);
ok(i_rubthru($targ, $src, 10, 10, 0, 0, $src_width, $src_height),
   "low level rubthrough");
my $c = Imager::i_get_pixel($targ, 10, 10);
ok($c, "get pixel at (10, 10)");
ok(color_cmp($c, NC(0, 0, 0)) == 0, "check for correct color");
$c = Imager::i_get_pixel($targ, 30, 30);
ok($c, "get pixel at (30, 30)");
ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");

my $black = NC(0, 0, 0);
# reset the target and try a grey+alpha source
i_box_filled($targ, 0, 0, 100, 100, $black);
my $gsrc = Imager::ImgRaw::new($src_width, $src_height, 2);
my $halfwhite = NC(255, 128, 0);
i_box_filled($gsrc, 20, 20, 60, 60, $halfwhite);
ok(i_rubthru($targ, $gsrc, 10, 10, 0, 0, $src_width, $src_height),
   "low level with grey/alpha source");
$c = Imager::i_get_pixel($targ, 15, 15);
ok($c, "get at (15, 15)");
ok(color_cmp($c, NC(0, 0, 0)) == 0, "check color");
$c = Imager::i_get_pixel($targ, 30, 30);
ok($c, "get pixel at (30, 30)");
ok(color_cmp($c, NC(128, 128, 128)) == 0, "check color");

# try grey target and grey alpha source
my $gtarg = Imager::ImgRaw::new(100, 100, 1);
ok(i_rubthru($gtarg, $gsrc, 10, 10, 0, 0, $src_width, $src_height), 
   "low level with grey target and gray/alpha source");
$c = Imager::i_get_pixel($gtarg, 10, 10);
ok($c, "get pixel at 10, 10");
is(($c->rgba)[0], 0, "check grey level");
is((Imager::i_get_pixel($gtarg, 30, 30)->rgba)[0], 128,
   "check grey level at 30, 30");

# simple test for 16-bit/sample images
my $targ16 = Imager::i_img_16_new(100, 100, 3);
ok(i_rubthru($targ16, $src, 10, 10, 0, 0, $src_width, $src_height),
   "smoke test vs 16-bit/sample image");
$c = Imager::i_get_pixel($targ16, 30, 30);
ok($c, "get pixel at 30, 30");
ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");

# check the OO interface
my $ootarg = Imager->new(xsize=>100, ysize=>100);
my $oosrc = Imager->new(xsize=>80, ysize=>80, channels=>4);
$oosrc->box(color=>$halfred, xmin=>20, ymin=>20, xmax=>60, ymax=>60,
            filled=>1);
ok($ootarg->rubthrough(src=>$oosrc, tx=>10, ty=>10),
   "oo rubthrough");
ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 10, 10), NC(0, 0, 0)) == 0,
   "check pixel at 10, 10");
ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 30, 30), NC(128, 0, 0)) == 0,
   "check pixel at 30, 30");

my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1);

{ # check empty image errors
  my $empty = Imager->new;
  ok(!$empty->rubthrough(src => $oosrc), "check empty target");
  is($empty->errstr, 'rubthrough: empty input image', "check error message");
  ok(!$oogtarg->rubthrough(src=>$empty), "check empty source");
  is($oogtarg->errstr, 'rubthrough: empty input image (for src)',
     "check error message");
}

{
  # alpha source and target
  for my $method (qw/rubthrough compose/) {

    my $src = Imager->new(xsize => 10, ysize => 1, channels => 4);
    my $targ = Imager->new(xsize => 10, ysize => 2, channels => 4);

    # simple initialization
    $targ->setscanline('y' => 1, x => 1,
		       pixels =>
		       [
			NC(255, 128, 0, 255),
			NC(255, 128, 0, 128),
			NC(255, 128, 0, 0),
			NC(255, 128, 0, 255),
			NC(255, 128, 0, 128),
			NC(255, 128, 0, 0),
			NC(255, 128, 0, 255),
			NC(255, 128, 0, 128),
			NC(255, 128, 0, 0),
		       ]);
    $src->setscanline('y' => 0,
		      pixels =>
		      [
		       NC(0, 128, 255, 0),
		       NC(0, 128, 255, 0),
		       NC(0, 128, 255, 0),
		       NC(0, 128, 255, 128),
		       NC(0, 128, 255, 128),
		       NC(0, 128, 255, 128),
		       NC(0, 128, 255, 255),
		       NC(0, 128, 255, 255),
		       NC(0, 128, 255, 255),
		      ]);
    ok($targ->$method(src => $src, combine => 'normal',
		      tx => 1, ty => 1), "do 4 on 4 $method");
    iscolora($targ->getpixel(x => 1, 'y' => 1), NC(255, 128, 0, 255),
	     "check at zero source coverage on full targ coverage");
    iscolora($targ->getpixel(x => 2, 'y' => 1), NC(255, 128, 0, 128),
	     "check at zero source coverage on half targ coverage");
    iscolora($targ->getpixel(x => 3, 'y' => 1), NC(255, 128, 0, 0),
	     "check at zero source coverage on zero targ coverage");
    iscolora($targ->getpixel(x => 4, 'y' => 1), NC(127, 128, 128, 255),
	     "check at half source_coverage on full targ coverage");
    iscolora($targ->getpixel(x => 5, 'y' => 1), NC(85, 128, 170, 191),
	     "check at half source coverage on half targ coverage");
    iscolora($targ->getpixel(x => 6, 'y' => 1), NC(0, 128, 255, 128),
	     "check at half source coverage on zero targ coverage");
    iscolora($targ->getpixel(x => 7, 'y' => 1), NC(0, 128, 255, 255),
	     "check at full source_coverage on full targ coverage");
    iscolora($targ->getpixel(x => 8, 'y' => 1), NC(0, 128, 255, 255),
	     "check at full source coverage on half targ coverage");
    iscolora($targ->getpixel(x => 9, 'y' => 1), NC(0, 128, 255, 255),
	     "check at full source coverage on zero targ coverage");
  }
}

{ # https://rt.cpan.org/Ticket/Display.html?id=30908
  # we now adapt the source channels to the target
  # check each combination works as expected

  # various source images
  my $src1 = Imager->new(xsize => 50, ysize => 50, channels => 1);
  my $g_grey_full = Imager::Color->new(128, 255, 0, 0);
  my $g_white_50 = Imager::Color->new(255, 128, 0, 0);
  $src1->box(filled => 1, xmax => 24, color => $g_grey_full);

  my $src2 = Imager->new(xsize => 50, ysize => 50, channels => 2);
  $src2->box(filled => 1, xmax => 24, color => $g_grey_full);
  $src2->box(filled => 1, xmin => 25, color => $g_white_50);

  my $c_red_full = Imager::Color->new(255, 0, 0);
  my $c_blue_full = Imager::Color->new(0, 0, 255);
  my $src3 = Imager->new(xsize => 50, ysize => 50, channels => 3);
  $src3->box(filled => 1, xmax => 24, color => $c_red_full);
  $src3->box(filled => 1, xmin => 25, color => $c_blue_full);

  my $c_green_50 = Imager::Color->new(0, 255, 0, 127);
  my $src4 = Imager->new(xsize => 50, ysize => 50, channels => 4);
  $src4->box(filled => 1, xmax => 24, color => $c_blue_full);
  $src4->box(filled => 1, xmin => 25, color => $c_green_50);

  my @left_box = ( box => [ 25, 25, 49, 74 ] );
  my @right_box = ( box => [ 50, 25, 74, 74 ] );

  { # 1 channel output
    my $base = Imager->new(xsize => 100, ysize => 100, channels => 1);
    $base->box(filled => 1, color => Imager::Color->new(64, 255, 0, 0));

    my $work = $base->copy;
    ok($work->rubthrough(left => 25, top => 25, src => $src1), "rubthrough 1 to 1");
    my $comp = $base->copy;
    $comp->box(filled => 1, color => $g_grey_full, @left_box);
    $comp->box(filled => 1, color => [ 0, 0, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(left => 25, top => 25, src => $src2), "rubthrough 2 to 1");
    $comp = $base->copy;
    $comp->box(filled => 1, @left_box, color => $g_grey_full);
    $comp->box(filled => 1, @right_box, color => [ 159, 0, 0, 0 ]);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(left => 25, top => 25, src => $src3), "rubthrough 3 to 1");
     $comp = $base->copy;
    $comp->box(filled => 1, @left_box, color => [ 57, 255, 0, 0 ]);
    $comp->box(filled => 1, @right_box, color => [ 18, 255, 0, 0 ]);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(left => 25, top => 25, src => $src4), "rubthrough 4 to 1");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 18, 255, 0, 0 ], @left_box);
    $comp->box(filled => 1, color => [ 121, 255, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");
  }

  { # 2 channel output
    my $base = Imager->new(xsize => 100, ysize => 100, channels => 2);
    $base->box(filled => 1, color => [ 128, 128, 0, 0 ]);
    
    my $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src1), "rubthrough 1 to 2");
    my $comp = $base->copy;
    $comp->box(filled => 1, color => $g_grey_full, @left_box);
    $comp->box(filled => 1, color => [ 0, 255, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src2), "rubthrough 2 to 2");
    $comp = $base->copy;
    $comp->box(filled => 1, color => $g_grey_full, @left_box);
    $comp->box(filled => 1, color => [ 213, 191, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src3), "rubthrough 3 to 2");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 57, 255, 0, 0 ], @left_box);
    $comp->box(filled => 1, color => [ 18, 255, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src4), "rubthrough 4 to 2");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 18, 255, 0, 0 ], @left_box);
    $comp->box(filled => 1, color => [ 162, 191, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");
  }

  { # 3 channel output
    my $base = Imager->new(xsize => 100, ysize => 100, channels => 3);
    $base->box(filled => 1, color => [ 128, 255, 0, 0 ]);
    
    my $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src1), "rubthrough 1 to 3");
    my $comp = $base->copy;
    $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
    $comp->box(filled => 1, color => [ 0, 0, 0, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src2), "rubthrough 2 to 3");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
    $comp->box(filled => 1, color => [ 191, 255, 128, 255 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src3), "rubthrough 3 to 3");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 255, 0, 0 ], @left_box);
    $comp->box(filled => 1, color => [ 0, 0, 255 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src4), "rubthrough 4 to 3");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 0, 0, 255 ], @left_box);
    $comp->box(filled => 1, color => [ 64, 255, 0 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");
  }

  { # 4 channel output
    my $base = Imager->new(xsize => 100, ysize => 100, channels => 4);
    $base->box(filled => 1, color => [ 128, 255, 64, 128 ]);
    
    my $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src1), "rubthrough 1 to 4");
    my $comp = $base->copy;
    $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
    $comp->box(filled => 1, color => [ 0, 0, 0, 255 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src2), "rubthrough 2 to 4");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 128, 128, 128, 255 ], @left_box);
    $comp->box(filled => 1, color => [ 213, 255, 192, 191 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src3), "rubthrough 3 to 4");
    $comp = $base->copy;
    $comp->box(filled => 1, color => [ 255, 0, 0 ], @left_box);
    $comp->box(filled => 1, color => [ 0, 0, 255 ], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");

    $work = $base->copy;
    ok($work->rubthrough(top => 25, left => 25, src => $src4), "rubthrough 4 to 4");
    $comp = $base->copy;
    $comp->box(filled => 1, color => $c_blue_full, @left_box);
    $comp->box(filled => 1, color => [ 43, 255, 21, 191], @right_box);
    is_image($work, $comp, "compare rubthrough target to expected");
  }
}

sub color_cmp {
  my ($l, $r) = @_;
  my @l = $l->rgba;
  my @r = $r->rgba;
  print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
  return $l[0] <=> $r[0]
    || $l[1] <=> $r[1]
      || $l[2] <=> $r[2];
}

sub iscolora {
  my ($c1, $c2, $msg) = @_;

  my $builder = Test::Builder->new;
  my @c1 = $c1->rgba;
  my @c2 = $c2->rgba;
  if (!$builder->ok($c1[0] == $c2[0] && $c1[1] == $c2[1] && $c1[2] == $c2[2]
                    && $c1[3] == $c2[3],
                    $msg)) {
    $builder->diag(<<DIAG);
      got color: [ @c1 ]
 expected color: [ @c2 ]
DIAG
  }
}
Commit	Line	Data
faa9b3e7	1	#!perl -w
3ce1204d	2	use strict;
9b1ec2b8 TC	3	use Test::More tests => 76;
	4	use Imager qw(:all :handy);
	5	use Imager::Test qw(is_image);
faa9b3e7	6
40e78f96 TC	7	-d "testout" or mkdir "testout";
40e78f96 TC	8
faa9b3e7 TC	9	init_log("testout/t69rubthru.log", 1);
faa9b3e7 TC	10
71dc4a83 AMH	11	my $src_height = 80;
	12	my $src_width = 80;
	13
faa9b3e7 TC	14	# raw interface
faa9b3e7 TC	15	my $targ = Imager::ImgRaw::new(100, 100, 3);
71dc4a83	16	my $src = Imager::ImgRaw::new($src_height, $src_width, 4);
faa9b3e7 TC	17	my $halfred = NC(255, 0, 0, 128);
faa9b3e7 TC	18	i_box_filled($src, 20, 20, 60, 60, $halfred);
3ce1204d TC	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");
faa9b3e7 TC	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);
71dc4a83	31	my $gsrc = Imager::ImgRaw::new($src_width, $src_height, 2);
faa9b3e7 TC	32	my $halfwhite = NC(255, 128, 0);
faa9b3e7 TC	33	i_box_filled($gsrc, 20, 20, 60, 60, $halfwhite);
3ce1204d TC	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");
faa9b3e7 TC	42
	43	# try grey target and grey alpha source
	44	my $gtarg = Imager::ImgRaw::new(100, 100, 1);
3ce1204d TC	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");
faa9b3e7	52
faa9b3e7 TC	53	# simple test for 16-bit/sample images
faa9b3e7 TC	54	my $targ16 = Imager::i_img_16_new(100, 100, 3);
3ce1204d TC	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");
faa9b3e7 TC	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);
71dc4a83	64	$oosrc->box(color=>$halfred, xmin=>20, ymin=>20, xmax=>60, ymax=>60,
faa9b3e7	65	filled=>1);
3ce1204d TC	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");
faa9b3e7	72
faa9b3e7	73	my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1);
e7b95388 TC	74
	75	{ # check empty image errors
	76	my $empty = Imager->new;
	77	ok(!$empty->rubthrough(src => $oosrc), "check empty target");
1136f089	78	is($empty->errstr, 'rubthrough: empty input image', "check error message");
e7b95388	79	ok(!$oogtarg->rubthrough(src=>$empty), "check empty source");
1136f089	80	is($oogtarg->errstr, 'rubthrough: empty input image (for src)',
e7b95388 TC	81	"check error message");
	82	}
	83
fe415ad2 TC	84	{
fe415ad2 TC	85	# alpha source and target
9b1ec2b8 TC	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	}
fe415ad2 TC	300	}
fe415ad2 TC	301
faa9b3e7 TC	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
fe415ad2 TC	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	}
faa9b3e7	327