[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);

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, 'empty input image', "check error message");
  ok(!$oogtarg->rubthrough(src=>$empty), "check empty source");
  is($oogtarg->errstr, '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
faa9b3e7 TC	7	init_log("testout/t69rubthru.log", 1);
faa9b3e7 TC	8
71dc4a83 AMH	9	my $src_height = 80;
	10	my $src_width = 80;
	11
faa9b3e7 TC	12	# raw interface
faa9b3e7 TC	13	my $targ = Imager::ImgRaw::new(100, 100, 3);
71dc4a83	14	my $src = Imager::ImgRaw::new($src_height, $src_width, 4);
faa9b3e7 TC	15	my $halfred = NC(255, 0, 0, 128);
faa9b3e7 TC	16	i_box_filled($src, 20, 20, 60, 60, $halfred);
3ce1204d TC	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");
faa9b3e7 TC	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);
71dc4a83	29	my $gsrc = Imager::ImgRaw::new($src_width, $src_height, 2);
faa9b3e7 TC	30	my $halfwhite = NC(255, 128, 0);
faa9b3e7 TC	31	i_box_filled($gsrc, 20, 20, 60, 60, $halfwhite);
3ce1204d TC	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");
faa9b3e7 TC	40
	41	# try grey target and grey alpha source
	42	my $gtarg = Imager::ImgRaw::new(100, 100, 1);
3ce1204d TC	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");
faa9b3e7	50
faa9b3e7 TC	51	# simple test for 16-bit/sample images
faa9b3e7 TC	52	my $targ16 = Imager::i_img_16_new(100, 100, 3);
3ce1204d TC	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");
faa9b3e7 TC	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);
71dc4a83	62	$oosrc->box(color=>$halfred, xmin=>20, ymin=>20, xmax=>60, ymax=>60,
faa9b3e7	63	filled=>1);
3ce1204d TC	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");
faa9b3e7	70
faa9b3e7	71	my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1);
e7b95388 TC	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
fe415ad2 TC	82	{
fe415ad2 TC	83	# alpha source and target
9b1ec2b8 TC	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	}
fe415ad2 TC	298	}
fe415ad2 TC	299
faa9b3e7 TC	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
fe415ad2 TC	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	}
faa9b3e7	325