t/t58trans2.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 38;
   4 BEGIN { use_ok('Imager'); }
   5 use Imager::Test qw(is_color3);
   6
   7 -d "testout" or mkdir "testout";
   8
   9 Imager::init('log'=>'testout/t58trans2.log');
  10
  11 my $im1 = Imager->new();
  12 $im1->open(file=>'testimg/penguin-base.ppm', type=>'pnm')
  13          || die "Cannot read image";
  14 my $im2 = Imager->new();
  15 $im2->open(file=>'testimg/scale.ppm',type=>'pnm')
  16         || die "Cannot read testimg/scale.ppm";
  17
  18 # error handling
  19 my $opts = { rpnexpr=>'x x 10 / sin 10 * y + get1' };
  20 my $im3 = Imager::transform2($opts);
  21 ok(!$im3, "returned an image on error");
  22 ok(defined($Imager::ERRSTR), "No error message on failure");
  23
  24 # image synthesis
  25 my $im4 = Imager::transform2({
  26         width=>300, height=>300,
  27         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'});
  28 ok($im4, "synthesis failed");
  29
  30 if ($im4) {
  31   $im4->write(type=>'pnm', file=>'testout/t56a.ppm')
  32     || die "Cannot write testout/t56a.ppm";
  33 }
  34
  35 # image distortion
  36 my $im5 = Imager::transform2({
  37         rpnexpr=>'x x 10 / sin 10 * y + getp1'
  38 }, $im1);
  39 ok($im5, "image distortion");
  40 if ($im5) {
  41   $im5->write(type=>'pnm', file=>'testout/t56b.ppm')
  42     || die "Cannot write testout/t56b.ppm";
  43 }
  44
  45 # image combination
  46 $opts = {
  47 rpnexpr=>'x h / !rat x w2 % y h2 % getp2 !pat x y getp1 @rat * @pat 1 @rat - * +'
  48 };
  49 my $im6 = Imager::transform2($opts,$im1,$im2);
  50 ok($im6, "image combination");
  51 if ($im6) {
  52   $im6->write(type=>'pnm', file=>'testout/t56c.ppm')
  53     || die "Cannot write testout/t56c.ppm";
  54 }
  55
  56 # alpha
  57 $opts =
  58   {
  59    rpnexpr => '0 0 255 x y + w h + 2 - / 255 * rgba',
  60    channels => 4,
  61    width => 50,
  62    height => 50,
  63   };
  64 my $im8 = Imager::transform2($opts);
  65 ok($im8, "alpha output");
  66 my $c = $im8->getpixel(x=>0, 'y'=>0);
  67 is(($c->rgba)[3], 0, "zero alpha");
  68 $c = $im8->getpixel(x=>49, 'y'=>49);
  69 is(($c->rgba)[3], 255, "max alpha");
  70
  71 $opts = { rpnexpr => 'x 1 + log 50 * y 1 + log 50 * getp1' };
  72 my $im9 = Imager::transform2($opts, $im1);
  73 ok($im9, "log function");
  74 if ($im9) {
  75   $im9->write(type=>'pnm', file=>'testout/t56-9.ppm');
  76 }
  77
  78 # op tests
  79 sub op_test($$$$$$);
  80 print "# op tests\n";
  81 op_test('7F0000', <<EOS, 0, 127, 0, 'value hsv getp1');
  82 120 1.0
  83 0 0 getp1 value
  84 hsv
  85 EOS
  86 op_test("7F0000", <<EOS, 255, 0, 0, 'hue');
  87 0 0 getp1 hue
  88 1.0 1.0 hsv
  89 EOS
  90 op_test("7F0000", <<EOS, 0, 255, 0, 'sat');
  91 120 0 0 getp1 sat 1.0 hsv
  92 EOS
  93 op_test("4060A0", <<'EOS', 128, 128, 128, "add mult sub rgb red green blue");
  94 0 0 getp1 !p @p red 2 * @p green 32 + @p blue 32 - rgb
  95 EOS
  96 op_test('806040', <<'EOS', 64, 64, 64, "div uminus");
  97 0 0 getp1 !p @p red 2 / @p green 32 uminus add @p blue rgb
  98 EOS
  99 op_test('40087f', <<'EOS', 8, 64, 31, 'pow mod');
 100 0 0 getp1 !p @p red 0.5 pow @p green 2 pow @p blue 32 mod rgb
 101 EOS
 102 op_test('202122', '0 0 getp1 4 *', 128, 132, 136, 'multp');
 103 op_test('404040', '0 0 getp1 1 2 3 rgb +', 65, 66, 67, 'addp');
 104 op_test('414243', '0 0 getp1 3 2 1 rgb -', 62, 64, 66, 'subp');
 105 op_test('808040', <<'EOS', 64, 64, 8, 'sin cos pi sqrt');
 106 0 0 getp1 !p pi 6 / sin @p red * 0.1 + pi 3 / cos @p green * 0.1 +
 107 @p blue sqrt rgb
 108 EOS
 109 op_test('008080', <<'EOS', 0, 0, 0, 'atan2');
 110 0 0 0 0 getp1 !p @p red 128 / @p green 128 / atan2 hsv
 111 EOS
 112 op_test('000000', <<'EOS', 150, 150, 150, 'distance');
 113 0 100 120 10 distance !d @d @d @d rgb
 114 EOS
 115 op_test('000000', <<'EOS', 100, 100, 100, 'int');
 116 50.75 int 2 * !i @i @i @i rgb
 117 EOS
 118 op_test('000100', <<'EOS', 128, 0, 0, 'if');
 119 0 0 getp1 !p @p red 0 128 if @p green 0 128 if 0 rgb
 120 EOS
 121 op_test('FF0000', <<'EOS', 0, 255, 0, 'ifp');
 122 0 0 0 getp1 0 255 0 rgb ifp
 123 EOS
 124 op_test('000000', <<'EOS', 1, 0, 1, 'le lt gt');
 125 0 1 le 1 0 lt 1 0 gt rgb
 126 EOS
 127 op_test('000000', <<'EOS', 0, 1, 0, 'ge eq ne');
 128 0 1 ge 0 0 eq 0 0 ne rgb
 129 EOS
 130 op_test('000000', <<'EOS', 0, 1, 1, 'and or not');
 131 1 0 and 1 0 or 0 not rgb
 132 EOS
 133 op_test('000000', <<'EOS', 255, 0, 255, 'abs');
 134 -255 abs 0 abs 255 abs rgb
 135 EOS
 136 op_test('000000', <<'EOS', 50, 82, 0, 'exp log');
 137 1 exp log 50 * 0.5 + 0.5 exp 50 * 0 rgb
 138 EOS
 139 op_test('800000', <<'EOS', 128, 0, 0, 'det');
 140 1 0 0 1 det 128 * 1 1 1 1 det 128 * 0 rgb
 141 EOS
 142 op_test('FF80C0', <<'EOS', 127, 0, 0, 'sat');
 143 0 0 getp1 sat 255 * 0.01 + 0 0 rgb
 144 EOS
 145
 146 use Imager::Transform;
 147
 148 # some simple tests
 149 print "# Imager::Transform\n";
 150 my @funcs = Imager::Transform->list;
 151 ok(@funcs, "funcs");
 152
 153 my $tran = Imager::Transform->new($funcs[0]);
 154 ok($tran, "got tranform");
 155 ok($tran->describe() eq Imager::Transform->describe($funcs[0]),
 156    "description");
 157 # look for a function that takes inputs (at least one does)
 158 my @needsinputs = grep Imager::Transform->new($_)->inputs, @funcs;
 159 # make sure they're
 160 my @inputs = Imager::Transform->new($needsinputs[0])->inputs;
 161 ok($inputs[0]{desc}, "input description");
 162 # at some point I might want to test the actual transformations
 163
 164 # check lower level error handling
 165 my $im7 = Imager::transform2({rpnexpr=>'x y getp2', width=>100, height=>100});
 166 ok(!$im7, "expected failure on accessing invalid image");
 167 print "# ", Imager->errstr, "\n";
 168 ok(Imager->errstr =~ /not enough images/, "didn't get expected error");
 169
 170 sub op_test ($$$$$$) {
 171   my ($in_color, $code, $r, $g, $b, $comment) = @_;
 172
 173   my $im = Imager->new(xsize => 1, ysize => 1);
 174   $im->setpixel(x => 0, y => 0, color => $in_color);
 175  SKIP:
 176   {
 177     my $out = Imager::transform2({ rpnexpr => $code }, $im);
 178     unless ($out) {
 179       fail("$comment: could not compile $code - ".Imager->errstr);
 180       return;
 181     }
 182     my $found = $out->getpixel(x => 0, y => 0);
 183     is_color3($found, $r, $g, $b, $comment);
 184   }
 185 }