t/t67convert.t

   1 Imager::init("log"=>'testout/t67convert.log');
   2
   3 use Imager qw(:all :handy);
   4
   5 print "1..17\n";
   6
   7 my $imbase = Imager::ImgRaw::new(200,300,3);
   8
   9 # first a basic test, make sure the basic things happen ok
  10 # make a 1 channel image from the above (black) image
  11 # but with 1 as the 'extra' value
  12 my $imnew = Imager::i_img_new();
  13 unless (i_convert($imnew, $imbase, [ [ 0, 0, 0, 1 ] ])) {
  14   print "not ok 1 # call failed\n";
  15   print "ok 2 # skipped\n";
  16   print "ok 3 # skipped\n";
  17 }
  18 else {
  19   print "ok 1\n";
  20   my ($w, $h, $ch) = i_img_info($imnew);
  21
  22   # the output image should now have one channel
  23   if ($ch == 1) {
  24     print "ok 2\n";
  25   }
  26   else {
  27     print "not ok 2 # $ch channels in output\n";
  28   }
  29   # should have the same width and height
  30   if ($w == 200 && $h == 300) {
  31     print "ok 3\n";
  32   }
  33   else {
  34     print "not ok 3 # output image is the wrong size!\n";
  35   }
  36   # should be a white image now, let's check
  37   my $c = Imager::i_get_pixel($imnew, 20, 20);
  38   my @c = $c->rgba;
  39   print "# @c\n";
  40   if (($c->rgba())[0] == 255) {
  41     print "ok 4\n";
  42   }
  43   else {
  44     print "not ok 4 # wrong colour in output image",($c->rgba())[0],"\n";
  45   }
  46 }
  47
  48 # test the highlevel interface
  49 # currently this requires visual inspection of the output files
  50 my $im = Imager->new;
  51 if ($im->read(file=>'testimg/scale.ppm')) {
  52   print "ok 5\n";
  53   my $out;
  54   $out = $im->convert(preset=>'gray')
  55     or print "not ";
  56   print "ok 6\n";
  57   if ($out->write(file=>'testout/t67_gray.ppm', type=>'pnm')) {
  58     print "ok 7\n";
  59   }
  60   else {
  61     print "not ok 7 # Cannot save testout/t67_gray.ppm:", $out->errstr,"\n";
  62   }
  63   $out = $im->convert(preset=>'blue')
  64     or print "not ";
  65   print "ok 8\n";
  66
  67   if ($out->write(file=>'testout/t67_blue.ppm', type=>'pnm')) {
  68     print "ok 9\n";
  69   }
  70   else {
  71     print "not ok 9 # Cannot save testout/t67_blue.ppm:", $out->errstr, "\n";
  72   }
  73 }
  74 else {
  75   print "not ok 5 # could not load testout/scale.ppm\n";
  76   print map "ok $_ # skipped\n", 6..9;
  77 }
  78
  79 # test against 16-bit/sample images
  80 my $im16targ = Imager::i_img_16_new(200, 300, 3);
  81 unless (i_convert($im16targ, $imbase, [ [ 0, 0, 0, 1 ],
  82                                         [ 0, 0, 0, 0 ],
  83                                         [ 0, 0, 0, 0 ] ])) {
  84   print "not ok 10 # call failed\n";
  85   print map "ok $_ # skipped\n", 11..12;
  86 }
  87 else {
  88   print "ok 10\n";
  89
  90   # image should still be 16-bit
  91   Imager::i_img_bits($im16targ) == 16
  92       or print "not ";
  93   print "ok 11\n";
  94   # make sure that it's roughly red
  95   my $c = Imager::i_gpixf($im16targ, 0, 0);
  96   my @ch = $c->rgba;
  97   abs($ch[0] - 1) <= 0.0001 && abs($ch[1]) <= 0.0001 && abs($ch[2]) <= 0.0001
  98     or print "not ";
  99   print "ok 12\n";
 100 }
 101
 102 # test against palette based images
 103 my $impal = Imager::i_img_pal_new(200, 300, 3, 256);
 104 my $black = NC(0, 0, 0);
 105 my $blackindex = Imager::i_addcolors($impal, $black)
 106   or print "not ";
 107 print "ok 13\n";
 108 for my $y (0..299) {
 109   Imager::i_ppal($impal, 0, $y, ($black) x 200);
 110 }
 111 my $impalout = Imager::i_img_pal_new(200, 300, 3, 256);
 112 if (i_convert($impalout, $impal, [ [ 0, 0, 0, 0 ],
 113                                    [ 0, 0, 0, 1 ],
 114                                    [ 0, 0, 0, 0 ] ])) {
 115   Imager::i_img_type($impalout) == 1 or print "not ";
 116   print "ok 14\n";
 117   Imager::i_colorcount($impalout) == 1 or print "not ";
 118   print "ok 15\n";
 119   my $c = Imager::i_getcolors($impalout, $blackindex) or print "not ";
 120   print "ok 16\n";
 121   my @ch = $c->rgba;
 122   print "# @ch\n";
 123   $ch[0] == 0 && $ch[1] == 255 && $ch[2] == 0
 124     or print "not ";
 125   print "ok 17\n";
 126 }
 127 else {
 128   print "not ok 14 # could not convert paletted image\n";
 129   print map "ok $_ # skipped\n", 15..17;
 130 }