t/t20fill.t

   1 #!perl -w
   2 use strict;
   3
   4 use Imager ':handy';
   5 use Imager::Fill;
   6 use Imager::Color::Float;
   7
   8 Imager::init_log("testout/t20fill.log", 1);
   9
  10 print "1..21\n";
  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(1, $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(2, 1, "drawing with solid fill");
  23 my $diff = Imager::i_img_diff($raw1, $raw2);
  24 ok(3, $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(4, $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(5, $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(6, $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(7, 1, "filling with hatch");
  42 $diff = Imager::i_img_diff($raw1, $raw2);
  43 ok(8, $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(9, $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(10, $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(11, $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(12, !$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=>$red);
  76 ok(13, $solid, "creating oo solid fill");
  77 ok(14, $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(15, !$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(16, $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(17, !$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(18, !$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 $im->arc(r=>80, d1=>45, d2=>75,
 109            fill=>{ hatch=>'stipple2',
 110                    combine=>1,
 111                    fg=>NC(0, 0, 0, 255),
 112                    bg=>NC(255,255,255,192) });
 113 $im->arc(r=>80, d1=>75, d2=>135,
 114          fill=>{ fountain=>'radial', xa=>100, ya=>100, xb=>20, yb=>100 });
 115 $im->write(file=>'testout/t20_sample.ppm');
 116
 117 # flood fill tests
 118 my $rffimg = Imager::ImgRaw::new(100, 100, 3);
 119 # build a H
 120 Imager::i_box_filled($rffimg, 10, 10, 20, 90, $blue);
 121 Imager::i_box_filled($rffimg, 80, 10, 90, 90, $blue);
 122 Imager::i_box_filled($rffimg, 20, 45, 80, 55, $blue);
 123 my $black = Imager::Color->new(0, 0, 0);
 124 Imager::i_flood_fill($rffimg, 15, 15, $red);
 125 my $rffcmp = Imager::ImgRaw::new(100, 100, 3);
 126 # build a H
 127 Imager::i_box_filled($rffcmp, 10, 10, 20, 90, $red);
 128 Imager::i_box_filled($rffcmp, 80, 10, 90, 90, $red);
 129 Imager::i_box_filled($rffcmp, 20, 45, 80, 55, $red);
 130 $diff = Imager::i_img_diff($rffimg, $rffcmp);
 131 ok(19, !$diff, "flood fill difference");
 132
 133 my $ffim = Imager->new(xsize=>100, ysize=>100);
 134 my $yellow = Imager::Color->new(255, 255, 0);
 135 $ffim->box(xmin=>10, ymin=>10, xmax=>20, ymax=>90, color=>$blue, filled=>1);
 136 $ffim->box(xmin=>20, ymin=>45, xmax=>80, ymax=>55, color=>$blue, filled=>1);
 137 $ffim->box(xmin=>80, ymin=>10, xmax=>90, ymax=>90, color=>$blue, filled=>1);
 138 ok(20, $ffim->flood_fill(x=>50, 'y'=>50, color=>$red), "flood fill");
 139 $diff = Imager::i_img_diff($rffcmp, $ffim->{IMG});
 140 ok(21, !$diff, "oo flood fill difference");
 141 $ffim->flood_fill(x=>50, 'y'=>50,
 142                   fill=> {
 143                           hatch => 'check2x2'
 144                          });
 145 #                  fill=>{
 146 #                         fountain=>'radial',
 147 #                         xa=>50, ya=>50,
 148 #                         xb=>10, yb=>10,
 149 #                        });
 150 $ffim->write(file=>'testout/t20_ooflood.ppm');
 151
 152 sub ok {
 153   my ($num, $test, $desc) = @_;
 154
 155   if ($test) {
 156     print "ok $num\n";
 157   }
 158   else {
 159     print "not ok $num # $desc\n";
 160   }
 161 }
 162
 163 # for use during testing
 164 sub save {
 165   my ($im, $name) = @_;
 166
 167   open FH, "> $name" or die "Cannot create $name: $!";
 168   binmode FH;
 169   my $io = Imager::io_new_fd(fileno(FH));
 170   Imager::i_writeppm_wiol($im, $io) or die "Cannot save to $name";
 171   undef $io;
 172   close FH;
 173 }