t/150-type/100-masked.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 244;
   4 use Imager qw(:all :handy);
   5 use Imager::Test qw(is_color3 is_fcolor3);
   6
   7 -d "testout" or mkdir "testout";
   8
   9 Imager->open_log(log => "testout/t020masked.log");
  10
  11 my $base_rgb = Imager::ImgRaw::new(100, 100, 3);
  12 # put something in there
  13 my $black = NC(0, 0, 0);
  14 my $red = NC(255, 0, 0);
  15 my $green = NC(0, 255, 0);
  16 my $blue = NC(0, 0, 255);
  17 my $white = NC(255, 255, 255);
  18 my $grey = NC(128, 128, 128);
  19 use Imager::Color::Float;
  20 my $redf = Imager::Color::Float->new(1, 0, 0);
  21 my $greenf = Imager::Color::Float->new(0, 1, 0);
  22 my $bluef = Imager::Color::Float->new(0, 0, 1);
  23 my $greyf = Imager::Color::Float->new(0.5, 0.5, 0.5);
  24 my @cols = ($red, $green, $blue);
  25 for 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
  30 my $s_rgb = Imager::i_img_masked_new($base_rgb, undef, 25, 25, 50, 50);
  31
  32 is(Imager::i_img_getchannels($s_rgb), 3,
  33    "1 channel image channel count match");
  34 ok(Imager::i_img_getmask($s_rgb) & 1,
  35    "1 channel image mask");
  36 ok(Imager::i_img_virtual($s_rgb),
  37    "1 channel image thinks it isn't virtual");
  38 is(Imager::i_img_bits($s_rgb), 8,
  39    "1 channel image has bits == 8");
  40 is(Imager::i_img_type($s_rgb), 0, # direct
  41    "1 channel image is direct");
  42
  43 my @ginfo = i_img_info($s_rgb);
  44 is($ginfo[0], 50, "check width");
  45 is($ginfo[1], 50, "check height");
  46
  47 # sample some pixels through the subset
  48 my $c = Imager::i_get_pixel($s_rgb, 0, 0);
  49 is_color3($c, 0, 255, 0, "check (0,0)");
  50 $c = Imager::i_get_pixel($s_rgb, 49, 49);
  51 # (25+49)%3 = 2
  52 is_color3($c, 0, 0, 255, "check (49,49)");
  53
  54 # try writing to it
  55 for my $y (0..49) {
  56   Imager::i_plin($s_rgb, 0, $y, ($cols[$y % 3]) x 50);
  57 }
  58 pass("managed to write to it");
  59 # and checking the target image
  60 $c = Imager::i_get_pixel($base_rgb, 25, 25);
  61 is_color3($c, 255, 0, 0, "check (25,25)");
  62 $c = Imager::i_get_pixel($base_rgb, 29, 29);
  63 is_color3($c, 0, 255, 0, "check (29,29)");
  64
  65 undef $s_rgb;
  66
  67 # a basic background
  68 for my $y (0..99) {
  69   Imager::i_plin($base_rgb, 0, $y, ($red ) x 100);
  70 }
  71 my $mask = Imager::ImgRaw::new(50, 50, 1);
  72 # some venetian blinds
  73 for my $y (4..20) {
  74   Imager::i_plin($mask, 5, $y*2, ($white) x 40);
  75 }
  76 # with a strip down the middle
  77 for my $y (0..49) {
  78   Imager::i_plin($mask, 20, $y, ($white) x 8);
  79 }
  80 my $m_rgb = Imager::i_img_masked_new($base_rgb, $mask, 25, 25, 50, 50);
  81 ok($m_rgb, "make masked with mask");
  82 for my $y (0..49) {
  83   Imager::i_plin($m_rgb, 0, $y, ($green) x 50);
  84 }
  85 my @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   );
 103 my $test_num = 15;
 104 for my $test (@color_tests) {
 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)");
 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
 115   my $base = Imager->new(xsize=>100, ysize=>100);
 116   ok($base, "make base OO image");
 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);
 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");
 123   $m_img->box(color=>$green, filled=>1);
 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)");
 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);
 138   pass("didn't crash unreffing base or mask for masked image");
 139 }
 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       is($masked->setpixel(x => 80, y => 0, color => $green), "0 but true",
 208          "write 8-bit color out of range");
 209       is($masked->setpixel(x => 0, y => 80, color => $greenf), "0 but true",
 210          "write float color out of range");
 211     }
 212   }
 213
 214   # 46.9
 215
 216   {
 217     print "# plin coverage\n";
 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   {
 261     print "# plinf coverage\n";
 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     {
 306       print "# gpix\n";
 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     {
 325       print "# gpixf\n";
 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     {
 347       print "# glin\n";
 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     {
 372       print "# glinf\n";
 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     {
 401       print "# gsamp\n";
 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     {
 428       print "# gsampf\n";
 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
 483     print "# gpal\n";
 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
 500     print "# ppal\n";
 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 }
 532
 533 my $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
 537 my $psamp_outside_error = "Image position outside of image";
 538 for 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
 601 for 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");
 612     is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64,
 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");
 617     is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 191,
 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");
 621     is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 191,
 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");
 626     is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0,
 627               "check first color written");
 628     is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0,
 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 ]) ],
 633               [ (128, 64, 32) x 10 ],
 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
 683               ( 0, 128, 255 ) x 4, # masked area
 684               ( 0, 0, 0 ) x 3, # unmasked area
 685               ( 0, 128, 255 ) x 3, # masked area
 686               ( 0, 0, 0 ) x 7 ], # right of mask
 687             "check values written");
 688 }
 689
 690 {
 691   my $empty = Imager->new;
 692   ok(!$empty->masked, "fail to make a masked image from an empty");
 693   is($empty->errstr, "masked: empty input image",
 694     "check error message");
 695 }
 696
 697 Imager->close_log();
 698
 699 unless ($ENV{IMAGER_KEEP_FILES}) {
 700   unlink "testout/t020masked.log";
 701 }
 702
 703 sub _get_error {
 704   my @errors = Imager::i_errors();
 705   return join(": ", map $_->[0], @errors);
 706 }