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