b565cbf730e31da7cfb8047ebd083991b399cca1
[imager.git] / t / t103raw.t
1 #!perl -w
2 use strict;
3 use lib 't';
4 use Test::More tests => 17;
5 use Imager qw(:all);
6 init_log("testout/t103raw.log",1);
7
8 my $green=i_color_new(0,255,0,255);
9 my $blue=i_color_new(0,0,255,255);
10 my $red=i_color_new(255,0,0,255);
11
12 my $img=Imager::ImgRaw::new(150,150,3);
13 my $cmpimg=Imager::ImgRaw::new(150,150,3);
14
15 i_box_filled($img,70,25,130,125,$green);
16 i_box_filled($img,20,25,80,125,$blue);
17 i_arc($img,75,75,30,0,361,$red);
18 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
19
20 my $timg = Imager::ImgRaw::new(20, 20, 4);
21 my $trans = i_color_new(255, 0, 0, 127);
22 i_box_filled($timg, 0, 0, 20, 20, $green);
23 i_box_filled($timg, 2, 2, 18, 18, $trans);
24
25 open(FH,">testout/t103.raw") || die "Cannot open testout/t103.raw for writing\n";
26 binmode(FH);
27 my $IO = Imager::io_new_fd( fileno(FH) );
28 ok(i_writeraw_wiol($img, $IO), "write raw low") or
29   print "# Cannot write testout/t103.raw\n";
30 close(FH);
31
32 open(FH,"testout/t103.raw") || die "Cannot open testout/t103.raw\n";
33 binmode(FH);
34 $IO = Imager::io_new_fd( fileno(FH) );
35 $cmpimg = i_readraw_wiol($IO, 150, 150, 3, 3, 0);
36 ok($cmpimg, "read raw low")
37   or print "# Cannot read testout/t103.raw\n";
38 close(FH);
39
40 print "# raw average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
41
42 # I could have kept the raw images for these tests in binary files in
43 # testimg/, but I think keeping them as hex encoded data in here makes
44 # it simpler to add more if necessary
45 # Later we may change this to read from a scalar instead
46 save_data('testout/t103_base.raw');
47 save_data('testout/t103_3to4.raw');
48 save_data('testout/t103_line_int.raw');
49 save_data('testout/t103_img_int.raw');
50
51 # load the base image
52 open FH, "testout/t103_base.raw" 
53   or die "Cannot open testout/t103_base.raw: $!";
54 binmode FH;
55 $IO = Imager::io_new_fd( fileno(FH) );
56
57 my $baseimg = i_readraw_wiol( $IO, 4, 4, 3, 3, 0);
58 ok($baseimg, "read base raw image")
59   or die "Cannot read base raw image";
60 close FH;
61
62 # the actual read tests
63 # each read_test() call does 2 tests:
64 #  - check if the read succeeds
65 #  - check if it matches $baseimg
66 read_test('testout/t103_3to4.raw', 4, 4, 4, 3, 0, $baseimg);
67 read_test('testout/t103_line_int.raw', 4, 4, 3, 3, 1, $baseimg);
68 # intrl==2 is documented in raw.c but doesn't seem to be implemented
69 #read_test('testout/t103_img_int.raw', 4, 4, 3, 3, 2, $baseimg, 7);
70
71 # paletted images
72 SKIP:
73 {
74   my $palim = Imager::i_img_pal_new(20, 20, 3, 256);
75   ok($palim, "make paletted image")
76     or skip("couldn't make paletted image", 2);
77   my $redindex = Imager::i_addcolors($palim, $red);
78   my $blueindex = Imager::i_addcolors($palim, $blue);
79   for my $y (0..9) {
80     Imager::i_ppal($palim, 0, $y, ($redindex) x 20);
81   }
82   for my $y (10..19) {
83     Imager::i_ppal($palim, 0, $y, ($blueindex) x 20);
84   }
85   open FH, "> testout/t103_pal.raw"
86     or die "Cannot create testout/t103_pal.raw: $!";
87   binmode FH;
88   $IO = Imager::io_new_fd(fileno(FH));
89   ok(i_writeraw_wiol($palim, $IO), "write low paletted");
90   close FH;
91   
92   open FH, "testout/t103_pal.raw"
93     or die "Cannot open testout/t103_pal.raw: $!";
94   binmode FH;
95   my $data = do { local $/; <FH> };
96   is($data, "\x0" x 200 . "\x1" x 200, "compare paletted data written");
97   close FH;
98 }
99
100 # 16-bit image
101 # we don't have 16-bit reads yet
102 SKIP:
103 {
104   my $img16 = Imager::i_img_16_new(150, 150, 3);
105   ok($img16, "make 16-bit/sample image")
106     or skip("couldn't make 16 bit/sample image", 1);
107   i_box_filled($img16,70,25,130,125,$green);
108   i_box_filled($img16,20,25,80,125,$blue);
109   i_arc($img16,75,75,30,0,361,$red);
110   i_conv($img16,[0.1, 0.2, 0.4, 0.2, 0.1]);
111   
112   open FH, "> testout/t103_16.raw" 
113     or die "Cannot create testout/t103_16.raw: $!";
114   binmode FH;
115   $IO = Imager::io_new_fd(fileno(FH));
116   ok(i_writeraw_wiol($img16, $IO), "write low 16 bit image");
117   close FH;
118 }
119
120 # try a simple virtual image
121 SKIP:
122 {
123   my $maskimg = Imager::i_img_masked_new($img, undef, 0, 0, 150, 150);
124   ok($maskimg, "make masked image")
125     or skip("couldn't make masked image", 3);
126
127   open FH, "> testout/t103_virt.raw" 
128     or die "Cannot create testout/t103_virt.raw: $!";
129   binmode FH;
130   $IO = Imager::io_new_fd(fileno(FH));
131   ok(i_writeraw_wiol($maskimg, $IO), "write virtual raw");
132   close FH;
133
134   open FH, "testout/t103_virt.raw"
135     or die "Cannot open testout/t103_virt.raw: $!";
136   binmode FH;
137   $IO = Imager::io_new_fd(fileno(FH));
138   my $cmpimgmask = i_readraw_wiol($IO, 150, 150, 3, 3, 0);
139   ok($cmpimgmask, "read result of masked write");
140   my $diff = i_img_diff($maskimg, $cmpimgmask);
141   print "# difference for virtual image $diff\n";
142   is($diff, 0, "compare masked to read");
143
144   # check that i_format is set correctly
145   my $index = Imager::i_tags_find($cmpimgmask, 'i_format', 0);
146   if ($index) {
147     my $value = Imager::i_tags_get($cmpimgmask, $index);
148     is($value, 'raw', "check i_format value");
149   }
150   else {
151     fail("couldn't find i_format tag");
152   }
153 }
154
155 sub read_test {
156   my ($in, $xsize, $ysize, $data, $store, $intrl, $base) = @_;
157   open FH, $in or die "Cannot open $in: $!";
158   binmode FH;
159   my $IO = Imager::io_new_fd( fileno(FH) );
160
161   my $img = i_readraw_wiol($IO, $xsize, $ysize, $data, $store, $intrl);
162  SKIP:
163   {
164     ok($img, "read_test $in read")
165       or skip("couldn't read $in", 1);
166     is(i_img_diff($img, $baseimg), 0, "read_test $in compare");
167   }
168 }
169
170 sub save_data {
171   my $outname = shift;
172   my $data = load_data();
173   open FH, "> $outname" or die "Cannot create $outname: $!";
174   binmode FH;
175   print FH $data;
176   close FH;
177 }
178
179 sub load_data {
180   my $hex = '';
181   while (<DATA>) {
182     next if /^#/;
183     last if /^EOF/;
184     chomp;
185     $hex .= $_;
186   }
187   $hex =~ tr/ //d;
188   my $result = pack("H*", $hex);
189   #print unpack("H*", $result),"\n";
190   return $result;
191 }
192
193 # FIXME: may need tests for 1,2,4 channel images
194
195 __DATA__
196 # we keep some packed raw images here
197 # we decode this in the code, ignoring lines starting with #, a subfile
198 # ends with EOF, data is HEX encoded (spaces ignored)
199
200 # basic 3 channel version of the image
201 001122 011223 021324 031425
202 102132 112233 122334 132435
203 203142 213243 223344 233445
204 304152 314253 324354 334455
205 EOF
206
207 # test image for reading a 4 channel image into a 3 channel image
208 # 4 x 4 pixels
209 00112233 01122334 02132435 03142536
210 10213243 11223344 12233445 13243546
211 20314253 21324354 22334455 23344556
212 30415263 31425364 32435465 33445566
213 EOF
214
215 # test image for line based interlacing
216 # 4 x 4 pixels
217 # first line
218 00 01 02 03
219 11 12 13 14
220 22 23 24 25
221
222 # second line
223 10 11 12 13
224 21 22 23 24
225 32 33 34 35
226
227 # third line
228 20 21 22 23
229 31 32 33 34
230 42 43 44 45
231
232 # fourth line
233 30 31 32 33
234 41 42 43 44
235 52 53 54 55
236
237 EOF
238
239 # test image for image based interlacing
240 # first channel
241 00 01 02 03
242 10 11 12 13
243 20 21 22 23
244 30 31 32 33
245
246 # second channel
247 11 12 13 14
248 21 22 23 24
249 31 32 33 34
250 41 42 43 44
251
252 # third channel
253 22 23 24 25
254 32 33 34 35
255 42 43 44 45
256 52 53 54 55
257
258 EOF