t/t021sixteen.t

   1 #!perl -w
   2 use strict;
   3 BEGIN { $| = 1; print "1..29\n"; }
   4 my $loaded;
   5 END {print "not ok 1\n" unless $loaded;}
   6 use Imager qw(:all :handy);
   7 #use Data::Dumper;
   8 $loaded = 1;
   9 print "ok 1\n";
  10 init_log("testout/t021sixteen.t", 1);
  11
  12 use Imager::Color::Float;
  13
  14 my $im_g = Imager::i_img_16_new(100, 101, 1);
  15
  16 print Imager::i_img_getchannels($im_g) == 1
  17   ? "ok 2\n" : "not ok 2 # 1 channel image channel count mismatch\n";
  18 print Imager::i_img_getmask($im_g) & 1
  19   ? "ok 3\n" : "not ok 3 # 1 channel image bad mask\n";
  20 print Imager::i_img_virtual($im_g)
  21   ? "not ok 4 # 1 channel image thinks it is virtual\n" : "ok 4\n";
  22 print Imager::i_img_bits($im_g) == 16
  23   ? "ok 5\n" : "not ok 5 # 1 channel image has bits != 16\n";
  24 print Imager::i_img_type($im_g) == 0 # direct
  25   ? "ok 6\n" : "not ok 6 # 1 channel image isn't direct\n";
  26
  27 my @ginfo = i_img_info($im_g);
  28 print $ginfo[0] == 100
  29   ? "ok 7\n" : "not ok 7 # 1 channel image width incorrect\n";
  30 print $ginfo[1] == 101
  31   ? "ok 8\n" : "not ok 8 # 1 channel image height incorrect\n";
  32
  33 undef $im_g;
  34
  35 my $im_rgb = Imager::i_img_16_new(100, 101, 3);
  36
  37 print Imager::i_img_getchannels($im_rgb) == 3
  38   ? "ok 9\n" : "not ok 9 # 3 channel image channel count mismatch\n";
  39 print +(Imager::i_img_getmask($im_rgb) & 7) == 7
  40   ? "ok 10\n" : "not ok 10 # 3 channel image bad mask\n";
  41 print Imager::i_img_bits($im_rgb) == 16
  42   ? "ok 11\n" : "not ok 11 # 3 channel image has bits != 16\n";
  43 print Imager::i_img_type($im_rgb) == 0 # direct
  44   ? "ok 12\n" : "not ok 12 # 3 channel image isn't direct\n";
  45
  46 my $redf = NCF(1, 0, 0);
  47 my $greenf = NCF(0, 1, 0);
  48 my $bluef = NCF(0, 0, 1);
  49
  50 # fill with red
  51 for my $y (0..101) {
  52   Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
  53 }
  54 print "ok 13\n";
  55 # basic sanity
  56 test_colorf_gpix(14, $im_rgb, 0,  0,   $redf);
  57 test_colorf_gpix(16, $im_rgb, 99, 0,   $redf);
  58 test_colorf_gpix(18, $im_rgb, 0,  100, $redf);
  59 test_colorf_gpix(20, $im_rgb, 99, 100, $redf);
  60 test_colorf_glin(22, $im_rgb, 0,  0,   ($redf) x 100);
  61 test_colorf_glin(24, $im_rgb, 0,  100, ($redf) x 100);
  62
  63 Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
  64 test_colorf_glin(26, $im_rgb, 0, 1,
  65                  ($redf) x 20, ($greenf) x 60, ($redf) x 20);
  66
  67 # basic OO tests
  68 my $oo16img = Imager->new(xsize=>200, ysize=>201, bits=>16)
  69   or print "not ";
  70 print "ok 28\n";
  71 $oo16img->bits == 16 or print "not ";
  72 print "ok 29\n";
  73
  74
  75 sub NCF {
  76   return Imager::Color::Float->new(@_);
  77 }
  78
  79 sub test_colorf_gpix {
  80   my ($test_base, $im, $x, $y, $expected) = @_;
  81   my $c = Imager::i_gpixf($im, $x, $y);
  82   $c or print "not ";
  83   print "ok ",$test_base++,"\n";
  84   colorf_cmp($c, $expected) == 0 or print "not ";
  85   print "ok ",$test_base++,"\n";
  86 }
  87
  88 sub test_colorf_glin {
  89   my ($test_base, $im, $x, $y, @pels) = @_;
  90
  91   my @got = Imager::i_glinf($im, $x, $x+@pels, $y);
  92   @got == @pels or print "not ";
  93   print "ok ",$test_base++,"\n";
  94   grep(colorf_cmp($pels[$_], $got[$_]), 0..$#got) and print "not ";
  95   print "ok ",$test_base++,"\n";
  96 }
  97
  98 sub colorf_cmp {
  99   my ($c1, $c2) = @_;
 100   my @s1 = map { int($_*65535.99) } $c1->rgba;
 101   my @s2 = map { int($_*65535.99) } $c2->rgba;
 102
 103   # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
 104   return $s1[0] <=> $s2[0]
 105     || $s1[1] <=> $s2[1]
 106       || $s1[2] <=> $s2[2];
 107 }