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