t/t20fill.t

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