Commit | Line | Data |
---|---|---|
bffa5c1c TC |
1 | #!perl -w |
2 | use strict; | |
785364c1 TC |
3 | use Test::More; |
4 | use Imager::Test qw(is_image test_image); | |
bffa5c1c | 5 | |
40e78f96 TC |
6 | -d "testout" or mkdir "testout"; |
7 | ||
9a5744db | 8 | Imager::init("log"=>'testout/t68map.log'); |
40eba1ea AMH |
9 | |
10 | use Imager qw(:all :handy); | |
11 | ||
40eba1ea AMH |
12 | my $imbase = Imager::ImgRaw::new(200,300,3); |
13 | ||
14 | ||
bffa5c1c TC |
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; | |
40eba1ea | 20 | |
bffa5c1c | 21 | my $tst = 1; |
40eba1ea | 22 | |
bffa5c1c TC |
23 | ok(i_map($imbase, [ [], [], \@map1 ]), "map1 in ch 3"); |
24 | ok(i_map($imbase, [ \@map1, \@map1, \@map1 ]), "map1 in ch1-3"); | |
40eba1ea | 25 | |
bffa5c1c | 26 | ok(i_map($imbase, [ \@map1, \@map2, \@map3 ]), "map1-3 in ch 1-3"); |
40eba1ea | 27 | |
bffa5c1c | 28 | ok(i_map($imbase, [ \@maps, \@mapl, \@map3 ]), "incomplete maps"); |
40eba1ea AMH |
29 | |
30 | # test the highlevel interface | |
31 | # currently this requires visual inspection of the output files | |
32 | ||
bffa5c1c TC |
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; | |
40eba1ea | 37 | |
bffa5c1c TC |
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)"); | |
40eba1ea | 42 | } |
1136f089 TC |
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 | } | |
85f38e13 TC |
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 | } | |
785364c1 TC |
64 | |
65 | { | |
66 | # test with zero mask: coverity detected a bad channel index problem | |
67 | # that only applies in this case | |
68 | my $im = test_image(); | |
69 | $im->setmask(mask => 0x80); | |
70 | is($im->getmask, 0x80, "check we set mask"); | |
71 | my @map = ( map int $_ / 2, 0 .. 255 ); | |
72 | my $out = $im->map(maps => [ (undef) x 3 ]); | |
73 | ok($out, "map done"); | |
74 | } | |
75 | ||
76 | done_testing(); |