t/t69rubthru.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More tests => 38;
   5 BEGIN { use_ok(Imager => qw(:all :handy)); }
   6
   7 init_log("testout/t69rubthru.log", 1);
   8
   9 my $src_height = 80;
  10 my $src_width = 80;
  11
  12 # raw interface
  13 my $targ = Imager::ImgRaw::new(100, 100, 3);
  14 my $src = Imager::ImgRaw::new($src_height, $src_width, 4);
  15 my $halfred = NC(255, 0, 0, 128);
  16 i_box_filled($src, 20, 20, 60, 60, $halfred);
  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");
  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);
  29 my $gsrc = Imager::ImgRaw::new($src_width, $src_height, 2);
  30 my $halfwhite = NC(255, 128, 0);
  31 i_box_filled($gsrc, 20, 20, 60, 60, $halfwhite);
  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");
  40
  41 # try grey target and grey alpha source
  42 my $gtarg = Imager::ImgRaw::new(100, 100, 1);
  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");
  50
  51 # an attempt rub a 4 channel image over 1 channel should fail
  52 ok(!i_rubthru($gtarg, $src, 10, 10, 0, 0, $src_width, $src_height),
  53    "check failure of 4 channel over 1 channel image");
  54
  55 # simple test for 16-bit/sample images
  56 my $targ16 = Imager::i_img_16_new(100, 100, 3);
  57 ok(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);
  60 ok($c, "get pixel at 30, 30");
  61 ok(color_cmp($c, NC(128, 0, 0)) == 0, "check color");
  62
  63 # check the OO interface
  64 my $ootarg = Imager->new(xsize=>100, ysize=>100);
  65 my $oosrc = Imager->new(xsize=>80, ysize=>80, channels=>4);
  66 $oosrc->box(color=>$halfred, xmin=>20, ymin=>20, xmax=>60, ymax=>60,
  67             filled=>1);
  68 ok($ootarg->rubthrough(src=>$oosrc, tx=>10, ty=>10),
  69    "oo rubthrough");
  70 ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 10, 10), NC(0, 0, 0)) == 0,
  71    "check pixel at 10, 10");
  72 ok(color_cmp(Imager::i_get_pixel($ootarg->{IMG}, 30, 30), NC(128, 0, 0)) == 0,
  73    "check pixel at 30, 30");
  74
  75 # make sure we fail as expected
  76 my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1);
  77 ok(!$oogtarg->rubthrough(src=>$oosrc), "check oo fails correctly");
  78
  79 is($oogtarg->errstr,
  80    'rubthru can only work where (dest, src) channels are (3,4), (4,4), (3,2), (4,2), (1,2) or (2,2)',
  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
  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
 146 sub 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
 156 sub 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 ]
 168 DIAG
 169   }
 170 }
 171