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