d4f3af84b57e5700f148585cdf8931b9d75d76cb
[imager.git] / t / t104ppm.t
1 use Imager ':all';
2
3 print "1..8\n";
4
5 init_log("testout/t104ppm.log",1);
6
7 my $green = i_color_new(0,255,0,255);
8 my $blue  = i_color_new(0,0,255,255);
9 my $red   = i_color_new(255,0,0,255);
10
11 my $img    = Imager::ImgRaw::new(150,150,3);
12
13 i_box_filled($img,70,25,130,125,$green);
14 i_box_filled($img,20,25,80,125,$blue);
15 i_arc($img,75,75,30,0,361,$red);
16 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
17
18 my $fh = openimage(">testout/t104.ppm");
19 $IO = Imager::io_new_fd(fileno($fh));
20 i_writeppm_wiol($img, $IO) 
21   or die "Cannot write testout/t104.ppm\n";
22 close($fh);
23
24 print "ok 1\n";
25
26 $IO = Imager::io_new_bufchain();
27 i_writeppm_wiol($img, $IO) or die "Cannot write to bufchain";
28 $data = Imager::io_slurp($IO);
29 print "ok 2\n";
30
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";
34 close($fh);
35 print "ok 3\n";
36
37 print i_img_diff($img, $cmpimg) ? "not ok 4 # saved image different\n" : "ok 4\n";
38
39 my $rdata = slurp("testout/t104.ppm");
40 print "not " if $rdata ne $data;
41 print "ok 5\n";
42
43
44 # build a grayscale image
45 my $gimg = Imager::ImgRaw::new(150, 150, 1);
46 my $gray = i_color_new(128, 0, 0, 255);
47 my $dgray = i_color_new(64, 0, 0, 255);
48 my $white = i_color_new(255, 0, 0, 255);
49 i_box_filled($gimg, 20, 20, 130, 130, $gray);
50 i_box_filled($gimg, 40, 40, 110, 110, $dgray);
51 i_arc($gimg, 75, 75, 30, 0, 361, $white);
52
53 open FH, "> testout/t104_gray.pgm" or die "Cannot create testout/t104_gray.pgm: $!\n";
54 binmode FH;
55 my $IO = Imager::io_new_fd(fileno(FH));
56 i_writeppm_wiol($gimg, $IO) or print "not ";
57 print "ok 6\n";
58 close FH;
59
60 open FH, "< testout/t104_gray.pgm" or die "Cannot open testout/t104_gray.pgm: $!\n";
61 binmode FH;
62 $IO = Imager::io_new_fd(fileno(FH));
63 my $gcmpimg = i_readpnm_wiol($IO, -1) or print "not ";
64 print "ok 7\n";
65 i_img_diff($gimg, $gcmpimg) == 0 or print "not ";
66 print "ok 8\n";
67
68 sub openimage {
69   my $fname = shift;
70   local(*FH);
71   open(FH, $fname) or die "Cannot open $fname: $!\n";
72   binmode(FH);
73   return *FH;
74 }
75
76 sub slurp {
77   my $fh = openimage(shift);
78   local $/;
79   my $data = <$fh>;
80   close($fh);
81   return $data;
82 }