t/t20fill.t

   1 #!perl -w
   2 use strict;
   3
   4 print "1..40\n";
   5
   6 use Imager ':handy';
   7 use Imager::Fill;
   8 use Imager::Color::Float;
   9 use Config;
  10
  11 sub ok ($$$);
  12
  13 Imager::init_log("testout/t20fill.log", 1);
  14
  15 my $blue = NC(0,0,255);
  16 my $red = NC(255, 0, 0);
  17 my $redf = Imager::Color::Float->new(1, 0, 0);
  18 my $rsolid = Imager::i_new_fill_solid($blue, 0);
  19 ok(1, $rsolid, "building solid fill");
  20 my $raw1 = Imager::ImgRaw::new(100, 100, 3);
  21 # use the normal filled box
  22 Imager::i_box_filled($raw1, 0, 0, 99, 99, $blue);
  23 my $raw2 = Imager::ImgRaw::new(100, 100, 3);
  24 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rsolid);
  25 ok(2, 1, "drawing with solid fill");
  26 my $diff = Imager::i_img_diff($raw1, $raw2);
  27 ok(3, $diff == 0, "solid fill doesn't match");
  28 Imager::i_box_filled($raw1, 0, 0, 99, 99, $red);
  29 my $rsolid2 = Imager::i_new_fill_solidf($redf, 0);
  30 ok(4, $rsolid2, "creating float solid fill");
  31 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rsolid2);
  32 $diff = Imager::i_img_diff($raw1, $raw2);
  33 ok(5, $diff == 0, "float solid fill doesn't match");
  34
  35 # ok solid still works, let's try a hatch
  36 # hash1 is a 2x2 checkerboard
  37 my $rhatcha = Imager::i_new_fill_hatch($red, $blue, 0, 1, undef, 0, 0);
  38 my $rhatchb = Imager::i_new_fill_hatch($blue, $red, 0, 1, undef, 2, 0);
  39 ok(6, $rhatcha && $rhatchb, "can't build hatched fill");
  40
  41 # the offset should make these match
  42 Imager::i_box_cfill($raw1, 0, 0, 99, 99, $rhatcha);
  43 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb);
  44 ok(7, 1, "filling with hatch");
  45 $diff = Imager::i_img_diff($raw1, $raw2);
  46 ok(8, $diff == 0, "hatch images different");
  47 $rhatchb = Imager::i_new_fill_hatch($blue, $red, 0, 1, undef, 4, 6);
  48 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb);
  49 $diff = Imager::i_img_diff($raw1, $raw2);
  50 ok(9, $diff == 0, "hatch images different");
  51
  52 # I guess I was tired when I originally did this - make sure it keeps
  53 # acting the way it's meant to
  54 # I had originally expected these to match with the red and blue swapped
  55 $rhatchb = Imager::i_new_fill_hatch($red, $blue, 0, 1, undef, 2, 2);
  56 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb);
  57 $diff = Imager::i_img_diff($raw1, $raw2);
  58 ok(10, $diff == 0, "hatch images different");
  59
  60 # this shouldn't match
  61 $rhatchb = Imager::i_new_fill_hatch($red, $blue, 0, 1, undef, 1, 1);
  62 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rhatchb);
  63 $diff = Imager::i_img_diff($raw1, $raw2);
  64 ok(11, $diff, "hatch images the same!");
  65
  66 # custom hatch
  67 # the inverse of the 2x2 checkerboard
  68 my $hatch = pack("C8", 0x33, 0x33, 0xCC, 0xCC, 0x33, 0x33, 0xCC, 0xCC);
  69 my $rcustom = Imager::i_new_fill_hatch($blue, $red, 0, 0, $hatch, 0, 0);
  70 Imager::i_box_cfill($raw2, 0, 0, 99, 99, $rcustom);
  71 $diff = Imager::i_img_diff($raw1, $raw2);
  72 ok(12, !$diff, "custom hatch mismatch");
  73
  74 # test the oo interface
  75 my $im1 = Imager->new(xsize=>100, ysize=>100);
  76 my $im2 = Imager->new(xsize=>100, ysize=>100);
  77
  78 my $solid = Imager::Fill->new(solid=>'#FF0000');
  79 ok(13, $solid, "creating oo solid fill");
  80 ok(14, $solid->{fill}, "bad oo solid fill");
  81 $im1->box(fill=>$solid);
  82 $im2->box(filled=>1, color=>$red);
  83 $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG});
  84 ok(15, !$diff, "oo solid fill");
  85
  86 my $hatcha = Imager::Fill->new(hatch=>'check2x2');
  87 my $hatchb = Imager::Fill->new(hatch=>'check2x2', dx=>2);
  88 $im1->box(fill=>$hatcha);
  89 $im2->box(fill=>$hatchb);
  90 # should be different
  91 $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG});
  92 ok(16, $diff, "offset checks the same!");
  93 $hatchb = Imager::Fill->new(hatch=>'check2x2', dx=>2, dy=>2);
  94 $im2->box(fill=>$hatchb);
  95 $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG});
  96 ok(17, !$diff, "offset into similar check should be the same");
  97
  98 # test dymanic build of fill
  99 $im2->box(fill=>{hatch=>'check2x2', dx=>2, fg=>NC(255,255,255),
 100                  bg=>NC(0,0,0)});
 101 $diff = Imager::i_img_diff($im1->{IMG}, $im2->{IMG});
 102 ok(18, !$diff, "offset and flipped should be the same");
 103
 104 # a simple demo
 105 my $im = Imager->new(xsize=>200, ysize=>200);
 106
 107 $im->box(xmin=>10, ymin=>10, xmax=>190, ymax=>190,
 108          fill=>{ hatch=>'check4x4',
 109                  fg=>NC(128, 0, 0),
 110                  bg=>NC(128, 64, 0) })
 111   or print "# ",$im->errstr,"\n";
 112 $im->arc(r=>80, d1=>45, d2=>75,
 113            fill=>{ hatch=>'stipple2',
 114                    combine=>1,
 115                    fg=>[ 0, 0, 0, 255 ],
 116                    bg=>{ rgba=>[255,255,255,160] } })
 117   or print "# ",$im->errstr,"\n";
 118 $im->arc(r=>80, d1=>75, d2=>135,
 119          fill=>{ fountain=>'radial', xa=>100, ya=>100, xb=>20, yb=>100 })
 120   or print "# ",$im->errstr,"\n";
 121 $im->write(file=>'testout/t20_sample.ppm');
 122
 123 # flood fill tests
 124 my $rffimg = Imager::ImgRaw::new(100, 100, 3);
 125 # build a H
 126 Imager::i_box_filled($rffimg, 10, 10, 20, 90, $blue);
 127 Imager::i_box_filled($rffimg, 80, 10, 90, 90, $blue);
 128 Imager::i_box_filled($rffimg, 20, 45, 80, 55, $blue);
 129 my $black = Imager::Color->new(0, 0, 0);
 130 Imager::i_flood_fill($rffimg, 15, 15, $red);
 131 my $rffcmp = Imager::ImgRaw::new(100, 100, 3);
 132 # build a H
 133 Imager::i_box_filled($rffcmp, 10, 10, 20, 90, $red);
 134 Imager::i_box_filled($rffcmp, 80, 10, 90, 90, $red);
 135 Imager::i_box_filled($rffcmp, 20, 45, 80, 55, $red);
 136 $diff = Imager::i_img_diff($rffimg, $rffcmp);
 137 ok(19, !$diff, "flood fill difference");
 138
 139 my $ffim = Imager->new(xsize=>100, ysize=>100);
 140 my $yellow = Imager::Color->new(255, 255, 0);
 141 $ffim->box(xmin=>10, ymin=>10, xmax=>20, ymax=>90, color=>$blue, filled=>1);
 142 $ffim->box(xmin=>20, ymin=>45, xmax=>80, ymax=>55, color=>$blue, filled=>1);
 143 $ffim->box(xmin=>80, ymin=>10, xmax=>90, ymax=>90, color=>$blue, filled=>1);
 144 ok(20, $ffim->flood_fill('x'=>50, 'y'=>50, color=>$red), "flood fill");
 145 $diff = Imager::i_img_diff($rffcmp, $ffim->{IMG});
 146 ok(21, !$diff, "oo flood fill difference");
 147 $ffim->flood_fill('x'=>50, 'y'=>50,
 148                   fill=> {
 149                           hatch => 'check2x2'
 150                          });
 151 #                  fill=>{
 152 #                         fountain=>'radial',
 153 #                         xa=>50, ya=>50,
 154 #                         xb=>10, yb=>10,
 155 #                        });
 156 $ffim->write(file=>'testout/t20_ooflood.ppm');
 157
 158 # test combining modes
 159 my $fill = NC(192, 128, 128, 128);
 160 my $target = NC(64, 32, 64);
 161 my %comb_tests =
 162   (
 163    none=>{ result=>$fill },
 164    normal=>{ result=>NC(128, 80, 96) },
 165    multiply => { result=>NC(56, 24, 48) },
 166    dissolve => { result=>[ $target, NC(128, 80, 96) ] },
 167    add => { result=>NC(159, 96, 128) },
 168    subtract => { result=>NC(31, 15, 31) }, # 31.87, 15.9, 31.87
 169    diff => { result=>NC(96, 64, 64) },
 170    lighten => { result=>NC(128, 80, 96) },
 171    darken => { result=>$target },
 172    # the following results are based on the results of the tests and
 173    # are suspect for that reason (and were broken at one point <sigh>)
 174    # but trying to work them out manually just makes my head hurt - TC
 175    hue => { result=>NC(64, 32, 47) },
 176    saturation => { result=>NC(63, 37, 64) },
 177    value => { result=>NC(127, 64, 128) },
 178    color => { result=>NC(64, 37, 52) },
 179   );
 180
 181 my $testnum = 22; # from 22 to 34
 182 for my $comb (Imager::Fill->combines) {
 183   my $test = $comb_tests{$comb};
 184   my $targim = Imager->new(xsize=>1, ysize=>1);
 185   $targim->box(filled=>1, color=>$target);
 186   my $fillobj = Imager::Fill->new(solid=>$fill, combine=>$comb);
 187   $targim->box(fill=>$fillobj);
 188   my $c = Imager::i_get_pixel($targim->{IMG}, 0, 0);
 189   if ($test->{result} =~ /ARRAY/) {
 190     ok($testnum++, scalar grep(color_close($_, $c), @{$test->{result}}),
 191        "combine '$comb'")
 192       or print "# got:",join(",", $c->rgba),"  allowed: ",
 193         join("|", map { join(",", $_->rgba) } @{$test->{result}}),"\n";
 194   }
 195   else {
 196     ok($testnum++, color_close($c, $test->{result}), "combine '$comb'")
 197       or print "# got: ",join(",", $c->rgba),
 198         "  allowed: ",join(",", $test->{result}->rgba),"\n";
 199   }
 200 }
 201
 202 ok($testnum++, $ffim->arc(r=>45, color=>$blue, aa=>1), "aa circle");
 203 $ffim->write(file=>"testout/t20_aacircle.ppm");
 204
 205 # image based fills
 206 my $green = NC(0, 255, 0);
 207 my $fillim = Imager->new(xsize=>40, ysize=>40, channels=>4);
 208 $fillim->box(filled=>1, xmin=>5, ymin=>5, xmax=>35, ymax=>35,
 209              color=>NC(0, 0, 255, 128));
 210 $fillim->arc(filled=>1, r=>10, color=>$green, aa=>1);
 211 my $ooim = Imager->new(xsize=>150, ysize=>150);
 212 $ooim->box(filled=>1, color=>$green, xmin=>70, ymin=>25, xmax=>130, ymax=>125);
 213 $ooim->box(filled=>1, color=>$blue, xmin=>20, ymin=>25, xmax=>80, ymax=>125);
 214 $ooim->arc(r=>30, color=>$red, aa=>1);
 215
 216 my $oocopy = $ooim->copy();
 217 ok($testnum++,
 218    $oocopy->arc(fill=>{image=>$fillim,
 219                        combine=>'normal',
 220                        xoff=>5}, r=>40),
 221    "image based fill");
 222 $oocopy->write(file=>'testout/t20_image.ppm');
 223
 224 # a more complex version
 225 use Imager::Matrix2d ':handy';
 226 $oocopy = $ooim->copy;
 227 ok($testnum++,
 228    $oocopy->arc(fill=>{
 229                        image=>$fillim,
 230                        combine=>'normal',
 231                        matrix=>m2d_rotate(degrees=>30),
 232                        xoff=>5
 233                        }, r=>40),
 234    "transformed image based fill");
 235 $oocopy->write(file=>'testout/t20_image_xform.ppm');
 236
 237 ok($testnum++,
 238    !$oocopy->arc(fill=>{ hatch=>"not really a hatch" }, r=>20),
 239    "error handling of automatic fill conversion");
 240 ok($testnum++,
 241    $oocopy->errstr =~ /Unknown hatch type/,
 242    "error message for automatic fill conversion");
 243
 244 # previous box fills to float images, or using the fountain fill
 245 # got into a loop here
 246
 247 if ($Config{d_alarm}) {
 248   local $SIG{ALRM} = sub { die; };
 249
 250   eval {
 251     alarm(2);
 252     ok($testnum,
 253        $ooim->box(xmin=>20, ymin=>20, xmax=>80, ymax=>40,
 254                   fill=>{ fountain=>'linear', xa=>20, ya=>20, xb=>80,
 255                           yb=>20 }), "linear box fill");
 256     ++$testnum;
 257     alarm 0;
 258   };
 259   $@ and ok($testnum++, 0, "linear box fill $@");
 260 }
 261 else {
 262   print "ok $testnum # skipped can't test without alarm\n";
 263   ++$testnum;
 264 }
 265
 266 sub ok ($$$) {
 267   my ($num, $test, $desc) = @_;
 268
 269   if ($test) {
 270     print "ok $num\n";
 271   }
 272   else {
 273     print "not ok $num # $desc\n";
 274   }
 275   $test;
 276 }
 277
 278 sub color_close {
 279   my ($c1, $c2) = @_;
 280
 281   my @c1 = $c1->rgba;
 282   my @c2 = $c2->rgba;
 283
 284   for my $i (0..2) {
 285     if (abs($c1[$i]-$c2[$i]) > 2) {
 286       return 0;
 287     }
 288   }
 289   return 1;
 290 }
 291
 292 # for use during testing
 293 sub save {
 294   my ($im, $name) = @_;
 295
 296   open FH, "> $name" or die "Cannot create $name: $!";
 297   binmode FH;
 298   my $io = Imager::io_new_fd(fileno(FH));
 299   Imager::i_writeppm_wiol($im, $io) or die "Cannot save to $name";
 300   undef $io;
 301   close FH;
 302 }