]> git.imager.perl.org - imager.git/blame - t/t020masked.t
test the API under IMAGER_NO_CONTEXT
[imager.git] / t / t020masked.t
CommitLineData
faa9b3e7 1#!perl -w
95f7b74d 2use strict;
978284fe 3use Test::More tests => 242;
faa9b3e7 4use Imager qw(:all :handy);
416e9814 5use Imager::Test qw(is_color3 is_fcolor3);
40e78f96
TC
6
7-d "testout" or mkdir "testout";
8
cc59eadc 9Imager->open_log(log => "testout/t020masked.log");
faa9b3e7
TC
10
11my $base_rgb = Imager::ImgRaw::new(100, 100, 3);
12# put something in there
416e9814 13my $black = NC(0, 0, 0);
faa9b3e7
TC
14my $red = NC(255, 0, 0);
15my $green = NC(0, 255, 0);
16my $blue = NC(0, 0, 255);
17my $white = NC(255, 255, 255);
416e9814
TC
18my $grey = NC(128, 128, 128);
19use Imager::Color::Float;
20my $redf = Imager::Color::Float->new(1, 0, 0);
21my $greenf = Imager::Color::Float->new(0, 1, 0);
22my $bluef = Imager::Color::Float->new(0, 0, 1);
23my $greyf = Imager::Color::Float->new(0.5, 0.5, 0.5);
faa9b3e7
TC
24my @cols = ($red, $green, $blue);
25for my $y (0..99) {
26 Imager::i_plin($base_rgb, 0, $y, ($cols[$y % 3] ) x 100);
27}
28
29# first a simple subset image
30my $s_rgb = Imager::i_img_masked_new($base_rgb, undef, 25, 25, 50, 50);
31
95f7b74d
TC
32is(Imager::i_img_getchannels($s_rgb), 3,
33 "1 channel image channel count match");
34ok(Imager::i_img_getmask($s_rgb) & 1,
35 "1 channel image mask");
36ok(Imager::i_img_virtual($s_rgb),
37 "1 channel image thinks it isn't virtual");
38is(Imager::i_img_bits($s_rgb), 8,
39 "1 channel image has bits == 8");
40is(Imager::i_img_type($s_rgb), 0, # direct
41 "1 channel image is direct");
faa9b3e7
TC
42
43my @ginfo = i_img_info($s_rgb);
95f7b74d
TC
44is($ginfo[0], 50, "check width");
45is($ginfo[1], 50, "check height");
faa9b3e7
TC
46
47# sample some pixels through the subset
48my $c = Imager::i_get_pixel($s_rgb, 0, 0);
95f7b74d 49is_color3($c, 0, 255, 0, "check (0,0)");
faa9b3e7
TC
50$c = Imager::i_get_pixel($s_rgb, 49, 49);
51# (25+49)%3 = 2
95f7b74d 52is_color3($c, 0, 0, 255, "check (49,49)");
faa9b3e7
TC
53
54# try writing to it
55for my $y (0..49) {
56 Imager::i_plin($s_rgb, 0, $y, ($cols[$y % 3]) x 50);
57}
95f7b74d 58pass("managed to write to it");
faa9b3e7
TC
59# and checking the target image
60$c = Imager::i_get_pixel($base_rgb, 25, 25);
95f7b74d 61is_color3($c, 255, 0, 0, "check (25,25)");
faa9b3e7 62$c = Imager::i_get_pixel($base_rgb, 29, 29);
95f7b74d 63is_color3($c, 0, 255, 0, "check (29,29)");
faa9b3e7
TC
64
65undef $s_rgb;
66
67# a basic background
68for my $y (0..99) {
69 Imager::i_plin($base_rgb, 0, $y, ($red ) x 100);
70}
71my $mask = Imager::ImgRaw::new(50, 50, 1);
72# some venetian blinds
73for my $y (4..20) {
74 Imager::i_plin($mask, 5, $y*2, ($white) x 40);
75}
76# with a strip down the middle
77for my $y (0..49) {
78 Imager::i_plin($mask, 20, $y, ($white) x 8);
79}
80my $m_rgb = Imager::i_img_masked_new($base_rgb, $mask, 25, 25, 50, 50);
95f7b74d 81ok($m_rgb, "make masked with mask");
faa9b3e7
TC
82for my $y (0..49) {
83 Imager::i_plin($m_rgb, 0, $y, ($green) x 50);
84}
85my @color_tests =
86 (
87 [ 25+0, 25+0, $red ],
88 [ 25+19, 25+0, $red ],
89 [ 25+20, 25+0, $green ],
90 [ 25+27, 25+0, $green ],
91 [ 25+28, 25+0, $red ],
92 [ 25+49, 25+0, $red ],
93 [ 25+19, 25+7, $red ],
94 [ 25+19, 25+8, $green ],
95 [ 25+19, 25+9, $red ],
96 [ 25+0, 25+8, $red ],
97 [ 25+4, 25+8, $red ],
98 [ 25+5, 25+8, $green ],
99 [ 25+44, 25+8, $green ],
100 [ 25+45, 25+8, $red ],
101 [ 25+49, 25+49, $red ],
102 );
103my $test_num = 15;
104for my $test (@color_tests) {
95f7b74d
TC
105 my ($x, $y, $testc) = @$test;
106 my ($r, $g, $b) = $testc->rgba;
107 my $c = Imager::i_get_pixel($base_rgb, $x, $y);
108 is_color3($c, $r, $g, $b, "at ($x, $y)");
faa9b3e7
TC
109}
110
111{
112 # tests for the OO versions, fairly simple, since the basic functionality
113 # is covered by the low-level interface tests
114
95f7b74d
TC
115 my $base = Imager->new(xsize=>100, ysize=>100);
116 ok($base, "make base OO image");
faa9b3e7
TC
117 $base->box(color=>$blue, filled=>1); # fill it all
118 my $mask = Imager->new(xsize=>80, ysize=>80, channels=>1);
119 $mask->box(color=>$white, filled=>1, xmin=>5, xmax=>75, ymin=>5, ymax=>75);
95f7b74d
TC
120 my $m_img = $base->masked(mask=>$mask, left=>5, top=>5);
121 ok($m_img, "make masked OO image");
122 is($m_img->getwidth, 80, "check width");
faa9b3e7 123 $m_img->box(color=>$green, filled=>1);
95f7b74d
TC
124 my $c = $m_img->getpixel(x=>0, y=>0);
125 is_color3($c, 0, 0, 255, "check (0,0)");
126 $c = $m_img->getpixel(x => 5, y => 5);
127 is_color3($c, 0, 255, 0, "check (5,5)");
faa9b3e7
TC
128
129 # older versions destroyed the Imager::ImgRaw object manually in
130 # Imager::DESTROY rather than letting Imager::ImgRaw::DESTROY
131 # destroy the object
132 # so we test here by destroying the base and mask objects and trying
133 # to draw to the masked wrapper
134 # you may need to test with ElectricFence to trigger the problem
135 undef $mask;
136 undef $base;
137 $m_img->box(color=>$blue, filled=>1);
95f7b74d 138 pass("didn't crash unreffing base or mask for masked image");
faa9b3e7 139}
416e9814
TC
140
141# 35.7% cover on maskimg.c up to here
142
143{ # error handling:
144 my $base = Imager->new(xsize => 100, ysize => 100);
145 ok($base, "make base");
146 { # make masked image subset outside of the base image
147 my $masked = $base->masked(left => 100);
148 ok (!$masked, "fail to make empty masked");
149 is($base->errstr, "subset outside of target image", "check message");
150 }
151}
152
153{ # size limiting
154 my $base = Imager->new(xsize => 10, ysize => 10);
155 ok($base, "make base for size limit tests");
156 {
157 my $masked = $base->masked(left => 5, right => 15);
158 ok($masked, "make masked");
159 is($masked->getwidth, 5, "check width truncated");
160 }
161 {
162 my $masked = $base->masked(top => 5, bottom => 15);
163 ok($masked, "make masked");
164 is($masked->getheight, 5, "check height truncated");
165 }
166}
167# 36.7% up to here
168
169$mask = Imager->new(xsize => 80, ysize => 80, channels => 1);
170$mask->box(filled => 1, color => $white, xmax => 39, ymax => 39);
171$mask->box(fill => { hatch => "check1x1" }, ymin => 40, xmax => 39);
172
173{
174 my $base = Imager->new(xsize => 100, ysize => 100, bits => "double");
175 ok($base, "base for single pixel tests");
176 is($base->type, "direct", "check type");
177 my $masked = $base->masked(mask => $mask, left => 1, top => 2);
178 my $limited = $base->masked(left => 1, top => 2);
179
180 is($masked->type, "direct", "check masked is same type as base");
181 is($limited->type, "direct", "check limited is same type as base");
182
183 {
184 # single pixel writes, masked
185 {
186 ok($masked->setpixel(x => 1, y => 3, color => $green),
187 "set (1,3) in masked (2, 5) in based");
188 my $c = $base->getpixel(x => 2, y => 5);
189 is_color3($c, 0, 255, 0, "check it wrote through");
190 ok($masked->setpixel(x => 45, y => 2, color => $red),
191 "set (45,2) in masked (46,4) in base (no mask)");
192 $c = $base->getpixel(x => 46, y => 4);
193 is_color3($c, 0, 0, 0, "shouldn't have written through");
194 }
195 {
196 ok($masked->setpixel(x => 2, y => 3, color => $redf),
197 "write float red to (2,3) base(3,5)");
198 my $c = $base->getpixel(x => 3, y => 5);
199 is_color3($c, 255, 0, 0, "check it wrote through");
200 ok($masked->setpixel(x => 45, y => 3, color => $greenf),
201 "set float (45,3) in masked (46,5) in base (no mask)");
202 $c = $base->getpixel(x => 46, y => 5);
203 is_color3($c, 0, 0, 0, "check it didn't write");
204 }
205 {
206 # write out of range should fail
207 ok(!$masked->setpixel(x => 80, y => 0, color => $green),
208 "write 8-bit color out of range");
209 ok(!$masked->setpixel(x => 0, y => 80, color => $greenf),
210 "write float color out of range");
211 }
212 }
213
214 # 46.9
215
216 {
9cd61346 217 print "# plin coverage\n";
416e9814
TC
218 {
219 $base->box(filled => 1, color => $black);
220 # plin masked
221 # simple path
222 is($masked->setscanline(x => 76, y => 1, pixels => [ ($red, $green) x 3 ]),
223 4, "try to write 6 pixels, but only write 4");
224 is_deeply([ $base->getsamples(x => 77, y => 3, width => 4) ],
225 [ ( 0 ) x 12 ],
226 "check not written through");
227 # !simple path
228 is($masked->setscanline(x => 4, y => 2, pixels => [ ($red, $green, $blue, $grey) x (72/4) ]),
229 72, "write many pixels (masked)");
230 is_deeply([ $base->getsamples(x => 5, y => 4, width => 72) ],
231 [ ( (255, 0, 0), (0, 255, 0), (0, 0, 255), (128, 128, 128)) x 9,
232 ( 0, 0, 0 ) x 36 ],
233 "check written through to base");
234
235 # simple path, due to number of transitions
236 is($masked->setscanline(x => 0, y => 40, pixels => [ ($red, $green, $blue, $grey) x 5 ]),
237 20, "try to write 20 pixels, with alternating write through");
238 is_deeply([ $base->getsamples(x => 1, y => 42, width => 20) ],
239 [ ( (0, 0, 0), (0,255,0), (0,0,0), (128,128,128) ) x 5 ],
240 "check correct pixels written through");
241 }
242
243 {
244 $base->box(filled => 1, color => $black);
245 # plin, non-masked path
246 is($limited->setscanline(x => 4, y => 2, pixels => [ ($red, $green, $blue, $grey) x (72/4) ]),
247 72, "write many pixels (limited)");
248 is_deeply([ $base->getsamples(x => 5, y => 4, width => 72) ],
249 [ ( (255, 0, 0), (0, 255, 0), (0, 0, 255), (128, 128, 128)) x 18 ],
250 "check written through to based");
251 }
252
253 {
254 # draw outside fails
255 is($masked->setscanline(x => 80, y => 2, pixels => [ $red, $green ]),
256 0, "check writing no pixels");
257 }
258 }
259
260 {
9cd61346 261 print "# plinf coverage\n";
416e9814
TC
262 {
263 $base->box(filled => 1, color => $black);
264 # plinf masked
265 # simple path
266 is($masked->setscanline(x => 76, y => 1, pixels => [ ($redf, $greenf) x 3 ]),
267 4, "try to write 6 pixels, but only write 4");
268 is_deeply([ $base->getsamples(x => 77, y => 3, width => 4, type => "float") ],
269 [ ( 0 ) x 12 ],
270 "check not written through");
271 # !simple path
272 is($masked->setscanline(x => 4, y => 2, pixels => [ ($redf, $greenf, $bluef, $greyf) x (72/4) ]),
273 72, "write many pixels (masked)");
274 is_deeply([ $base->getsamples(x => 5, y => 4, width => 72, type => "float") ],
275 [ ( (1, 0, 0), (0, 1, 0), (0, 0, 1), (0.5, 0.5, 0.5)) x 9,
276 ( 0, 0, 0 ) x 36 ],
277 "check written through to base");
278
279 # simple path, due to number of transitions
280 is($masked->setscanline(x => 0, y => 40, pixels => [ ($redf, $greenf, $bluef, $greyf) x 5 ]),
281 20, "try to write 20 pixels, with alternating write through");
282 is_deeply([ $base->getsamples(x => 1, y => 42, width => 20, type => "float") ],
283 [ ( (0, 0, 0), (0,1,0), (0,0,0), (0.5,0.5,0.5) ) x 5 ],
284 "check correct pixels written through");
285 }
286
287 {
288 $base->box(filled => 1, color => $black);
289 # plinf, non-masked path
290 is($limited->setscanline(x => 4, y => 2, pixels => [ ($redf, $greenf, $bluef, $greyf) x (72/4) ]),
291 72, "write many pixels (limited)");
292 is_deeply([ $base->getsamples(x => 5, y => 4, width => 72, type => "float") ],
293 [ ( (1, 0, 0), (0, 1, 0), (0, 0, 1), (0.5, 0.5, 0.5)) x 18 ],
294 "check written through to based");
295 }
296
297 {
298 # draw outside fails
299 is($masked->setscanline(x => 80, y => 2, pixels => [ $redf, $greenf ]),
300 0, "check writing no pixels");
301 }
302 }
303 # 71.4%
304 {
305 {
9cd61346 306 print "# gpix\n";
416e9814
TC
307 # gpix
308 $base->box(filled => 1, color => $black);
309 ok($base->setpixel(x => 4, y => 10, color => $red),
310 "set base(4,10) to red");
311 is_fcolor3($masked->getpixel(x => 3, y => 8),
312 255, 0, 0, "check pixel written");
313
314 # out of range
315 is($masked->getpixel(x => -1, y => 1),
316 undef, "check failure to left");
317 is($masked->getpixel(x => 0, y => -1),
318 undef, "check failure to top");
319 is($masked->getpixel(x => 80, y => 1),
320 undef, "check failure to right");
321 is($masked->getpixel(x => 0, y => 80),
322 undef, "check failure to bottom");
323 }
324 {
9cd61346 325 print "# gpixf\n";
416e9814
TC
326 # gpixf
327 $base->box(filled => 1, color => $black);
328 ok($base->setpixel(x => 4, y => 10, color => $redf),
329 "set base(4,10) to red");
330 is_fcolor3($masked->getpixel(x => 3, y => 8, type => "float"),
331 1.0, 0, 0, 0, "check pixel written");
332
333 # out of range
334 is($masked->getpixel(x => -1, y => 1, type => "float"),
335 undef, "check failure to left");
336 is($masked->getpixel(x => 0, y => -1, type => "float"),
337 undef, "check failure to top");
338 is($masked->getpixel(x => 80, y => 1, type => "float"),
339 undef, "check failure to right");
340 is($masked->getpixel(x => 0, y => 80, type => "float"),
341 undef, "check failure to bottom");
342 }
343 }
344 # 74.5
345 {
346 {
9cd61346 347 print "# glin\n";
416e9814
TC
348 $base->box(filled => 1, color => $black);
349 is($base->setscanline(x => 31, y => 3,
350 pixels => [ ( $red, $green) x 10 ]),
351 20, "write 20 pixels to base image");
352 my @colors = $masked->
353 getscanline(x => 30, y => 1, width => 20);
354 is(@colors, 20, "check we got right number of colors");
355 is_color3($colors[0], 255, 0, 0, "check first pixel");
356 is_color3($colors[19], 0, 255, 0, "check last pixel");
357
358 @colors = $masked->getscanline(x => 76, y => 2, width => 10);
359 is(@colors, 4, "read line from right edge");
360 is_color3($colors[0], 0, 0, 0, "check pixel");
361
362 is_deeply([ $masked->getscanline(x => -1, y => 0, width => 1) ],
363 [], "fail read left of image");
364 is_deeply([ $masked->getscanline(x => 0, y => -1, width => 1) ],
365 [], "fail read top of image");
366 is_deeply([$masked->getscanline(x => 80, y => 0, width => 1)],
367 [], "fail read right of image");
368 is_deeply([$masked->getscanline(x => 0, y => 80, width => 1)],
369 [], "fail read bottom of image");
370 }
371 {
9cd61346 372 print "# glinf\n";
416e9814
TC
373 $base->box(filled => 1, color => $black);
374 is($base->setscanline(x => 31, y => 3,
375 pixels => [ ( $redf, $greenf) x 10 ]),
376 20, "write 20 pixels to base image");
377 my @colors = $masked->
378 getscanline(x => 30, y => 1, width => 20, type => "float");
379 is(@colors, 20, "check we got right number of colors");
380 is_fcolor3($colors[0], 1.0, 0, 0, 0, "check first pixel");
381 is_fcolor3($colors[19], 0, 1.0, 0, 0, "check last pixel");
382
383 @colors = $masked->
384 getscanline(x => 76, y => 2, width => 10, type => "float");
385 is(@colors, 4, "read line from right edge");
386 is_fcolor3($colors[0], 0, 0, 0, 0, "check pixel");
387
388 is_deeply([ $masked->getscanline(x => -1, y => 0, width => 1, type => "float") ],
389 [], "fail read left of image");
390 is_deeply([ $masked->getscanline(x => 0, y => -1, width => 1, type => "float") ],
391 [], "fail read top of image");
392 is_deeply([$masked->getscanline(x => 80, y => 0, width => 1, type => "float")],
393 [], "fail read right of image");
394 is_deeply([$masked->getscanline(x => 0, y => 80, width => 1, type => "float")],
395 [], "fail read bottom of image");
396 }
397 }
398 # 81.6%
399 {
400 {
9cd61346 401 print "# gsamp\n";
416e9814
TC
402 $base->box(filled => 1, color => $black);
403 is($base->setscanline(x => 31, y => 3,
404 pixels => [ ( $red, $green) x 10 ]),
405 20, "write 20 pixels to base image");
406 my @samps = $masked->
407 getsamples(x => 30, y => 1, width => 20);
408 is(@samps, 60, "check we got right number of samples");
409 is_deeply(\@samps,
410 [ (255, 0, 0, 0, 255, 0) x 10 ],
411 "check it");
412
413 @samps = $masked->
414 getsamples(x => 76, y => 2, width => 10);
415 is(@samps, 12, "read line from right edge");
416 is_deeply(\@samps, [ (0, 0, 0) x 4], "check result");
417
418 is_deeply([ $masked->getsamples(x => -1, y => 0, width => 1) ],
419 [], "fail read left of image");
420 is_deeply([ $masked->getsamples(x => 0, y => -1, width => 1) ],
421 [], "fail read top of image");
422 is_deeply([$masked->getsamples(x => 80, y => 0, width => 1)],
423 [], "fail read right of image");
424 is_deeply([$masked->getsamples(x => 0, y => 80, width => 1)],
425 [], "fail read bottom of image");
426 }
427 {
9cd61346 428 print "# gsampf\n";
416e9814
TC
429 $base->box(filled => 1, color => $black);
430 is($base->setscanline(x => 31, y => 3,
431 pixels => [ ( $redf, $greenf) x 10 ]),
432 20, "write 20 pixels to base image");
433 my @samps = $masked->
434 getsamples(x => 30, y => 1, width => 20, type => "float");
435 is(@samps, 60, "check we got right number of samples");
436 is_deeply(\@samps,
437 [ (1.0, 0, 0, 0, 1.0, 0) x 10 ],
438 "check it");
439
440 @samps = $masked->
441 getsamples(x => 76, y => 2, width => 10, type => "float");
442 is(@samps, 12, "read line from right edge");
443 is_deeply(\@samps, [ (0, 0, 0) x 4], "check result");
444
445 is_deeply([ $masked->getsamples(x => -1, y => 0, width => 1, type => "float") ],
446 [], "fail read left of image");
447 is_deeply([ $masked->getsamples(x => 0, y => -1, width => 1, type => "float") ],
448 [], "fail read top of image");
449 is_deeply([$masked->getsamples(x => 80, y => 0, width => 1, type => "float")],
450 [], "fail read right of image");
451 is_deeply([$masked->getsamples(x => 0, y => 80, width => 1, type => "float")],
452 [], "fail read bottom of image");
453 }
454 }
455 # 86.2%
456}
457
458{
459 my $base = Imager->new(xsize => 100, ysize => 100, type => "paletted");
460 ok($base, "make paletted base");
461 is($base->type, "paletted", "check we got paletted");
462 is($base->addcolors(colors => [ $black, $red, $green, $blue ]),
463 "0 but true",
464 "add some colors to base");
465 my $masked = $base->masked(mask => $mask, left => 1, top => 2);
466 my $limited = $base->masked(left => 1, top => 2);
467
468 is($masked->type, "paletted", "check masked is same type as base");
469 is($limited->type, "paletted", "check limited is same type as base");
470
471 {
472 # make sure addcolors forwarded
473 is($masked->addcolors(colors => [ $grey ]), 4,
474 "test addcolors forwarded");
475 my @colors = $masked->getcolors();
476 is(@colors, 5, "check getcolors forwarded");
477 is_color3($colors[1], 255, 0, 0, "check color from palette");
478 }
479
480 my ($blacki, $redi, $greeni, $bluei, $greyi) = 0 .. 4;
481
482 { # gpal
9cd61346 483 print "# gpal\n";
416e9814
TC
484 $base->box(filled => 1, color => $black);
485 is($base->setscanline(x => 0, y => 5, type => "index",
486 pixels => [ ( $redi, $greeni, $bluei, $greyi) x 25 ]),
487 100, "write some pixels to base");
488 my @indexes = $masked->getscanline(y => 3, type => "index", width => "81");
489 is(@indexes, 80, "got 80 indexes");
490 is_deeply(\@indexes,
491 [ ( $greeni, $bluei, $greyi, $redi) x 20 ],
492 "check values");
493
494 is_deeply([ $masked->getscanline(x => -1, y => 3, type => "index") ],
495 [], "fail read left of image");
496 }
497 # 89.8%
498
499 { # ppal, unmasked
9cd61346 500 print "# ppal\n";
416e9814
TC
501 $base->box(filled => 1, color => $black);
502 is($limited->setscanline(x => 1, y => 1, type => "index",
503 pixels => [ ( $redi, $greeni, $bluei) x 3 ]),
504 9, "ppal limited");
505 is_deeply([ $base->getscanline(x => 2, y => 3, type => "index",
506 width => 9) ],
507 [ ( $redi, $greeni, $bluei) x 3 ],
508 "check set in base");
509 }
510 { # ppal, masked
511 $base->box(filled => 1, color => $black);
512 is($masked->setscanline(x => 1, y => 2, type => "index",
513 pixels => [ ( $redi, $greeni, $bluei, $greyi) x 12 ]),
514 48, "ppal masked");
515 is_deeply([ $base->getscanline(x => 0, y => 4, type => "index") ],
516 [ 0, 0,
517 ( $redi, $greeni, $bluei, $greyi ) x 9,
518 $redi, $greeni, $bluei, ( 0 ) x 59 ],
519 "check written");
520 }
521 {
522 # ppal, errors
523 is($masked->setscanline(x => -1, y => 0, type => "index",
524 pixels => [ $redi, $bluei ]),
525 0, "fail to write ppal");
526
527 is($masked->setscanline(x => 78, y => 0, type => "index",
528 pixels => [ $redi, $bluei, $greeni, $greyi ]),
529 2, "write over right side");
530 }
531}
cc59eadc 532
978284fe
TC
533my $full_mask = Imager->new(xsize => 10, ysize => 10, channels => 1);
534$full_mask->box(filled => 1, color => NC(255, 0, 0));
535
536# no mask and mask with full coverage should behave the same
537my $psamp_outside_error = "Image position outside of image";
538for my $masked (0, 1){ # psamp
539 print "# psamp masked: $masked\n";
540 my $imback = Imager::ImgRaw::new(20, 20, 3);
541 my $mask;
542 if ($masked) {
543 $mask = $full_mask->{IMG};
544 }
545 my $imraw = Imager::i_img_masked_new($imback, $mask, 3, 4, 10, 10);
546 {
547 is(Imager::i_psamp($imraw, 0, 2, undef, [ 255, 128, 64 ]), 3,
548 "i_psamp def channels, 3 samples");
549 is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64,
550 "check color written");
551 Imager::i_img_setmask($imraw, 5);
552 is(Imager::i_psamp($imraw, 1, 3, undef, [ 64, 128, 192 ]), 3,
553 "i_psamp def channels, 3 samples, masked");
554 is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 192,
555 "check color written");
556 is(Imager::i_psamp($imraw, 1, 7, [ 0, 1, 2 ], [ 64, 128, 192 ]), 3,
557 "i_psamp channels listed, 3 samples, masked");
558 is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 192,
559 "check color written");
560 Imager::i_img_setmask($imraw, ~0);
561 is(Imager::i_psamp($imraw, 2, 4, [ 0, 1 ], [ 255, 128, 64, 32 ]), 4,
562 "i_psamp channels [0, 1], 4 samples");
563 is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0,
564 "check first color written");
565 is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0,
566 "check second color written");
567 is(Imager::i_psamp($imraw, 0, 5, [ 0, 1, 2 ], [ (128, 63, 32) x 10 ]), 30,
568 "write a full row");
569 is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ],
570 [ (128, 63, 32) x 10 ],
571 "check full row");
572 is(Imager::i_psamp($imraw, 8, 8, [ 0, 1, 2 ],
573 [ 255, 128, 32, 64, 32, 16, 32, 16, 8 ]),
574 6, "i_psamp channels [0, 1, 2], 9 samples, but room for 6");
575 }
576 { # errors we catch
577 is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, 3 ], [ 255, 128, 32 ]),
578 undef, "i_psamp channels [0, 1, 3], 3 samples (invalid channel number)");
579 is(_get_error(), "No channel 3 in this image",
580 "check error message");
581 is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, -1 ], [ 255, 128, 32 ]),
582 undef, "i_psamp channels [0, 1, -1], 3 samples (invalid channel number)");
583 is(_get_error(), "No channel -1 in this image",
584 "check error message");
585 is(Imager::i_psamp($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef,
586 "negative y");
587 is(_get_error(), $psamp_outside_error, "check error message");
588 is(Imager::i_psamp($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef,
589 "y overflow");
590 is(_get_error(), $psamp_outside_error, "check error message");
591 is(Imager::i_psamp($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef,
592 "negative x");
593 is(_get_error(), $psamp_outside_error, "check error message");
594 is(Imager::i_psamp($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef,
595 "x overflow");
596 is(_get_error(), $psamp_outside_error, "check error message");
597 }
598 print "# end psamp tests\n";
599}
600
601for my $masked (0, 1) { # psampf
602 print "# psampf\n";
603 my $imback = Imager::ImgRaw::new(20, 20, 3);
604 my $mask;
605 if ($masked) {
606 $mask = $full_mask->{IMG};
607 }
608 my $imraw = Imager::i_img_masked_new($imback, $mask, 3, 4, 10, 10);
609 {
610 is(Imager::i_psampf($imraw, 0, 2, undef, [ 1, 0.5, 0.25 ]), 3,
611 "i_psampf def channels, 3 samples");
29b38678 612 is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64,
978284fe
TC
613 "check color written");
614 Imager::i_img_setmask($imraw, 5);
615 is(Imager::i_psampf($imraw, 1, 3, undef, [ 0.25, 0.5, 0.75 ]), 3,
616 "i_psampf def channels, 3 samples, masked");
29b38678 617 is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 191,
978284fe
TC
618 "check color written");
619 is(Imager::i_psampf($imraw, 1, 7, [ 0, 1, 2 ], [ 0.25, 0.5, 0.75 ]), 3,
620 "i_psampf channels listed, 3 samples, masked");
29b38678 621 is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 191,
978284fe
TC
622 "check color written");
623 Imager::i_img_setmask($imraw, ~0);
624 is(Imager::i_psampf($imraw, 2, 4, [ 0, 1 ], [ 1, 0.5, 0.25, 0.125 ]), 4,
625 "i_psampf channels [0, 1], 4 samples");
29b38678 626 is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0,
978284fe 627 "check first color written");
29b38678 628 is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0,
978284fe
TC
629 "check second color written");
630 is(Imager::i_psampf($imraw, 0, 5, [ 0, 1, 2 ], [ (0.5, 0.25, 0.125) x 10 ]), 30,
631 "write a full row");
632 is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ],
29b38678 633 [ (128, 64, 32) x 10 ],
978284fe
TC
634 "check full row");
635 is(Imager::i_psampf($imraw, 8, 8, [ 0, 1, 2 ],
636 [ 1.0, 0.5, 0.125, 0.25, 0.125, 0.0625, 0.125, 0, 1 ]),
637 6, "i_psampf channels [0, 1, 2], 9 samples, but room for 6");
638 }
639 { # errors we catch
640 is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, 3 ], [ 1, 0.5, 0.125 ]),
641 undef, "i_psampf channels [0, 1, 3], 3 samples (invalid channel number)");
642 is(_get_error(), "No channel 3 in this image",
643 "check error message");
644 is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, -1 ], [ 1, 0.5, 0.125 ]),
645 undef, "i_psampf channels [0, 1, -1], 3 samples (invalid channel number)");
646 is(_get_error(), "No channel -1 in this image",
647 "check error message");
648 is(Imager::i_psampf($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef,
649 "negative y");
650 is(_get_error(), $psamp_outside_error, "check error message");
651 is(Imager::i_psampf($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef,
652 "y overflow");
653 is(_get_error(), $psamp_outside_error, "check error message");
654 is(Imager::i_psampf($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef,
655 "negative x");
656 is(_get_error(), $psamp_outside_error, "check error message");
657 is(Imager::i_psampf($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef,
658 "x overflow");
659 is(_get_error(), $psamp_outside_error, "check error message");
660 }
661 print "# end psampf tests\n";
662}
663
664{
665 my $sub_mask = $full_mask->copy;
666 $sub_mask->box(filled => 1, color => NC(0,0,0), xmin => 4, xmax => 6);
667 my $base = Imager::ImgRaw::new(20, 20, 3);
668 my $masked = Imager::i_img_masked_new($base, $sub_mask->{IMG}, 3, 4, 10, 10);
669
670 is(Imager::i_psamp($masked, 0, 2, undef, [ ( 0, 127, 255) x 10 ]), 30,
671 "psamp() to masked image");
672 is_deeply([ Imager::i_gsamp($base, 0, 20, 6, undef) ],
673 [ ( 0, 0, 0 ) x 3, # left of mask
674 ( 0, 127, 255 ) x 4, # masked area
675 ( 0, 0, 0 ) x 3, # unmasked area
676 ( 0, 127, 255 ) x 3, # masked area
677 ( 0, 0, 0 ) x 7 ], # right of mask
678 "check values written");
679 is(Imager::i_psampf($masked, 0, 2, undef, [ ( 0, 0.5, 1.0) x 10 ]), 30,
680 "psampf() to masked image");
681 is_deeply([ Imager::i_gsamp($base, 0, 20, 6, undef) ],
682 [ ( 0, 0, 0 ) x 3, # left of mask
29b38678 683 ( 0, 128, 255 ) x 4, # masked area
978284fe 684 ( 0, 0, 0 ) x 3, # unmasked area
29b38678 685 ( 0, 128, 255 ) x 3, # masked area
978284fe
TC
686 ( 0, 0, 0 ) x 7 ], # right of mask
687 "check values written");
688}
689
cc59eadc
TC
690Imager->close_log();
691
692unless ($ENV{IMAGER_KEEP_FILES}) {
693 unlink "testout/t020masked.log";
694}
978284fe
TC
695
696sub _get_error {
697 my @errors = Imager::i_errors();
698 return join(": ", map $_->[0], @errors);
699}