t/t67convert.t

   1 #!perl -w
   2 use strict;
   3 use Imager qw(:all :handy);
   4 use Test::More tests=>21;
   5
   6 Imager::init("log"=>'testout/t67convert.log');
   7
   8 my $imbase = Imager::ImgRaw::new(200,300,3);
   9
  10 # first a basic test, make sure the basic things happen ok
  11 # make a 1 channel image from the above (black) image
  12 # but with 1 as the 'extra' value
  13 SKIP:
  14 {
  15   my $im_white = i_convert($imbase, [ [ 0, 0, 0, 1 ] ]);
  16   skip("convert to white failed", 3)
  17     unless ok($im_white, "convert to white");
  18
  19   my ($w, $h, $ch) = i_img_info($im_white);
  20
  21   # the output image should now have one channel
  22   is($ch, 1, "one channel image now");
  23   # should have the same width and height
  24   ok($w == 200 && $h == 300, "check converted size is the same");
  25
  26   # should be a white image now, let's check
  27   my $c = Imager::i_get_pixel($im_white, 20, 20);
  28   my @c = $c->rgba;
  29   print "# @c\n";
  30   is($c[0], 255, "check image is white");
  31 }
  32
  33 # test the highlevel interface
  34 # currently this requires visual inspection of the output files
  35 my $im = Imager->new;
  36 SKIP:
  37 {
  38   skip("could not load scale.ppm", 3)
  39     unless $im->read(file=>'testimg/scale.ppm');
  40   my $out = $im->convert(preset=>'gray');
  41   ok($out, "convert preset gray");
  42   ok($out->write(file=>'testout/t67_gray.ppm', type=>'pnm'),
  43     "save grey image");
  44   $out = $im->convert(preset=>'blue');
  45   ok($out, "convert preset blue");
  46
  47   ok($out->write(file=>'testout/t67_blue.ppm', type=>'pnm'),
  48      "save blue image");
  49 }
  50
  51 # test against 16-bit/sample images
  52 SKIP:
  53 {
  54   my $imbase16 = Imager::i_img_16_new(200, 200, 3);
  55
  56   my $im16targ = i_convert($imbase16, [ [ 0, 0, 0, 1 ],
  57                                         [ 0, 0, 0, 0 ],
  58                                         [ 0, 0, 0, 0 ] ]);
  59   skip("could not convert 16-bit image", 2)
  60     unless ok($im16targ, "convert 16/bit sample image");
  61   # image should still be 16-bit
  62   is(Imager::i_img_bits($im16targ), 16, "Image still 16-bit/sample");
  63   # make sure that it's roughly red
  64   my $c = Imager::i_gpixf($im16targ, 0, 0);
  65   my @ch = $c->rgba;
  66   ok(abs($ch[0] - 1) <= 0.0001 && abs($ch[1]) <= 0.0001 && abs($ch[2]) <= 0.0001,
  67      "image roughly red")
  68     or print "# @ch\n";
  69 }
  70
  71 # test against palette based images
  72 my $impal = Imager::i_img_pal_new(200, 300, 3, 256);
  73 my $black = NC(0, 0, 0);
  74 my $blackindex = Imager::i_addcolors($impal, $black);
  75 ok($blackindex, "add black to paletted");
  76 for my $y (0..299) {
  77   Imager::i_ppal($impal, 0, $y, ($blackindex) x 200);
  78 }
  79
  80 SKIP:
  81 {
  82   my $impalout = i_convert($impal, [ [ 0, 0, 0, 0 ],
  83                                      [ 0, 0, 0, 1 ],
  84                                      [ 0, 0, 0, 0 ] ]);
  85   skip("could not convert paletted", 3)
  86     unless ok($impalout, "convert paletted");
  87   is(Imager::i_img_type($impalout), 1, "image still paletted");
  88   is(Imager::i_colorcount($impalout), 1, "still only one colour");
  89   my $c = Imager::i_getcolors($impalout, $blackindex);
  90   ok($c, "get color from palette");
  91   my @ch = $c->rgba;
  92   print "# @ch\n";
  93   ok($ch[0] == 0 && $ch[1] == 255 && $ch[2] == 0,
  94      "colour is as expected");
  95 }
  96
  97 { # http://rt.cpan.org/NoAuth/Bug.html?id=9672
  98   my $warning;
  99   local $SIG{__WARN__} =
 100     sub {
 101       $warning = "@_";
 102       my $printed = $warning;
 103       $printed =~ s/\n$//;
 104       $printed =~ s/\n/\n\#/g;
 105       print "# ",$printed, "\n";
 106     };
 107   my $img = Imager->new(xsize=>10, ysize=>10);
 108   $img->convert(preset=>"grey");
 109   cmp_ok($warning, '=~', 'void', "correct warning");
 110   cmp_ok($warning, '=~', 't67convert\\.t', "correct file");
 111 }
 112
 113 { # http://rt.cpan.org/NoAuth/Bug.html?id=28492
 114   my $im = Imager->new(xsize => 20, ysize => 20, channels => 3,
 115                        bits => 'double');
 116   is($im->bits, 'double', 'check source bits');
 117   my $conv = $im->convert(preset => 'grey');
 118   is($conv->bits, 'double', 'make sure result has extra bits');
 119 }