- added comment support the postfix transform2() expression
[imager.git] / t / t58trans2.t
1 #!perl -w
2 BEGIN { $| = 1; print "1..15\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 use Imager::Transform;
78
79 # some simple tests
80 print "# Imager::Transform\n";
81 my @funcs = Imager::Transform->list;
82 ok(@funcs, "funcs");
83
84 my $tran = Imager::Transform->new($funcs[0]);
85 ok($tran, "got tranform");
86 ok($tran->describe() eq Imager::Transform->describe($funcs[0]),
87    "description");
88 # look for a function that takes inputs (at least one does)
89 my @needsinputs = grep Imager::Transform->new($_)->inputs, @funcs;
90 # make sure they're 
91 my @inputs = Imager::Transform->new($needsinputs[0])->inputs;
92 ok($inputs[0]{desc}, "input description");
93 # at some point I might want to test the actual transformations
94
95 # check lower level error handling
96 my $im7 = Imager::transform2({rpnexpr=>'x y getp2', width=>100, height=>100});
97 ok(!$im7, "expected failure on accessing invalid image");
98 print "# ", Imager->errstr, "\n";
99 ok(Imager->errstr =~ /not enough images/, "didn't get expected error");
100
101
102 sub ok ($$) {
103   my ($test, $desc) = @_;
104
105   if ($test) {
106     print "ok $num # $desc\n";
107   }
108   else {
109     print "not ok $num # $desc\n";
110   }
111   ++$num;
112   $test;
113 }
114
115 sub is ($$$) {
116   my ($left, $right, $desc) = @_;
117
118   my $eq = $left == $right;
119   unless (ok($eq, $desc)) {
120     $left =~ s/\n/# \n/g;
121     $left =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
122     $right =~ s/\n/# \n/g;
123     $right =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
124     print "# not equal, left = '$left'\n";
125     print "# right = '$right'\n";
126   }
127   $eq;
128 }