t/t69rubthru.t

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