ICO/t/t10icon.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 100;
   4 use Imager::Test qw(is_image);
   5
   6 BEGIN { use_ok('Imager::File::ICO'); }
   7
   8 -d 'testout' or mkdir 'testout', 0777;
   9
  10 my $im = Imager->new;
  11 # type=>'ico' or 'cur' and read ico and cur since they're pretty much
  12 # the same
  13 ok($im->read(file => "testimg/rgba3232.ico", type=>"ico", ico_masked => 0),
  14    "read 32 bit")
  15   or print "# ", $im->errstr, "\n";
  16 is($im->getwidth, 32, "check width");
  17 is($im->getwidth, 32, "check height");
  18 is($im->type, 'direct', "check type");
  19 is($im->tags(name => 'ico_bits'), 32, "check ico_bits tag");
  20 is($im->tags(name => 'i_format'), 'ico', "check i_format tag");
  21 my $mask = '.*
  22 ..........................******
  23 ..........................******
  24 ..........................******
  25 ..........................******
  26 ...........................*****
  27 ............................****
  28 ............................****
  29 .............................***
  30 .............................***
  31 .............................***
  32 .............................***
  33 ..............................**
  34 ..............................**
  35 ...............................*
  36 ...............................*
  37 ................................
  38 ................................
  39 ................................
  40 ................................
  41 ................................
  42 ................................
  43 *...............................
  44 **..............................
  45 **..............................
  46 ***.............................
  47 ***.............................
  48 ****............................
  49 ****............................
  50 *****...........................
  51 *****...........................
  52 *****...........................
  53 *****...........................';
  54 is($im->tags(name => 'ico_mask'), $mask, "check ico_mask_tag");
  55
  56 # compare the pixels
  57 # ppm can't store 4 channels
  58 SKIP:
  59 {
  60   my $work = $im->convert(preset=>'noalpha');
  61   my $comp = Imager->new;
  62   $comp->read(file => "testimg/rgba3232.ppm")
  63     or skip "could not read 24-bit comparison file:". $comp->errstr, 1;
  64   is(Imager::i_img_diff($comp->{IMG}, $work->{IMG}), 0,
  65      "compare image data");
  66 }
  67
  68 ok($im->read(file => 'testimg/pal83232.ico', type=>'ico', ico_masked => 0),
  69    "read 8 bit")
  70   or print "# ", $im->errstr, "\n";
  71 is($im->getwidth, 32, "check width");
  72 is($im->getwidth, 32, "check height");
  73 is($im->type, 'paletted', "check type");
  74 is($im->colorcount, 256, "color count");
  75 is($im->tags(name => 'ico_bits'), 8, "check ico_bits tag");
  76 is($im->tags(name => 'i_format'), 'ico', "check i_format tag");
  77 SKIP:
  78 {
  79   my $comp = Imager->new;
  80   $comp->read(file => "testimg/pal83232.ppm")
  81     or skip "could not read 8-bit comparison file:". $comp->errstr, 1;
  82   is(Imager::i_img_diff($comp->{IMG}, $im->{IMG}), 0,
  83      "compare image data");
  84 }
  85 $im->write(file=>'testout/pal83232.ppm');
  86
  87 ok($im->read(file => 'testimg/pal43232.ico', type=>'ico', ico_masked => 0),
  88    "read 4 bit")
  89   or print "# ", $im->errstr, "\n";
  90 is($im->getwidth, 32, "check width");
  91 is($im->getwidth, 32, "check height");
  92 is($im->type, 'paletted', "check type");
  93 is($im->colorcount, 16, "color count");
  94 is($im->tags(name => 'ico_bits'), 4, "check ico_bits tag");
  95 is($im->tags(name => 'i_format'), 'ico', "check i_format tag");
  96 SKIP:
  97 {
  98   my $comp = Imager->new;
  99   $comp->read(file => "testimg/pal43232.ppm")
 100     or skip "could not read 4-bit comparison file:". $comp->errstr, 1;
 101   is(Imager::i_img_diff($comp->{IMG}, $im->{IMG}), 0,
 102      "compare image data");
 103 }
 104
 105 $im->write(file=>'testout/pal43232.ppm');
 106 ok($im->read(file => 'testimg/pal13232.ico', type=>'ico', ico_masked => 0),
 107    "read 1 bit")
 108   or print "# ", $im->errstr, "\n";
 109 is($im->getwidth, 32, "check width");
 110 is($im->getwidth, 32, "check height");
 111 is($im->type, 'paletted', "check type");
 112 is($im->colorcount, 2, "color count");
 113 is($im->tags(name => 'cur_bits'), 1, "check ico_bits tag");
 114 is($im->tags(name => 'i_format'), 'cur', "check i_format tag");
 115 $im->write(file=>'testout/pal13232.ppm');
 116
 117 # combo was created with the GIMP, which has a decent mechanism for selecting
 118 # the output format
 119 # you get different size icon images by making different size layers.
 120 my @imgs = Imager->read_multi(file => 'testimg/combo.ico', type=>'ico',
 121                               ico_masked => 0);
 122 is(scalar(@imgs), 3, "read multiple");
 123 is($imgs[0]->getwidth, 48, "image 0 width");
 124 is($imgs[0]->getheight, 48, "image 0 height");
 125 is($imgs[1]->getwidth, 32, "image 1 width");
 126 is($imgs[1]->getheight, 32, "image 1 height");
 127 is($imgs[2]->getwidth, 16, "image 2 width");
 128 is($imgs[2]->getheight, 16, "image 2 height");
 129 is($imgs[0]->type, 'direct', "image 0 type");
 130 is($imgs[1]->type, 'paletted', "image 1 type");
 131 is($imgs[2]->type, 'paletted', "image 2 type");
 132 is($imgs[1]->colorcount, 256, "image 1 colorcount");
 133 is($imgs[2]->colorcount, 16, "image 2 colorcount");
 134
 135 is_deeply([ $imgs[0]->getpixel(x=>0, 'y'=>0)->rgba ], [ 231, 17, 67, 255 ],
 136           "check image data 0(0,0)");
 137 is_deeply([ $imgs[1]->getpixel(x=>0, 'y'=>0)->rgba ], [ 231, 17, 67, 255 ],
 138           "check image data 1(0,0)");
 139 is_deeply([ $imgs[2]->getpixel(x=>0, 'y'=>0)->rgba ], [ 231, 17, 67, 255 ],
 140           "check image data 2(0,0)");
 141
 142 is_deeply([ $imgs[0]->getpixel(x=>47, 'y'=>0)->rgba ], [ 131, 231, 17, 255 ],
 143           "check image data 0(47,0)");
 144 is_deeply([ $imgs[1]->getpixel(x=>31, 'y'=>0)->rgba ], [ 131, 231, 17, 255 ],
 145           "check image data 1(31,0)");
 146 is_deeply([ $imgs[2]->getpixel(x=>15, 'y'=>0)->rgba ], [ 131, 231, 17, 255 ],
 147           "check image data 2(15,0)");
 148
 149 is_deeply([ $imgs[0]->getpixel(x=>0, 'y'=>47)->rgba ], [ 17, 42, 231, 255 ],
 150           "check image data 0(0,47)");
 151 is_deeply([ $imgs[1]->getpixel(x=>0, 'y'=>31)->rgba ], [ 17, 42, 231, 255 ],
 152           "check image data 1(0,31)");
 153 is_deeply([ $imgs[2]->getpixel(x=>0, 'y'=>15)->rgba ], [ 17, 42, 231, 255 ],
 154           "check image data 2(0,15)");
 155
 156 is_deeply([ $imgs[0]->getpixel(x=>47, 'y'=>47)->rgba ], [ 17, 231, 177, 255 ],
 157           "check image data 0(47,47)");
 158 is_deeply([ $imgs[1]->getpixel(x=>31, 'y'=>31)->rgba ], [ 17, 231, 177, 255 ],
 159           "check image data 1(31,31)");
 160 is_deeply([ $imgs[2]->getpixel(x=>15, 'y'=>15)->rgba ], [ 17, 231, 177, 255 ],
 161           "check image data 2(15,15)");
 162
 163 $im = Imager->new(xsize=>32, ysize=>32);
 164 $im->box(filled=>1, color=>'FF0000');
 165 $im->box(filled=>1, color=>'0000FF', xmin => 6, ymin=>0, xmax => 21, ymax=>15);
 166 $im->box(filled=>1, color=>'00FF00', xmin => 10, ymin=>16, xmax => 25, ymax=>31);
 167
 168 ok($im->write(file=>'testout/t10_32.ico', type=>'ico'),
 169    "write 32-bit icon");
 170
 171 my $im2 = Imager->new;
 172 ok($im2->read(file=>'testout/t10_32.ico', type=>'ico', ico_masked => 0),
 173    "read it back in");
 174
 175 is(Imager::i_img_diff($im->{IMG}, $im2->{IMG}), 0,
 176    "check they're the same");
 177 is($im->bits, $im2->bits, "check same bits");
 178
 179 {
 180   my $im = Imager->new(xsize => 32, ysize => 32);
 181   $im->box(filled=>1, color=>'#FF00FF');
 182   my $data;
 183   ok(Imager->write_multi({ data => \$data, type=>'ico' }, $im, $im),
 184      "write multi icons");
 185   ok(length $data, "and it wrote data");
 186   my @im = Imager->read_multi(data => $data, ico_masked => 0);
 187   is(@im, 2, "got all the images back");
 188   is(Imager::i_img_diff($im->{IMG}, $im[0]{IMG}), 0, "check first image");
 189   is(Imager::i_img_diff($im->{IMG}, $im[1]{IMG}), 0, "check second image");
 190 }
 191
 192 { # 1 channel image
 193   my $im = Imager->new(xsize => 32, ysize => 32, channels => 1);
 194   $im->box(filled=>1, color => [ 128, 0, 0 ]);
 195   my $data;
 196   ok($im->write(data => \$data, type=>'ico'), "write 1 channel image");
 197   my $im2 = Imager->new;
 198   ok($im2->read(data => $data, ico_masked => 0), "read it back");
 199   is($im2->getchannels, 4, "check channels");
 200   my $imrgb = $im->convert(preset => 'rgb')
 201     ->convert(preset => 'addalpha');
 202   is(Imager::i_img_diff($imrgb->{IMG}, $im2->{IMG}), 0,
 203      "check image matches expected");
 204 }
 205
 206 { # 2 channel image
 207   my $base = Imager->new(xsize => 32, ysize => 32, channels => 2);
 208   $base->box(filled => 1, color => [ 64, 192, 0 ]);
 209   my $data;
 210   ok($base->write(data => \$data, type=>'ico'), "write 2 channel image");
 211   my $read = Imager->new;
 212   ok($read->read(data => $data, ico_masked => 0), "read it back");
 213   is($read->getchannels, 4, "check channels");
 214   my $imrgb = $base->convert(preset => 'rgb');
 215   is(Imager::i_img_diff($imrgb->{IMG}, $read->{IMG}), 0,
 216      "check image matches expected");
 217 }
 218
 219 { # 4 channel image
 220   my $base = Imager->new(xsize => 32, ysize => 32, channels => 4);
 221   $base->box(filled=>1, ymax => 15, color => [ 255, 0, 255, 128 ]);
 222   $base->box(filled=>1, ymin => 16, color => [ 0, 255, 255, 255 ]);
 223   my $data;
 224   ok($base->write(data => \$data, type=>'ico'), "write 4 channel image");
 225   my $read = Imager->new;
 226   ok($read->read(data => $data, type=>'ico', ico_masked => 0), "read it back")
 227     or print "# ", $read->errstr, "\n";
 228   is(Imager::i_img_diff($base->{IMG}, $read->{IMG}), 0,
 229      "check image matches expected");
 230 }
 231
 232 { # mask handling
 233   my $base = Imager->new(xsize => 16, ysize => 16, channels => 3);
 234   $base->box(filled=>1, xmin => 5, xmax => 10, color => '#0000FF');
 235   $base->box(filled=>1, ymin => 5, ymax => 10, color => '#0000FF');
 236   my $mask = <<EOS; # CR in this to test it's skipped correctly
 237 01
 238 0000011111100000
 239 00000111111 00000xx
 240 00000111111000
 241 00000111111000
 242 0000011111100000
 243 1111111111111111
 244 1111111111111111
 245 1111111111111111
 246 1111111111111111
 247 1111111111111111
 248 1111111111111111
 249 1010101010101010
 250 1010101010101010
 251 1010101010101010
 252 1010101010101010
 253 1010101010101010
 254 EOS
 255   $mask =~ s/\n/\r\n/g; # to test alternate newline handling is correct
 256   $base->settag(name => 'ico_mask', value => $mask);
 257   my $saved_mask = $base->tags(name => 'ico_mask');
 258   my $data;
 259   ok($base->write(data => \$data, type => 'ico'),
 260      "write with mask tag set");
 261   my $read = Imager->new;
 262   ok($read->read(data => $data, ico_masked => 0), "read it back");
 263   my $mask2 = $mask;
 264   $mask2 =~ tr/01/.*/;
 265   $mask2 =~ s/\n$//;
 266   $mask2 =~ tr/\r x//d;
 267   $mask2 =~ s/^(.{3,19})$/$1 . "." x (16 - length $1)/gem;
 268   my $read_mask = $read->tags(name => 'ico_mask');
 269   is($read_mask, $mask2, "check mask is correct");
 270 }
 271
 272 { # mask too short to handle
 273   my $mask = "xx";
 274   my $base = Imager->new(xsize => 16, ysize => 16, channels => 3);
 275   $base->box(filled=>1, xmin => 5, xmax => 10, color => '#0000FF');
 276   $base->box(filled=>1, ymin => 5, ymax => 10, color => '#0000FF');
 277   $base->settag(name => 'ico_mask', value => $mask);
 278   my $data;
 279   ok($base->write(data => \$data, type=>'ico'),
 280      "save icon with short mask tag");
 281   my $read = Imager->new;
 282   ok($read->read(data => $data, ico_masked => 0), "read it back");
 283   my $read_mask = $read->tags(name => 'ico_mask');
 284   my $expected_mask = ".*" . ( "\n" . "." x 16 ) x 16;
 285   is($read_mask, $expected_mask, "check the mask");
 286
 287   # mask that doesn't match what we expect
 288   $base->settag(name => 'ico_mask', value => 'abcd');
 289   ok($base->write(data => \$data, type => 'ico'),
 290      "write with bad format mask tag");
 291   ok($read->read(data => $data, ico_masked => 0), "read it back");
 292   $read_mask = $read->tags(name => 'ico_mask');
 293   is($read_mask, $expected_mask, "check the mask");
 294
 295   # mask with invalid char
 296   $base->settag(name => 'ico_mask', value => ".*\n....xxx..");
 297   ok($base->write(data => \$data, type => 'ico'),
 298      "write with unexpected chars in mask");
 299   ok($read->read(data => $data, ico_masked => 0), "read it back");
 300   $read_mask = $read->tags(name => 'ico_mask');
 301   is($read_mask, $expected_mask, "check the mask");
 302 }
 303
 304 { # check handling of greyscale paletted
 305   my $base = Imager->new(xsize => 16, ysize => 16, channels => 1,
 306                          type => 'paletted');
 307   my @grays = map Imager::Color->new($_),
 308     "000000", "666666", "CCCCCC", "FFFFFF";
 309   ok($base->addcolors(colors => \@grays), "add some colors");
 310   $base->box(filled => 1, color => $grays[1], xmax => 7, ymax => 7);
 311   $base->box(filled => 1, color => $grays[1], xmax => 7, ymin => 8);
 312   $base->box(filled => 1, color => $grays[1], xmin => 8, ymax => 7);
 313   $base->box(filled => 1, color => $grays[1], xmin => 8, ymax => 8);
 314   my $data;
 315   ok($base->write(data => \$data, type => 'ico'),
 316      "write grayscale paletted");
 317   my $read = Imager->new;
 318   ok($read->read(data => $data, ico_masked => 0), "read it back")
 319     or print "# ", $read->errstr, "\n";
 320   is($read->type, 'paletted', "check type");
 321   is($read->getchannels, 3, "check channels");
 322   my $as_rgb = $base->convert(preset => 'rgb');
 323   is(Imager::i_img_diff($base->{IMG}, $read->{IMG}), 0,
 324      "check the image");
 325 }
 326
 327 {
 328   # check default mask processing
 329   #
 330   # the query at http://www.cpanforum.com/threads/5958 made it fairly
 331   # obvious that the way Imager handled the mask in 0.59 was confusing
 332   # when compared with loading other images with some sort of
 333   # secondary alpha channel (eg. gif)
 334   # So from 0.60 the mask is applied as an alpha channel by default.
 335   # make sure that application works.
 336
 337   # the strange mask checks the optimization paths of the mask application
 338   my $mask = <<EOS;
 339 01
 340 1001
 341 1100
 342 0011
 343 0000
 344 0010
 345 EOS
 346   chomp $mask;
 347   my $im = Imager->new(xsize => 4, ysize => 5, type => 'paletted');
 348   $im->addcolors(colors => [ '#FF0000' ]);
 349   $im->box(filled => 1, color => '#FF0000');
 350   $im->settag(name => 'ico_mask', value => $mask);
 351   my $imcopy = $im->convert(preset=>'addalpha');
 352   my $red_alpha = Imager::Color->new(255, 0, 0, 0);
 353   $imcopy->setpixel( 'x' => [ qw/0 3 0 1 2 3 2/ ],
 354                      'y' => [ qw/0 0 1 1 2 2 4/ ],
 355                      color => $red_alpha);
 356   my $data;
 357   ok($im->write(data => \$data, type => 'ico'),
 358      "save icon + mask");
 359   my $im2 = Imager->new;
 360   ok($im2->read(data => $data), "read ico with defaults");
 361   is($im2->type, 'direct', 'expect a direct image');
 362   is_image($im2, $imcopy, 'check against expected');
 363 }
 364
 365 {
 366   # read 24-bit images
 367   my $im = Imager->new;
 368   ok($im->read(file => 'testimg/rgb1616.ico'), "read 24-bit data image")
 369     or print "# ", $im->errstr, "\n";
 370   my $vs = Imager->new(xsize => 16, ysize => 16);
 371   $vs->box(filled => 1, color => '#333366');
 372   is_image($im, $vs, "check we got the right colors");
 373 }