87fdbbb6994e894d288d65d3d7e375282f7b5ea9
[imager.git] / t / t022double.t
1 #!perl -w
2 use strict;
3 BEGIN { $| = 1; print "1..42\n"; }
4 my $loaded;
5 END {print "not ok 1\n" unless $loaded;}
6 use Imager qw(:all :handy);
7 #use Data::Dumper;
8 $loaded = 1;
9 print "ok 1\n";
10
11 require "t/testtools.pl";
12
13 init_log("testout/t022double.log", 1);
14
15 use Imager::Color::Float;
16
17 my $im_g = Imager::i_img_double_new(100, 101, 1);
18
19 ok(2, Imager::i_img_getchannels($im_g) == 1, 
20    "1 channel image channel count mismatch");
21 ok(3, Imager::i_img_getmask($im_g) & 1, "1 channel image bad mask");
22 ok(4, Imager::i_img_virtual($im_g) == 0, 
23   "1 channel image thinks it is virtual");
24 my $double_bits = length(pack("d", 1)) * 8;
25 print "# $double_bits double bits\n";
26 ok(5, Imager::i_img_bits($im_g) == $double_bits, 
27    "1 channel image has bits != $double_bits");
28 ok(6, Imager::i_img_type($im_g) == 0, "1 channel image isn't direct");
29
30 my @ginfo = i_img_info($im_g);
31 ok(7, $ginfo[0] == 100, "1 channel image width incorrect");
32 ok(8, $ginfo[1] == 101, "1 channel image height incorrect");
33
34 undef $im_g;
35
36 my $im_rgb = Imager::i_img_double_new(100, 101, 3);
37
38 ok(9, Imager::i_img_getchannels($im_rgb) == 3,
39    "3 channel image channel count mismatch");
40 ok(10, (Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image bad mask");
41 ok(11, Imager::i_img_bits($im_rgb) == $double_bits,
42   "3 channel image has bits != $double_bits");
43 ok(12, Imager::i_img_type($im_rgb) == 0, "3 channel image isn't direct");
44
45 my $redf = NCF(1, 0, 0);
46 my $greenf = NCF(0, 1, 0);
47 my $bluef = NCF(0, 0, 1);
48
49 # fill with red
50 for my $y (0..101) {
51   Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
52 }
53 print "ok 13\n";
54 # basic sanity
55 test_colorf_gpix(14, $im_rgb, 0,  0,   $redf);
56 test_colorf_gpix(16, $im_rgb, 99, 0,   $redf);
57 test_colorf_gpix(18, $im_rgb, 0,  100, $redf);
58 test_colorf_gpix(20, $im_rgb, 99, 100, $redf);
59 test_colorf_glin(22, $im_rgb, 0,  0,   ($redf) x 100);
60 test_colorf_glin(24, $im_rgb, 0,  100, ($redf) x 100);
61
62 Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
63 test_colorf_glin(26, $im_rgb, 0, 1, 
64                  ($redf) x 20, ($greenf) x 60, ($redf) x 20);
65
66 # basic OO tests
67 my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double');
68 ok(28, $ooimg, "couldn't make double image");
69 ok(29, $ooimg->bits eq 'double', "oo didn't give double image");
70
71 # check that the image is copied correctly
72 my $oocopy = $ooimg->copy;
73 ok(30, $oocopy->bits eq 'double', "oo copy didn't give double image");
74
75 my $num = 31;
76 okn($num++, !Imager->new(xsize=>0, ysize=>1, bits=>'double'),
77     "fail making 0 width image");
78 matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
79        "and correct message");
80 okn($num++, !Imager->new(xsize=>1, ysize=>0, bits=>'double'),
81     "fail making 0 height image");
82 matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
83        "and correct message");
84 okn($num++, !Imager->new(xsize=>-1, ysize=>1, bits=>'double'),
85     "fail making -ve width image");
86 matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
87        "and correct message");
88 okn($num++, !Imager->new(xsize=>1, ysize=>-1, bits=>'double'),
89     "fail making -ve height image");
90 matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
91        "and correct message");
92 okn($num++, !Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>0),
93     "fail making 0 channel image");
94 matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
95        "and correct message");
96 okn($num++, !Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>5),
97     "fail making 5 channel image");
98 matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
99        "and correct message");
100
101 sub NCF {
102   return Imager::Color::Float->new(@_);
103 }
104
105 sub test_colorf_gpix {
106   my ($test_base, $im, $x, $y, $expected) = @_;
107   my $c = Imager::i_gpixf($im, $x, $y);
108   $c or print "not ";
109   print "ok ",$test_base++,"\n";
110   colorf_cmp($c, $expected) == 0 or print "not ";
111   print "ok ",$test_base++,"\n";
112 }
113
114 sub test_colorf_glin {
115   my ($test_base, $im, $x, $y, @pels) = @_;
116
117   my @got = Imager::i_glinf($im, $x, $x+@pels, $y);
118   @got == @pels or print "not ";
119   print "ok ",$test_base++,"\n";
120   grep(colorf_cmp($pels[$_], $got[$_]), 0..$#got) and print "not ";
121   print "ok ",$test_base++,"\n";
122 }
123
124 sub colorf_cmp {
125   my ($c1, $c2) = @_;
126   my @s1 = map { int($_*65535.99) } $c1->rgba;
127   my @s2 = map { int($_*65535.99) } $c2->rgba;
128
129   # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
130   return $s1[0] <=> $s2[0] 
131     || $s1[1] <=> $s2[1]
132       || $s1[2] <=> $s2[2];
133 }
134
135 sub ok {
136   my ($test_num, $ok, $comment) = @_;
137
138   if ($ok) {
139     print "ok $test_num\n";
140   }
141   else {
142     print "not ok $test_num # $comment\n";
143   }
144 }