- set i_format to pnm when reading pnm files and test for it
[imager.git] / t / t104ppm.t
CommitLineData
8b695554 1#!perl -w
0baa1a31 2use Imager ':all';
642a675b 3BEGIN { require "t/testtools.pl"; }
8b695554 4use strict;
0baa1a31 5
642a675b 6print "1..45\n";
0baa1a31
TC
7
8init_log("testout/t104ppm.log",1);
9
067d6bdc
AMH
10my $green = i_color_new(0,255,0,255);
11my $blue = i_color_new(0,0,255,255);
12my $red = i_color_new(255,0,0,255);
0baa1a31 13
067d6bdc 14my $img = Imager::ImgRaw::new(150,150,3);
0baa1a31
TC
15
16i_box_filled($img,70,25,130,125,$green);
17i_box_filled($img,20,25,80,125,$blue);
18i_arc($img,75,75,30,0,361,$red);
19i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
20
790923a4 21my $fh = openimage(">testout/t104.ppm");
8b695554 22my $IO = Imager::io_new_fd(fileno($fh));
067d6bdc
AMH
23i_writeppm_wiol($img, $IO)
24 or die "Cannot write testout/t104.ppm\n";
25close($fh);
0baa1a31
TC
26
27print "ok 1\n";
28
067d6bdc 29$IO = Imager::io_new_bufchain();
790923a4 30i_writeppm_wiol($img, $IO) or die "Cannot write to bufchain";
8b695554 31my $data = Imager::io_slurp($IO);
067d6bdc 32print "ok 2\n";
0baa1a31 33
067d6bdc
AMH
34$fh = openimage("testout/t104.ppm");
35$IO = Imager::io_new_fd( fileno($fh) );
8b695554 36my $cmpimg = i_readpnm_wiol($IO,-1) || die "Cannot read testout/t104.ppm\n";
067d6bdc
AMH
37close($fh);
38print "ok 3\n";
0baa1a31 39
067d6bdc
AMH
40print i_img_diff($img, $cmpimg) ? "not ok 4 # saved image different\n" : "ok 4\n";
41
42my $rdata = slurp("testout/t104.ppm");
43print "not " if $rdata ne $data;
44print "ok 5\n";
0baa1a31 45
0baa1a31 46
9f56d386
TC
47# build a grayscale image
48my $gimg = Imager::ImgRaw::new(150, 150, 1);
cd62a5a7
TC
49my $gray = i_color_new(128, 0, 0, 255);
50my $dgray = i_color_new(64, 0, 0, 255);
51my $white = i_color_new(255, 0, 0, 255);
9f56d386
TC
52i_box_filled($gimg, 20, 20, 130, 130, $gray);
53i_box_filled($gimg, 40, 40, 110, 110, $dgray);
54i_arc($gimg, 75, 75, 30, 0, 361, $white);
067d6bdc
AMH
55
56open FH, "> testout/t104_gray.pgm" or die "Cannot create testout/t104_gray.pgm: $!\n";
9f56d386 57binmode FH;
8b695554 58$IO = Imager::io_new_fd(fileno(FH));
067d6bdc
AMH
59i_writeppm_wiol($gimg, $IO) or print "not ";
60print "ok 6\n";
9f56d386 61close FH;
067d6bdc
AMH
62
63open FH, "< testout/t104_gray.pgm" or die "Cannot open testout/t104_gray.pgm: $!\n";
9f56d386
TC
64binmode FH;
65$IO = Imager::io_new_fd(fileno(FH));
067d6bdc
AMH
66my $gcmpimg = i_readpnm_wiol($IO, -1) or print "not ";
67print "ok 7\n";
9f56d386 68i_img_diff($gimg, $gcmpimg) == 0 or print "not ";
067d6bdc
AMH
69print "ok 8\n";
70
91492c5e
TC
71my $ooim = Imager->new;
72$ooim->read(file=>"testimg/simple.pbm") or print "not ";
73print "ok 9\n";
74
75check_gray(10, Imager::i_get_pixel($ooim->{IMG}, 0, 0), 255);
76check_gray(11, Imager::i_get_pixel($ooim->{IMG}, 0, 1), 0);
77check_gray(12, Imager::i_get_pixel($ooim->{IMG}, 1, 0), 0);
78check_gray(13, Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255);
79
8b695554
TC
80{
81 # https://rt.cpan.org/Ticket/Display.html?id=7465
82 # the pnm reader ignores the maxval that it reads from the pnm file
83 my $maxval = Imager->new;
84 $maxval->read(file=>"testimg/maxval.ppm") or print "not ";
85 print "ok 14 # read testimg/maxval.ppm\n";
86
87 # this image contains three pixels, with each sample from 0 to 63
88 # the pixels are (63, 63, 63), (32, 32, 32) and (31, 31, 0)
89
90 # check basic parameters
91 $maxval->getchannels == 3 or print "not ";
92 print "ok 15 # channel count\n";
93 $maxval->getwidth == 3 or print "not ";
94 print "ok 16 # width\n";
95 $maxval->getheight == 1 or print "not ";
96 print "ok 17 # height\n";
97
98 # check the pixels
99 my ($white, $grey, $green) = $maxval->getpixel('x'=>[0,1,2], 'y'=>[0,0,0])
100 or print "not ";
101 print "ok 18 # fetch pixels\n";
102 check_color(19, $white, 255, 255, 255, "white pixel");
103 check_color(20, $grey, 130, 130, 130, "grey pixel");
104 check_color(21, $green, 125, 125, 0, "green pixel");
105
106 # and do the same for ASCII images
107 my $maxval_asc = Imager->new;
108 $maxval_asc->read(file=>"testimg/maxval_asc.ppm") or print "not ";
109 print "ok 22 # read testimg/maxval_asc.ppm\n";
110
111 # this image contains three pixels, with each sample from 0 to 63
112 # the pixels are (63, 63, 63), (32, 32, 32) and (31, 31, 0)
113
114 # check basic parameters
115 $maxval_asc->getchannels == 3 or print "not ";
116 print "ok 23 # channel count\n";
117 $maxval_asc->getwidth == 3 or print "not ";
118 print "ok 24 # width\n";
119 $maxval_asc->getheight == 1 or print "not ";
120 print "ok 25 # height\n";
121
122 # check the pixels
123 my ($white_asc, $grey_asc, $green_asc) = $maxval_asc->getpixel('x'=>[0,1,2], 'y'=>[0,0,0])
124 or print "not ";
125 print "ok 26 # fetch pixels\n";
126 check_color(27, $white_asc, 255, 255, 255, "white asc pixel");
127 check_color(28, $grey_asc, 130, 130, 130, "grey asc pixel");
128 check_color(29, $green_asc, 125, 125, 0, "green asc pixel");
129}
130
131{ # previously we didn't validate maxval at all, make sure it's
132 # validated now
133 my $maxval0 = Imager->new;
134 $maxval0->read(file=>'testimg/maxval_0.ppm') and print "not ";
135 print "ok 30 # reading maxval 0 image\n";
136 print "# ", $maxval0->errstr, "\n";
137 $maxval0->errstr =~ /maxval is zero - invalid pnm file/
138 or print "not ";
139 print "ok 31 # error expected from reading maxval_0.ppm\n";
140
141 my $maxval65536 = Imager->new;
142 $maxval65536->read(file=>'testimg/maxval_65536.ppm') and print "not ";
143 print "ok 32 # reading maxval 65536 image\n";
144 print "# ",$maxval65536->errstr, "\n";
145 $maxval65536->errstr =~ /maxval of 65536 is over 65535 - invalid pnm file/
146 or print "not ";
147 print "ok 33 # error expected from reading maxval_65536.ppm\n";
148
149 # maxval of 256 is valid, but Imager can't handle it yet in binary files
150 my $maxval256 = Imager->new;
151 $maxval256->read(file=>'testimg/maxval_256.ppm') and print "not ";
152 print "ok 34 # reading maxval 256 image\n";
153 print "# ",$maxval256->errstr,"\n";
154 $maxval256->errstr =~ /maxval of 256 is over 255 - not currently supported by Imager/
155 or print "not ";
156 print "ok 35 # error expected from reading maxval_256.ppm\n";
157
158 # make sure we handle maxval > 255 for ascii
159 my $maxval4095asc = Imager->new;
160 okn(36, $maxval4095asc->read(file=>'testimg/maxval_4095_asc.ppm'),
161 "read maxval_4095_asc.ppm");
162 okn(37, $maxval4095asc->getchannels == 3, "channels");
163 okn(38, $maxval4095asc->getwidth == 3, "width");
164 okn(39, $maxval4095asc->getheight == 1, "height");
165
166 my ($white, $grey, $green) = $maxval4095asc->getpixel('x'=>[0,1,2], 'y'=>[0,0,0])
167 or print "not ";
168 print "ok 40 # fetch pixels\n";
169 check_color(41, $white, 255, 255, 255, "white 4095 pixel");
170 check_color(42, $grey, 128, 128, 128, "grey 4095 pixel");
171 check_color(43, $green, 127, 127, 0, "green 4095 pixel");
172}
173
642a675b
TC
174my $num = 44;
175{ # check i_format is set when reading a pnm file
176 # doesn't really matter which file.
177 my $maxval = Imager->new;
178 okn($num++, $maxval->read(file=>"testimg/maxval.ppm"),
179 "read test file");
180 my ($type) = $maxval->tags(name=>'i_format');
181 isn($num++, $type, 'pnm', "check i_format");
182}
183
067d6bdc
AMH
184sub openimage {
185 my $fname = shift;
186 local(*FH);
187 open(FH, $fname) or die "Cannot open $fname: $!\n";
188 binmode(FH);
189 return *FH;
190}
0baa1a31 191
067d6bdc
AMH
192sub slurp {
193 my $fh = openimage(shift);
194 local $/;
195 my $data = <$fh>;
196 close($fh);
197 return $data;
198}
91492c5e
TC
199
200sub check_gray {
201 my ($num, $c, $gray) = @_;
202
203 my ($g) = $c->rgba;
204 if ($g == $gray) {
205 print "ok $num\n";
206 }
207 else {
208 print "not ok $num # $g doesn't match $gray\n";
209 }
210}
8b695554
TC
211
212sub check_color {
213 my ($num, $c, $red, $green, $blue, $note) = @_;
214
215 my ($r, $g, $b) = $c->rgba;
216 if ($r == $red && $g == $green && $b == $blue) {
217 print "ok $num # $note\n";
218 }
219 else {
220 print "not ok $num # ($r, $g, $b) doesn't match ($red, $green, $blue)\n";
221 }
222}