t/t58trans2.t

   1 #!perl -w
   2 BEGIN { $| = 1; print "1..16\n"; }
   3 END {print "not ok 1\n" unless $loaded;}
   4 use Imager;
   5
   6 sub ok($$);
   7 sub is($$$);
   8 my $num = 1;
   9
  10 $loaded = 1;
  11 ok(1, "loaded");
  12
  13 #$Imager::DEBUG=1;
  14
  15 Imager::init('log'=>'testout/t58trans2.log');
  16
  17 my $im1 = Imager->new();
  18 $im1->open(file=>'testimg/penguin-base.ppm', type=>'pnm')
  19          || die "Cannot read image";
  20 my $im2 = Imager->new();
  21 $im2->open(file=>'testimg/scale.ppm',type=>'pnm')
  22         || die "Cannot read testimg/scale.ppm";
  23
  24 # error handling
  25 my $opts = { rpnexpr=>'x x 10 / sin 10 * y + get1' };
  26 my $im3 = Imager::transform2($opts);
  27 ok(!$im3, "returned an image on error");
  28 ok(defined($Imager::ERRSTR), "No error message on failure");
  29
  30 # image synthesis
  31 my $im4 = Imager::transform2({
  32         width=>300, height=>300,
  33         rpnexpr=>'x y cx cy distance !d y cy - x cx - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 cy * 3.1416 / 1 @a2 sin 1 + 2 / hsv'});
  34 ok($im4, "synthesis failed");
  35
  36 if ($im4) {
  37   $im4->write(type=>'pnm', file=>'testout/t56a.ppm')
  38     || die "Cannot write testout/t56a.ppm";
  39 }
  40
  41 # image distortion
  42 my $im5 = Imager::transform2({
  43         rpnexpr=>'x x 10 / sin 10 * y + getp1'
  44 }, $im1);
  45 ok($im5, "image distortion");
  46 if ($im5) {
  47   $im5->write(type=>'pnm', file=>'testout/t56b.ppm')
  48     || die "Cannot write testout/t56b.ppm";
  49 }
  50
  51 # image combination
  52 $opts = {
  53 rpnexpr=>'x h / !rat x w2 % y h2 % getp2 !pat x y getp1 @rat * @pat 1 @rat - * +'
  54 };
  55 my $im6 = Imager::transform2($opts,$im1,$im2);
  56 ok($im6, "image combination");
  57 if ($im6) {
  58   $im6->write(type=>'pnm', file=>'testout/t56c.ppm')
  59     || die "Cannot write testout/t56c.ppm";
  60 }
  61
  62 # alpha
  63 $opts =
  64   {
  65    rpnexpr => '0 0 255 x y + w h + 2 - / 255 * rgba',
  66    channels => 4,
  67    width => 50,
  68    height => 50,
  69   };
  70 my $im8 = Imager::transform2($opts);
  71 ok($im8, "alpha output");
  72 my $c = $im8->getpixel(x=>0, 'y'=>0);
  73 is(($c->rgba)[3], 0, "zero alpha");
  74 $c = $im8->getpixel(x=>49, 'y'=>49);
  75 is(($c->rgba)[3], 255, "max alpha");
  76
  77 $opts = { rpnexpr => 'x 1 + log 50 * y 1 + log 50 * getp1' };
  78 my $im9 = Imager::transform2($opts, $im1);
  79 ok($im9, "log function");
  80 if ($im9) {
  81   $im9->write(type=>'pnm', file=>'testout/t56-9.ppm');
  82 }
  83
  84 use Imager::Transform;
  85
  86 # some simple tests
  87 print "# Imager::Transform\n";
  88 my @funcs = Imager::Transform->list;
  89 ok(@funcs, "funcs");
  90
  91 my $tran = Imager::Transform->new($funcs[0]);
  92 ok($tran, "got tranform");
  93 ok($tran->describe() eq Imager::Transform->describe($funcs[0]),
  94    "description");
  95 # look for a function that takes inputs (at least one does)
  96 my @needsinputs = grep Imager::Transform->new($_)->inputs, @funcs;
  97 # make sure they're
  98 my @inputs = Imager::Transform->new($needsinputs[0])->inputs;
  99 ok($inputs[0]{desc}, "input description");
 100 # at some point I might want to test the actual transformations
 101
 102 # check lower level error handling
 103 my $im7 = Imager::transform2({rpnexpr=>'x y getp2', width=>100, height=>100});
 104 ok(!$im7, "expected failure on accessing invalid image");
 105 print "# ", Imager->errstr, "\n";
 106 ok(Imager->errstr =~ /not enough images/, "didn't get expected error");
 107
 108
 109 sub ok ($$) {
 110   my ($test, $desc) = @_;
 111
 112   if ($test) {
 113     print "ok $num # $desc\n";
 114   }
 115   else {
 116     print "not ok $num # $desc\n";
 117   }
 118   ++$num;
 119   $test;
 120 }
 121
 122 sub is ($$$) {
 123   my ($left, $right, $desc) = @_;
 124
 125   my $eq = $left == $right;
 126   unless (ok($eq, $desc)) {
 127     $left =~ s/\n/# \n/g;
 128     $left =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
 129     $right =~ s/\n/# \n/g;
 130     $right =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
 131     print "# not equal, left = '$left'\n";
 132     print "# right = '$right'\n";
 133   }
 134   $eq;
 135 }