t/t61filters.t

   1 #!perl -w
   2 use strict;
   3 use Imager qw(:handy);
   4 use lib 't';
   5 use Test::More tests => 62;
   6 Imager::init_log("testout/t61filters.log", 1);
   7 # meant for testing the filters themselves
   8 my $imbase = Imager->new;
   9 $imbase->open(file=>'testout/t104.ppm') or die;
  10 my $im_other = Imager->new(xsize=>150, ysize=>150);
  11 $im_other->box(xmin=>30, ymin=>60, xmax=>120, ymax=>90, filled=>1);
  12
  13 test($imbase, {type=>'autolevels'}, 'testout/t61_autolev.ppm');
  14
  15 test($imbase, {type=>'contrast', intensity=>0.5},
  16      'testout/t61_contrast.ppm');
  17
  18 # this one's kind of cool
  19 test($imbase, {type=>'conv', coef=>[ -0.5, 1, -0.5, ], },
  20      'testout/t61_conv.ppm');
  21
  22 test($imbase, {type=>'gaussian', stddev=>5 },
  23      'testout/t61_gaussian.ppm');
  24
  25 test($imbase, { type=>'gradgen', dist=>1,
  26                    xo=>[ 10,  10, 120 ],
  27                    yo=>[ 10, 140,  60 ],
  28                    colors=> [ NC('#FF0000'), NC('#FFFF00'), NC('#00FFFF') ]},
  29      'testout/t61_gradgen.ppm');
  30
  31 test($imbase, {type=>'mosaic', size=>8}, 'testout/t61_mosaic.ppm');
  32
  33 test($imbase, {type=>'hardinvert'}, 'testout/t61_hardinvert.ppm');
  34
  35 test($imbase, {type=>'noise'}, 'testout/t61_noise.ppm');
  36
  37 test($imbase, {type=>'radnoise'}, 'testout/t61_radnoise.ppm');
  38
  39 test($imbase, {type=>'turbnoise'}, 'testout/t61_turbnoise.ppm');
  40
  41 test($imbase, {type=>'bumpmap', bump=>$im_other, lightx=>30, lighty=>30},
  42      'testout/t61_bumpmap.ppm');
  43
  44 test($imbase, {type=>'bumpmap_complex', bump=>$im_other}, 'testout/t61_bumpmap_complex.ppm');
  45
  46 test($imbase, {type=>'postlevels', levels=>3}, 'testout/t61_postlevels.ppm');
  47
  48 test($imbase, {type=>'watermark', wmark=>$im_other },
  49      'testout/t61_watermark.ppm');
  50
  51 test($imbase, {type=>'fountain', xa=>75, ya=>75, xb=>85, yb=>30,
  52                repeat=>'triangle', #ftype=>'radial',
  53                super_sample=>'circle', ssample_param => 16,
  54               },
  55      'testout/t61_fountain.ppm');
  56 use Imager::Fountain;
  57
  58 my $f1 = Imager::Fountain->new;
  59 $f1->add(end=>0.2, c0=>NC(255, 0,0), c1=>NC(255, 255,0));
  60 $f1->add(start=>0.2, c0=>NC(255,255,0), c1=>NC(0,0,255,0));
  61 test($imbase, { type=>'fountain', xa=>20, ya=>130, xb=>130, yb=>20,
  62                 #repeat=>'triangle',
  63                 segments=>$f1
  64               },
  65      'testout/t61_fountain2.ppm');
  66 my $f2 = Imager::Fountain->new
  67   ->add(end=>0.5, c0=>NC(255,0,0), c1=>NC(255,0,0), color=>'hueup')
  68   ->add(start=>0.5, c0=>NC(255,0,0), c1=>NC(255,0,0), color=>'huedown');
  69 #use Data::Dumper;
  70 #print Dumper($f2);
  71 test($imbase, { type=>'fountain', xa=>20, ya=>130, xb=>130, yb=>20,
  72                     segments=>$f2 },
  73      'testout/t61_fount_hsv.ppm');
  74 my $f3 = Imager::Fountain->read(gimp=>'testimg/gimpgrad');
  75 ok($f3, "read gimpgrad");
  76 test($imbase, { type=>'fountain', xa=>75, ya=>75, xb=>90, yb=>15,
  77                     segments=>$f3, super_sample=>'grid',
  78                     ftype=>'radial_square', combine=>'color' },
  79      'testout/t61_fount_gimp.ppm');
  80 test($imbase, { type=>'unsharpmask', stddev=>2.0 },
  81      'testout/t61_unsharp.ppm');
  82 test($imbase, {type=>'conv', coef=>[ -1, 3, -1, ], },
  83      'testout/t61_conv_sharp.ppm');
  84
  85 # Regression test: the checking of the segment type was incorrect
  86 # (the comparison was checking the wrong variable against the wrong value)
  87 my $f4 = [ [ 0, 0.5, 1, NC(0,0,0), NC(255,255,255), 5, 0 ] ];
  88 test($imbase, {type=>'fountain',  xa=>75, ya=>75, xb=>90, yb=>15,
  89                segments=>$f4, super_sample=>'grid',
  90                ftype=>'linear', combine=>'color' },
  91      'testout/t61_regress_fount.ppm');
  92 my $im2 = $imbase->copy;
  93 $im2->box(xmin=>20, ymin=>20, xmax=>40, ymax=>40, color=>'FF0000', filled=>1);
  94 $im2->write(file=>'testout/t61_diff_base.ppm');
  95 my $im3 = Imager->new(xsize=>150, ysize=>150, channels=>3);
  96 $im3->box(xmin=>20, ymin=>20, xmax=>40, ymax=>40, color=>'FF0000', filled=>1);
  97 my $diff = $imbase->difference(other=>$im2);
  98 ok($diff, "got difference image");
  99 SKIP:
 100 {
 101   skip(1, "missing comp or diff image") unless $im3 && $diff;
 102
 103   is(Imager::i_img_diff($im3->{IMG}, $diff->{IMG}), 0,
 104      "compare test image and diff image");
 105 }
 106
 107 # newer versions of gimp add a line to the gradient file
 108 my $name;
 109 my $f5 = Imager::Fountain->read(gimp=>'testimg/newgimpgrad.ggr',
 110                                 name => \$name);
 111 ok($f5, "read newer gimp gradient")
 112   or print "# ",Imager->errstr,"\n";
 113 is($name, "imager test gradient", "check name read correctly");
 114 $f5 = Imager::Fountain->read(gimp=>'testimg/newgimpgrad.ggr');
 115 ok($f5, "check we handle case of no name reference correctly")
 116   or print "# ",Imager->errstr,"\n";
 117
 118 # test writing of gradients
 119 ok($f2->write(gimp=>'testout/t61grad1.ggr'), "save a gradient")
 120   or print "# ",Imager->errstr,"\n";
 121 undef $name;
 122 my $f6 = Imager::Fountain->read(gimp=>'testout/t61grad1.ggr',
 123                                 name=>\$name);
 124 ok($f6, "read what we wrote")
 125   or print "# ",Imager->errstr,"\n";
 126 ok(!defined $name, "we didn't set the name, so shouldn't get one");
 127
 128 # try with a name
 129 ok($f2->write(gimp=>'testout/t61grad2.ggr', name=>'test gradient'),
 130    "write gradient with a name")
 131   or print "# ",Imager->errstr,"\n";
 132 undef $name;
 133 my $f7 = Imager::Fountain->read(gimp=>'testout/t61grad2.ggr', name=>\$name);
 134 ok($f7, "read what we wrote")
 135   or print "# ",Imager->errstr,"\n";
 136 is($name, "test gradient", "check the name matches");
 137
 138 # we attempt to convert color names in segments to segments now
 139 {
 140   my @segs =
 141     (
 142      [ 0.0, 0.5, 1.0, '000000', '#FFF', 0, 0 ],
 143     );
 144   my $im = Imager->new(xsize=>50, ysize=>50);
 145   ok($im->filter(type=>'fountain', segments => \@segs,
 146                  xa=>0, ya=>30, xb=>49, yb=>30),
 147      "fountain with color names instead of objects in segments");
 148   my $left = $im->getpixel('x'=>0, 'y'=>20);
 149   ok(color_close($left, Imager::Color->new(0,0,0)),
 150      "check black converted correctly");
 151   my $right = $im->getpixel('x'=>49, 'y'=>20);
 152   ok(color_close($right, Imager::Color->new(255,255,255)),
 153      "check white converted correctly");
 154
 155   # check that invalid color names are handled correctly
 156   my @segs2 =
 157     (
 158      [ 0.0, 0.5, 1.0, '000000', 'FxFxFx', 0, 0 ],
 159     );
 160   ok(!$im->filter(type=>'fountain', segments => \@segs2,
 161                   xa=>0, ya=>30, xb=>49, yb=>30),
 162      "fountain with invalid color name");
 163   cmp_ok($im->errstr, '=~', 'No color named', "check error message");
 164 }
 165
 166 {
 167   my $im = Imager->new(xsize=>100, ysize=>100);
 168   # build the gradient the hard way - linear from black to white,
 169   # then back again
 170   my @simple =
 171    (
 172      [   0, 0.25, 0.5, 'black', 'white', 0, 0 ],
 173      [ 0.5. 0.75, 1.0, 'white', 'black', 0, 0 ],
 174    );
 175   # across
 176   my $linear = $im->filter(type   => "fountain",
 177                            ftype  => 'linear',
 178                            repeat => 'sawtooth',
 179                            xa     => 0,
 180                            ya     => $im->getheight / 2,
 181                            xb     => $im->getwidth - 1,
 182                            yb     => $im->getheight / 2);
 183   ok($linear, "linear fountain sample");
 184   # around
 185   my $revolution = $im->filter(type   => "fountain",
 186                                ftype  => 'revolution',
 187                                xa     => $im->getwidth / 2,
 188                                ya     => $im->getheight / 2,
 189                                xb     => $im->getwidth / 2,
 190                                yb     => 0);
 191   ok($revolution, "revolution fountain sample");
 192   # out from the middle
 193   my $radial = $im->filter(type   => "fountain",
 194                            ftype  => 'radial',
 195                            xa     => $im->getwidth / 2,
 196                            ya     => $im->getheight / 2,
 197                            xb     => $im->getwidth / 2,
 198                            yb     => 0);
 199   ok($radial, "radial fountain sample");
 200 }
 201
 202 sub test {
 203   my ($in, $params, $out) = @_;
 204
 205   my $copy = $in->copy;
 206   if (ok($copy->filter(%$params), $params->{type})) {
 207     ok($copy->write(file=>$out), "write $params->{type}")
 208       or print "# ",$copy->errstr,"\n";
 209   }
 210   else {
 211   SKIP:
 212     {
 213       skip("couldn't filter", 1);
 214     }
 215   }
 216 }
 217
 218 sub color_close {
 219   my ($c1, $c2) = @_;
 220
 221   my @c1 = $c1->rgba;
 222   my @c2 = $c2->rgba;
 223
 224   for my $i (0..2) {
 225     if (abs($c1[$i]-$c2[$i]) > 2) {
 226       return 0;
 227     }
 228   }
 229   return 1;
 230 }