t/300-transform/060-map.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 10;
   4 use Imager::Test qw(is_image);
   5
   6 -d "testout" or mkdir "testout";
   7
   8 Imager::init("log"=>'testout/t68map.log');
   9
  10 use Imager qw(:all :handy);
  11
  12 my $imbase = Imager::ImgRaw::new(200,300,3);
  13
  14
  15 my @map1 = map { int($_/2) } 0..255;
  16 my @map2 = map { 255-int($_/2) } 0..255;
  17 my @map3 = 0..255;
  18 my @maps = 0..24;
  19 my @mapl = 0..400;
  20
  21 my $tst = 1;
  22
  23 ok(i_map($imbase, [ [],     [],     \@map1 ]), "map1 in ch 3");
  24 ok(i_map($imbase, [ \@map1, \@map1, \@map1 ]), "map1 in ch1-3");
  25
  26 ok(i_map($imbase, [ \@map1, \@map2, \@map3 ]), "map1-3 in ch 1-3");
  27
  28 ok(i_map($imbase, [ \@maps, \@mapl, \@map3 ]), "incomplete maps");
  29
  30 # test the highlevel interface
  31 # currently this requires visual inspection of the output files
  32
  33 SKIP: {
  34   my $im = Imager->new;
  35   $im->read(file=>'testimg/scale.ppm')
  36     or skip "Cannot load test image testimg/scale.ppm", 2;
  37
  38   ok( $im->map(red=>\@map1, green=>\@map2, blue=>\@map3),
  39       "test OO interface (maps by color)");
  40   ok( $im->map(maps=>[\@map1, [], \@map2]),
  41       "test OO interface (maps by maps)");
  42 }
  43
  44 {
  45   my $empty = Imager->new;
  46   ok(!$empty->map(maps => [ \@map1, \@map2, \@map3 ]),
  47      "can't map an empty image");
  48   is($empty->errstr, "map: empty input image", "check error message");
  49 }
  50
  51 { # a real map test
  52   my $im = Imager->new(xsize => 10, ysize => 10);
  53   $im->box(filled => 1, color => [ 255, 128, 128 ], xmax => 4, ymax => 4);
  54   $im->box(filled => 1, color => [ 0, 255, 0 ], xmin => 5);
  55
  56   my $cmp = Imager->new(xsize => 10, ysize => 10);
  57   $cmp->box(filled => 1, color => [ 127, 64, 64 ], xmax => 4, ymax => 4);
  58   $cmp->box(filled => 1, color => [ 0, 127, 0 ], xmin => 5);
  59   my @map = ( map int $_/2, 0 .. 255 );
  60   my $out = $im->map(maps => [ \@map, \@map, \@map ]);
  61   ok($out, "map()");
  62   is_image($out, $cmp, "test map output");
  63 }