the rubthrough() method now supports destination images with an alpha
[imager.git] / t / t69rubthru.t
CommitLineData
faa9b3e7 1#!perl -w
3ce1204d 2use strict;
13eb8ccd 3use lib 't';
fe415ad2 4use Test::More tests => 38;
3ce1204d 5BEGIN { use_ok(Imager => qw(:all :handy)); }
faa9b3e7 6
faa9b3e7
TC
7init_log("testout/t69rubthru.log", 1);
8
71dc4a83
AMH
9my $src_height = 80;
10my $src_width = 80;
11
faa9b3e7
TC
12# raw interface
13my $targ = Imager::ImgRaw::new(100, 100, 3);
71dc4a83 14my $src = Imager::ImgRaw::new($src_height, $src_width, 4);
faa9b3e7
TC
15my $halfred = NC(255, 0, 0, 128);
16i_box_filled($src, 20, 20, 60, 60, $halfred);
3ce1204d
TC
17ok(i_rubthru($targ, $src, 10, 10, 0, 0, $src_width, $src_height),
18 "low level rubthrough");
19my $c = Imager::i_get_pixel($targ, 10, 10);
20ok($c, "get pixel at (10, 10)");
21ok(color_cmp($c, NC(0, 0, 0)) == 0, "check for correct color");
22$c = Imager::i_get_pixel($targ, 30, 30);
23ok($c, "get pixel at (30, 30)");
24ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");
faa9b3e7
TC
25
26my $black = NC(0, 0, 0);
27# reset the target and try a grey+alpha source
28i_box_filled($targ, 0, 0, 100, 100, $black);
71dc4a83 29my $gsrc = Imager::ImgRaw::new($src_width, $src_height, 2);
faa9b3e7
TC
30my $halfwhite = NC(255, 128, 0);
31i_box_filled($gsrc, 20, 20, 60, 60, $halfwhite);
3ce1204d
TC
32ok(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);
35ok($c, "get at (15, 15)");
36ok(color_cmp($c, NC(0, 0, 0)) == 0, "check color");
37$c = Imager::i_get_pixel($targ, 30, 30);
38ok($c, "get pixel at (30, 30)");
39ok(color_cmp($c, NC(128, 128, 128)) == 0, "check color");
faa9b3e7
TC
40
41# try grey target and grey alpha source
42my $gtarg = Imager::ImgRaw::new(100, 100, 1);
3ce1204d
TC
43ok(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);
46ok($c, "get pixel at 10, 10");
47is(($c->rgba)[0], 0, "check grey level");
48is((Imager::i_get_pixel($gtarg, 30, 30)->rgba)[0], 128,
49 "check grey level at 30, 30");
faa9b3e7
TC
50
51# an attempt rub a 4 channel image over 1 channel should fail
3ce1204d
TC
52ok(!i_rubthru($gtarg, $src, 10, 10, 0, 0, $src_width, $src_height),
53 "check failure of 4 channel over 1 channel image");
faa9b3e7
TC
54
55# simple test for 16-bit/sample images
56my $targ16 = Imager::i_img_16_new(100, 100, 3);
3ce1204d
TC
57ok(i_rubthru($targ16, $src, 10, 10, 0, 0, $src_width, $src_height),
58 "smoke test vs 16-bit/sample image");
59$c = Imager::i_get_pixel($targ16, 30, 30);
60ok($c, "get pixel at 30, 30");
61ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");
faa9b3e7
TC
62
63# check the OO interface
64my $ootarg = Imager->new(xsize=>100, ysize=>100);
65my $oosrc = Imager->new(xsize=>80, ysize=>80, channels=>4);
71dc4a83 66$oosrc->box(color=>$halfred, xmin=>20, ymin=>20, xmax=>60, ymax=>60,
faa9b3e7 67 filled=>1);
3ce1204d
TC
68ok($ootarg->rubthrough(src=>$oosrc, tx=>10, ty=>10),
69 "oo rubthrough");
70ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 10, 10), NC(0, 0, 0)) == 0,
71 "check pixel at 10, 10");
72ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 30, 30), NC(128, 0, 0)) == 0,
73 "check pixel at 30, 30");
faa9b3e7
TC
74
75# make sure we fail as expected
76my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1);
3ce1204d 77ok(!$oogtarg->rubthrough(src=>$oosrc), "check oo fails correctly");
faa9b3e7 78
e7b95388 79is($oogtarg->errstr,
fe415ad2 80 'rubthru can only work where (dest, src) channels are (3,4), (4,4), (3,2), (4,2), (1,2) or (2,2)',
e7b95388
TC
81 "check error message");
82
83{ # check empty image errors
84 my $empty = Imager->new;
85 ok(!$empty->rubthrough(src => $oosrc), "check empty target");
86 is($empty->errstr, 'empty input image', "check error message");
87 ok(!$oogtarg->rubthrough(src=>$empty), "check empty source");
88 is($oogtarg->errstr, 'empty input image for src',
89 "check error message");
90}
91
fe415ad2
TC
92{
93 # alpha source and target
94 my $src = Imager->new(xsize => 10, ysize => 1, channels => 4);
95 my $targ = Imager->new(xsize => 10, ysize => 2, channels => 4);
96
97 # simple initialization
98 $targ->setscanline('y' => 1, x => 1,
99 pixels =>
100 [
101 NC(255, 128, 0, 255),
102 NC(255, 128, 0, 128),
103 NC(255, 128, 0, 0),
104 NC(255, 128, 0, 255),
105 NC(255, 128, 0, 128),
106 NC(255, 128, 0, 0),
107 NC(255, 128, 0, 255),
108 NC(255, 128, 0, 128),
109 NC(255, 128, 0, 0),
110 ]);
111 $src->setscanline('y' => 0,
112 pixels =>
113 [
114 NC(0, 128, 255, 0),
115 NC(0, 128, 255, 0),
116 NC(0, 128, 255, 0),
117 NC(0, 128, 255, 128),
118 NC(0, 128, 255, 128),
119 NC(0, 128, 255, 128),
120 NC(0, 128, 255, 255),
121 NC(0, 128, 255, 255),
122 NC(0, 128, 255, 255),
123 ]);
124 ok($targ->rubthrough(src => $src,
125 tx => 1, ty => 1), "do 4 on 4 rubthrough");
126 iscolora($targ->getpixel(x => 1, y => 1), NC(255, 128, 0, 255),
127 "check at zero source coverage on full targ coverage");
128 iscolora($targ->getpixel(x => 2, y => 1), NC(255, 128, 0, 128),
129 "check at zero source coverage on half targ coverage");
130 iscolora($targ->getpixel(x => 3, y => 1), NC(255, 128, 0, 0),
131 "check at zero source coverage on zero targ coverage");
132 iscolora($targ->getpixel(x => 4, y => 1), NC(127, 128, 128, 255),
133 "check at half source_coverage on full targ coverage");
134 iscolora($targ->getpixel(x => 5, y => 1), NC(85, 128, 170, 191),
135 "check at half source coverage on half targ coverage");
136 iscolora($targ->getpixel(x => 6, y => 1), NC(0, 128, 255, 128),
137 "check at half source coverage on zero targ coverage");
138 iscolora($targ->getpixel(x => 7, y => 1), NC(0, 128, 255, 255),
139 "check at full source_coverage on full targ coverage");
140 iscolora($targ->getpixel(x => 8, y => 1), NC(0, 128, 255, 255),
141 "check at full source coverage on half targ coverage");
142 iscolora($targ->getpixel(x => 9, y => 1), NC(0, 128, 255, 255),
143 "check at full source coverage on zero targ coverage");
144}
145
faa9b3e7
TC
146sub color_cmp {
147 my ($l, $r) = @_;
148 my @l = $l->rgba;
149 my @r = $r->rgba;
150 print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
151 return $l[0] <=> $r[0]
152 || $l[1] <=> $r[1]
153 || $l[2] <=> $r[2];
154}
155
fe415ad2
TC
156sub iscolora {
157 my ($c1, $c2, $msg) = @_;
158
159 my $builder = Test::Builder->new;
160 my @c1 = $c1->rgba;
161 my @c2 = $c2->rgba;
162 if (!$builder->ok($c1[0] == $c2[0] && $c1[1] == $c2[1] && $c1[2] == $c2[2]
163 && $c1[3] == $c2[3],
164 $msg)) {
165 $builder->diag(<<DIAG);
166 got color: [ @c1 ]
167 expected color: [ @c2 ]
168DIAG
169 }
170}
faa9b3e7 171