ascii pbms weren't treated correctly
[imager.git] / t / t104ppm.t
CommitLineData
0baa1a31
TC
1use Imager ':all';
2
91492c5e 3print "1..13\n";
0baa1a31
TC
4
5init_log("testout/t104ppm.log",1);
6
067d6bdc
AMH
7my $green = i_color_new(0,255,0,255);
8my $blue = i_color_new(0,0,255,255);
9my $red = i_color_new(255,0,0,255);
0baa1a31 10
067d6bdc 11my $img = Imager::ImgRaw::new(150,150,3);
0baa1a31
TC
12
13i_box_filled($img,70,25,130,125,$green);
14i_box_filled($img,20,25,80,125,$blue);
15i_arc($img,75,75,30,0,361,$red);
16i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
17
790923a4 18my $fh = openimage(">testout/t104.ppm");
067d6bdc
AMH
19$IO = Imager::io_new_fd(fileno($fh));
20i_writeppm_wiol($img, $IO)
21 or die "Cannot write testout/t104.ppm\n";
22close($fh);
0baa1a31
TC
23
24print "ok 1\n";
25
067d6bdc 26$IO = Imager::io_new_bufchain();
790923a4 27i_writeppm_wiol($img, $IO) or die "Cannot write to bufchain";
067d6bdc
AMH
28$data = Imager::io_slurp($IO);
29print "ok 2\n";
0baa1a31 30
067d6bdc
AMH
31$fh = openimage("testout/t104.ppm");
32$IO = Imager::io_new_fd( fileno($fh) );
33$cmpimg = i_readpnm_wiol($IO,-1) || die "Cannot read testout/t104.ppm\n";
34close($fh);
35print "ok 3\n";
0baa1a31 36
067d6bdc
AMH
37print i_img_diff($img, $cmpimg) ? "not ok 4 # saved image different\n" : "ok 4\n";
38
39my $rdata = slurp("testout/t104.ppm");
40print "not " if $rdata ne $data;
41print "ok 5\n";
0baa1a31 42
0baa1a31 43
9f56d386
TC
44# build a grayscale image
45my $gimg = Imager::ImgRaw::new(150, 150, 1);
cd62a5a7
TC
46my $gray = i_color_new(128, 0, 0, 255);
47my $dgray = i_color_new(64, 0, 0, 255);
48my $white = i_color_new(255, 0, 0, 255);
9f56d386
TC
49i_box_filled($gimg, 20, 20, 130, 130, $gray);
50i_box_filled($gimg, 40, 40, 110, 110, $dgray);
51i_arc($gimg, 75, 75, 30, 0, 361, $white);
067d6bdc
AMH
52
53open FH, "> testout/t104_gray.pgm" or die "Cannot create testout/t104_gray.pgm: $!\n";
9f56d386 54binmode FH;
067d6bdc
AMH
55my $IO = Imager::io_new_fd(fileno(FH));
56i_writeppm_wiol($gimg, $IO) or print "not ";
57print "ok 6\n";
9f56d386 58close FH;
067d6bdc
AMH
59
60open FH, "< testout/t104_gray.pgm" or die "Cannot open testout/t104_gray.pgm: $!\n";
9f56d386
TC
61binmode FH;
62$IO = Imager::io_new_fd(fileno(FH));
067d6bdc
AMH
63my $gcmpimg = i_readpnm_wiol($IO, -1) or print "not ";
64print "ok 7\n";
9f56d386 65i_img_diff($gimg, $gcmpimg) == 0 or print "not ";
067d6bdc
AMH
66print "ok 8\n";
67
91492c5e
TC
68my $ooim = Imager->new;
69$ooim->read(file=>"testimg/simple.pbm") or print "not ";
70print "ok 9\n";
71
72check_gray(10, Imager::i_get_pixel($ooim->{IMG}, 0, 0), 255);
73check_gray(11, Imager::i_get_pixel($ooim->{IMG}, 0, 1), 0);
74check_gray(12, Imager::i_get_pixel($ooim->{IMG}, 1, 0), 0);
75check_gray(13, Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255);
76
067d6bdc
AMH
77sub openimage {
78 my $fname = shift;
79 local(*FH);
80 open(FH, $fname) or die "Cannot open $fname: $!\n";
81 binmode(FH);
82 return *FH;
83}
0baa1a31 84
067d6bdc
AMH
85sub slurp {
86 my $fh = openimage(shift);
87 local $/;
88 my $data = <$fh>;
89 close($fh);
90 return $data;
91}
91492c5e
TC
92
93sub check_gray {
94 my ($num, $c, $gray) = @_;
95
96 my ($g) = $c->rgba;
97 if ($g == $gray) {
98 print "ok $num\n";
99 }
100 else {
101 print "not ok $num # $g doesn't match $gray\n";
102 }
103}