3 BEGIN { $| = 1; print "1..30\n"; }
5 END {print "not ok 1\n" unless $loaded;}
6 use Imager qw(:all :handy);
10 init_log("testout/t022double.log", 1);
12 use Imager::Color::Float;
14 my $im_g = Imager::i_img_double_new(100, 101, 1);
16 ok(2, Imager::i_img_getchannels($im_g) == 1,
17 "1 channel image channel count mismatch");
18 ok(3, Imager::i_img_getmask($im_g) & 1, "1 channel image bad mask");
19 ok(4, Imager::i_img_virtual($im_g) == 0,
20 "1 channel image thinks it is virtual");
21 my $double_bits = length(pack("d", 1)) * 8;
22 print "# $double_bits double bits\n";
23 ok(5, Imager::i_img_bits($im_g) == $double_bits,
24 "1 channel image has bits != $double_bits");
25 ok(6, Imager::i_img_type($im_g) == 0, "1 channel image isn't direct");
27 my @ginfo = i_img_info($im_g);
28 ok(7, $ginfo[0] == 100, "1 channel image width incorrect");
29 ok(8, $ginfo[1] == 101, "1 channel image height incorrect");
33 my $im_rgb = Imager::i_img_double_new(100, 101, 3);
35 ok(9, Imager::i_img_getchannels($im_rgb) == 3,
36 "3 channel image channel count mismatch");
37 ok(10, (Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image bad mask");
38 ok(11, Imager::i_img_bits($im_rgb) == $double_bits,
39 "3 channel image has bits != $double_bits");
40 ok(12, Imager::i_img_type($im_rgb) == 0, "3 channel image isn't direct");
42 my $redf = NCF(1, 0, 0);
43 my $greenf = NCF(0, 1, 0);
44 my $bluef = NCF(0, 0, 1);
48 Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
52 test_colorf_gpix(14, $im_rgb, 0, 0, $redf);
53 test_colorf_gpix(16, $im_rgb, 99, 0, $redf);
54 test_colorf_gpix(18, $im_rgb, 0, 100, $redf);
55 test_colorf_gpix(20, $im_rgb, 99, 100, $redf);
56 test_colorf_glin(22, $im_rgb, 0, 0, ($redf) x 100);
57 test_colorf_glin(24, $im_rgb, 0, 100, ($redf) x 100);
59 Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
60 test_colorf_glin(26, $im_rgb, 0, 1,
61 ($redf) x 20, ($greenf) x 60, ($redf) x 20);
64 my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double');
65 ok(28, $ooimg, "couldn't make double image");
66 ok(29, $ooimg->bits eq 'double', "oo didn't give double image");
68 # check that the image is copied correctly
69 my $oocopy = $ooimg->copy;
70 ok(30, $oocopy->bits eq 'double', "oo copy didn't give double image");
73 return Imager::Color::Float->new(@_);
76 sub test_colorf_gpix {
77 my ($test_base, $im, $x, $y, $expected) = @_;
78 my $c = Imager::i_gpixf($im, $x, $y);
80 print "ok ",$test_base++,"\n";
81 colorf_cmp($c, $expected) == 0 or print "not ";
82 print "ok ",$test_base++,"\n";
85 sub test_colorf_glin {
86 my ($test_base, $im, $x, $y, @pels) = @_;
88 my @got = Imager::i_glinf($im, $x, $x+@pels, $y);
89 @got == @pels or print "not ";
90 print "ok ",$test_base++,"\n";
91 grep(colorf_cmp($pels[$_], $got[$_]), 0..$#got) and print "not ";
92 print "ok ",$test_base++,"\n";
97 my @s1 = map { int($_*65535.99) } $c1->rgba;
98 my @s2 = map { int($_*65535.99) } $c2->rgba;
100 # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
101 return $s1[0] <=> $s2[0]
103 || $s1[2] <=> $s2[2];
107 my ($test_num, $ok, $comment) = @_;
110 print "ok $test_num\n";
113 print "not ok $test_num # $comment\n";