t/t103raw.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 47;
   4 use Imager qw(:all);
   5 use Imager::Test qw/is_color3 is_color4/;
   6 init_log("testout/t103raw.log",1);
   7
   8 $| = 1;
   9
  10 my $green=i_color_new(0,255,0,255);
  11 my $blue=i_color_new(0,0,255,255);
  12 my $red=i_color_new(255,0,0,255);
  13
  14 my $img=Imager::ImgRaw::new(150,150,3);
  15 my $cmpimg=Imager::ImgRaw::new(150,150,3);
  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
  22 my $timg = Imager::ImgRaw::new(20, 20, 4);
  23 my $trans = i_color_new(255, 0, 0, 127);
  24 i_box_filled($timg, 0, 0, 20, 20, $green);
  25 i_box_filled($timg, 2, 2, 18, 18, $trans);
  26
  27 open(FH,">testout/t103.raw") || die "Cannot open testout/t103.raw for writing\n";
  28 binmode(FH);
  29 my $IO = Imager::io_new_fd( fileno(FH) );
  30 ok(i_writeraw_wiol($img, $IO), "write raw low") or
  31   print "# Cannot write testout/t103.raw\n";
  32 close(FH);
  33
  34 open(FH,"testout/t103.raw") || die "Cannot open testout/t103.raw\n";
  35 binmode(FH);
  36 $IO = Imager::io_new_fd( fileno(FH) );
  37 $cmpimg = i_readraw_wiol($IO, 150, 150, 3, 3, 0);
  38 ok($cmpimg, "read raw low")
  39   or print "# Cannot read testout/t103.raw\n";
  40 close(FH);
  41
  42 print "# raw average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
  43
  44 # I could have kept the raw images for these tests in binary files in
  45 # testimg/, but I think keeping them as hex encoded data in here makes
  46 # it simpler to add more if necessary
  47 # Later we may change this to read from a scalar instead
  48 save_data('testout/t103_base.raw');
  49 save_data('testout/t103_3to4.raw');
  50 save_data('testout/t103_line_int.raw');
  51 save_data('testout/t103_img_int.raw');
  52
  53 # load the base image
  54 open FH, "testout/t103_base.raw"
  55   or die "Cannot open testout/t103_base.raw: $!";
  56 binmode FH;
  57 $IO = Imager::io_new_fd( fileno(FH) );
  58
  59 my $baseimg = i_readraw_wiol( $IO, 4, 4, 3, 3, 0);
  60 ok($baseimg, "read base raw image")
  61   or die "Cannot read base raw image";
  62 close FH;
  63
  64 # the actual read tests
  65 # each read_test() call does 2 tests:
  66 #  - check if the read succeeds
  67 #  - check if it matches $baseimg
  68 read_test('testout/t103_3to4.raw', 4, 4, 4, 3, 0, $baseimg);
  69 read_test('testout/t103_line_int.raw', 4, 4, 3, 3, 1, $baseimg);
  70 # intrl==2 is documented in raw.c but doesn't seem to be implemented
  71 #read_test('testout/t103_img_int.raw', 4, 4, 3, 3, 2, $baseimg, 7);
  72
  73 # paletted images
  74 SKIP:
  75 {
  76   my $palim = Imager::i_img_pal_new(20, 20, 3, 256);
  77   ok($palim, "make paletted image")
  78     or skip("couldn't make paletted image", 2);
  79   my $redindex = Imager::i_addcolors($palim, $red);
  80   my $blueindex = Imager::i_addcolors($palim, $blue);
  81   for my $y (0..9) {
  82     Imager::i_ppal($palim, 0, $y, ($redindex) x 20);
  83   }
  84   for my $y (10..19) {
  85     Imager::i_ppal($palim, 0, $y, ($blueindex) x 20);
  86   }
  87   open FH, "> testout/t103_pal.raw"
  88     or die "Cannot create testout/t103_pal.raw: $!";
  89   binmode FH;
  90   $IO = Imager::io_new_fd(fileno(FH));
  91   ok(i_writeraw_wiol($palim, $IO), "write low paletted");
  92   close FH;
  93
  94   open FH, "testout/t103_pal.raw"
  95     or die "Cannot open testout/t103_pal.raw: $!";
  96   binmode FH;
  97   my $data = do { local $/; <FH> };
  98   is($data, "\x0" x 200 . "\x1" x 200, "compare paletted data written");
  99   close FH;
 100 }
 101
 102 # 16-bit image
 103 # we don't have 16-bit reads yet
 104 SKIP:
 105 {
 106   my $img16 = Imager::i_img_16_new(150, 150, 3);
 107   ok($img16, "make 16-bit/sample image")
 108     or skip("couldn't make 16 bit/sample image", 1);
 109   i_box_filled($img16,70,25,130,125,$green);
 110   i_box_filled($img16,20,25,80,125,$blue);
 111   i_arc($img16,75,75,30,0,361,$red);
 112   i_conv($img16,[0.1, 0.2, 0.4, 0.2, 0.1]);
 113
 114   open FH, "> testout/t103_16.raw"
 115     or die "Cannot create testout/t103_16.raw: $!";
 116   binmode FH;
 117   $IO = Imager::io_new_fd(fileno(FH));
 118   ok(i_writeraw_wiol($img16, $IO), "write low 16 bit image");
 119   close FH;
 120 }
 121
 122 # try a simple virtual image
 123 SKIP:
 124 {
 125   my $maskimg = Imager::i_img_masked_new($img, undef, 0, 0, 150, 150);
 126   ok($maskimg, "make masked image")
 127     or skip("couldn't make masked image", 3);
 128
 129   open FH, "> testout/t103_virt.raw"
 130     or die "Cannot create testout/t103_virt.raw: $!";
 131   binmode FH;
 132   $IO = Imager::io_new_fd(fileno(FH));
 133   ok(i_writeraw_wiol($maskimg, $IO), "write virtual raw");
 134   close FH;
 135
 136   open FH, "testout/t103_virt.raw"
 137     or die "Cannot open testout/t103_virt.raw: $!";
 138   binmode FH;
 139   $IO = Imager::io_new_fd(fileno(FH));
 140   my $cmpimgmask = i_readraw_wiol($IO, 150, 150, 3, 3, 0);
 141   ok($cmpimgmask, "read result of masked write");
 142   my $diff = i_img_diff($maskimg, $cmpimgmask);
 143   print "# difference for virtual image $diff\n";
 144   is($diff, 0, "compare masked to read");
 145
 146   # check that i_format is set correctly
 147   my $index = Imager::i_tags_find($cmpimgmask, 'i_format', 0);
 148   if ($index) {
 149     my $value = Imager::i_tags_get($cmpimgmask, $index);
 150     is($value, 'raw', "check i_format value");
 151   }
 152   else {
 153     fail("couldn't find i_format tag");
 154   }
 155 }
 156
 157 { # error handling checks
 158   # should get an error writing to a open for read file
 159   # make a empty file
 160   open RAW, "> testout/t103_empty.raw"
 161     or die "Cannot create testout/t103_empty.raw: $!";
 162   close RAW;
 163   open RAW, "< testout/t103_empty.raw"
 164     or die "Cannot open testout/t103_empty.raw: $!";
 165   my $im = Imager->new(xsize => 50, ysize=>50);
 166   ok(!$im->write(fh => \*RAW, type => 'raw'),
 167      "write to open for read handle");
 168   cmp_ok($im->errstr, '=~', '^Could not write to file: write\(\) failure',
 169          "check error message");
 170   close RAW;
 171
 172   # should get an error reading an empty file
 173   ok(!$im->read(file => 'testout/t103_empty.raw', xsize => 50, ysize=>50, type=>'raw', interleave => 1),
 174      'read an empty file');
 175   is($im->errstr, 'premature end of file', "check message");
 176   open RAW, "> testout/t103_empty.raw"
 177     or die "Cannot create testout/t103_empty.raw: $!";
 178   ok(!$im->read(fh => \*RAW, , xsize => 50, ysize=>50, type=>'raw', interleave => 1),
 179      'read a file open for write');
 180   cmp_ok($im->errstr, '=~', '^error reading file: read\(\) failure', "check message");
 181
 182 }
 183
 184
 185 {
 186   ok(grep($_ eq 'raw', Imager->read_types), "check raw in read types");
 187   ok(grep($_ eq 'raw', Imager->write_types), "check raw in write types");
 188 }
 189
 190
 191 { # OO no interleave warning
 192   my $im = Imager->new;
 193   my $msg;
 194   local $SIG{__WARN__} = sub { $msg = "@_" };
 195   ok($im->read(file => "testout/t103_line_int.raw", xsize => 4, ysize => 4,
 196                type => "raw"),
 197      "read without interleave parameter")
 198     or print "# ", $im->errstr, "\n";
 199   ok($msg, "should have warned");
 200   like($msg, qr/interleave/, "check warning is ok");
 201   # check we got the right value
 202   is_color3($im->getpixel(x => 0, y => 0), 0x00, 0x11, 0x22,
 203             "check the image was read correctly");
 204
 205   # check no warning if either is supplied
 206   $im = Imager->new;
 207   undef $msg;
 208   ok($im->read(file => "testout/t103_base.raw", xsize => 4, ysize => 4, type => "raw", interleave => 0),
 209      "read with interleave 0");
 210   is($msg, undef, "no warning");
 211   is_color3($im->getpixel(x => 0, y => 0), 0x00, 0x11, 0x22,
 212             "check read non-interleave");
 213
 214   $im = Imager->new;
 215   undef $msg;
 216   ok($im->read(file => "testout/t103_base.raw", xsize => 4, ysize => 4, type => "raw", raw_interleave => 0),
 217      "read with raw_interleave 0");
 218   is($msg, undef, "no warning");
 219   is_color3($im->getpixel(x => 1, y => 0), 0x01, 0x12, 0x23,
 220             "check read non-interleave");
 221
 222   # make sure set to 1 is sane
 223   $im = Imager->new;
 224   undef $msg;
 225   ok($im->read(file => "testout/t103_line_int.raw", xsize => 4, ysize => 4, type => "raw", raw_interleave => 1),
 226      "read with raw_interleave 1");
 227   is($msg, undef, "no warning");
 228   is_color3($im->getpixel(x => 2, y => 0), 0x02, 0x13, 0x24,
 229             "check read interleave = 1");
 230 }
 231
 232 { # invalid interleave error handling
 233   my $im = Imager->new;
 234   ok(!$im->read(file => "testout/t103_base.raw", raw_interleave => 2, type => "raw", xsize => 4, ysize => 4),
 235      "invalid interleave");
 236   is($im->errstr, "raw_interleave must be 0 or 1", "check message");
 237 }
 238
 239 { # store/data channel behaviour
 240   my $im = Imager->new;
 241   ok($im->read(file => "testout/t103_3to4.raw", xsize => 4, ysize => 4,
 242                raw_datachannels => 4, raw_interleave => 0, type => "raw"),
 243      "read 4 channel file as 3 channels")
 244     or print "# ", $im->errstr, "\n";
 245   is_color3($im->getpixel(x => 2, y => 1), 0x12, 0x23, 0x34,
 246             "check read correctly");
 247 }
 248
 249 { # should fail to read with storechannels > 4
 250   my $im = Imager->new;
 251   ok(!$im->read(file => "testout/t103_line_int.raw", type => "raw",
 252                 raw_interleave => 1, xsize => 4, ysize => 4,
 253                 raw_storechannels => 5),
 254      "read with large storechannels");
 255   is($im->errstr, "raw_storechannels must be between 1 and 4",
 256      "check error message");
 257 }
 258
 259 { # should zero spare channels if storechannels > datachannels
 260   my $im = Imager->new;
 261   ok($im->read(file => "testout/t103_base.raw", type => "raw",
 262                 raw_interleave => 0, xsize => 4, ysize => 4,
 263                 raw_storechannels => 4),
 264      "read with storechannels > datachannels");
 265   is($im->getchannels, 4, "should have 4 channels");
 266   is_color4($im->getpixel(x => 2, y => 1), 0x12, 0x23, 0x34, 0x00,
 267             "check last channel zeroed");
 268 }
 269
 270 unlink(qw(testout/t103_base.raw testout/t103_3to4.raw
 271           testout/t103_line_int.raw testout/t103_img_int.raw))
 272   unless $ENV{IMAGER_KEEP_FILES};
 273
 274 sub read_test {
 275   my ($in, $xsize, $ysize, $data, $store, $intrl, $base) = @_;
 276   open FH, $in or die "Cannot open $in: $!";
 277   binmode FH;
 278   my $IO = Imager::io_new_fd( fileno(FH) );
 279
 280   my $img = i_readraw_wiol($IO, $xsize, $ysize, $data, $store, $intrl);
 281  SKIP:
 282   {
 283     ok($img, "read_test $in read")
 284       or skip("couldn't read $in", 1);
 285     is(i_img_diff($img, $baseimg), 0, "read_test $in compare");
 286   }
 287 }
 288
 289 sub save_data {
 290   my $outname = shift;
 291   my $data = load_data();
 292   open FH, "> $outname" or die "Cannot create $outname: $!";
 293   binmode FH;
 294   print FH $data;
 295   close FH;
 296 }
 297
 298 sub load_data {
 299   my $hex = '';
 300   while (<DATA>) {
 301     next if /^#/;
 302     last if /^EOF/;
 303     chomp;
 304     $hex .= $_;
 305   }
 306   $hex =~ tr/ //d;
 307   my $result = pack("H*", $hex);
 308   #print unpack("H*", $result),"\n";
 309   return $result;
 310 }
 311
 312 # FIXME: may need tests for 1,2,4 channel images
 313
 314 __DATA__
 315 # we keep some packed raw images here
 316 # we decode this in the code, ignoring lines starting with #, a subfile
 317 # ends with EOF, data is HEX encoded (spaces ignored)
 318
 319 # basic 3 channel version of the image
 320 001122 011223 021324 031425
 321 102132 112233 122334 132435
 322 203142 213243 223344 233445
 323 304152 314253 324354 334455
 324 EOF
 325
 326 # test image for reading a 4 channel image into a 3 channel image
 327 # 4 x 4 pixels
 328 00112233 01122334 02132435 03142536
 329 10213243 11223344 12233445 13243546
 330 20314253 21324354 22334455 23344556
 331 30415263 31425364 32435465 33445566
 332 EOF
 333
 334 # test image for line based interlacing
 335 # 4 x 4 pixels
 336 # first line
 337 00 01 02 03
 338 11 12 13 14
 339 22 23 24 25
 340
 341 # second line
 342 10 11 12 13
 343 21 22 23 24
 344 32 33 34 35
 345
 346 # third line
 347 20 21 22 23
 348 31 32 33 34
 349 42 43 44 45
 350
 351 # fourth line
 352 30 31 32 33
 353 41 42 43 44
 354 52 53 54 55
 355
 356 EOF
 357
 358 # test image for image based interlacing
 359 # first channel
 360 00 01 02 03
 361 10 11 12 13
 362 20 21 22 23
 363 30 31 32 33
 364
 365 # second channel
 366 11 12 13 14
 367 21 22 23 24
 368 31 32 33 34
 369 41 42 43 44
 370
 371 # third channel
 372 22 23 24 25
 373 32 33 34 35
 374 42 43 44 45
 375 52 53 54 55
 376
 377 EOF