svn:ignore some more profiler files and other junk
[imager.git] / lib / Imager / Transform.pm
CommitLineData
02d1d628
AMH
1package Imager::Transform;
2use strict;
3use Imager;
4use Imager::Expr::Assem;
f17b46d8
TC
5use vars qw($VERSION);
6
4e33b785 7$VERSION = "1.004";
02d1d628
AMH
8
9my %funcs =
10 (
11 mandel=>
12 {
13 desc=>"Mandelbrot set",
14 type=>'assem',
15 assem=><<EOS,
16# x treated as in range minx..maxx
17# y treated as in range miny..maxy
18 var nx:n ; var ny:n
19 var diffx:n ; var diffy:n
20# conx/y are x/y adjusted to min..max ranges
21 var conx:n ; var cony:n
22 diffx = subtract maxx minx
23 conx = div x w
24 conx = mult conx diffx
25 conx = add conx minx
26 diffy = subtract maxy miny
27 cony = div y h
28 cony = mult cony diffy
29 cony = add cony miny
30 nx = 0
31 ny = 0
32 var count:n
33 count = 0
34loop:
35# calculate (nx,ny)**2 +(x,y)->
36# (nx*nx-ny*ny+x, 2.nx.ny+y)
37 var wx:n ; var wy:n ; var work:n
38 wx = mult nx nx
39 wy = mult ny ny
40 wx = subtract wx wy
41 ny = mult ny nx
42 ny = mult ny 2
43 nx = wx
44 nx = add nx conx
45 ny = add ny cony
46 work = distance nx ny 0 0
47 work = gt work 2
48 jumpnz work docol
49 count = add count 1
50 work = lt count maxcount
51 jumpnz work loop
52 jumpnz insideangle doinang
53 var workp:p
54 workp = rgb 0 0 0
55 ret workp
56 doinang:
57 var ang:n
58 ang = atan2 ny nx
59 ang = mult ang 360
60 ang = div ang pi
61 workp = hsv ang 255 0.5
62 ret workp
63 docol:
64 var outvalue:n
65 outvalue = mult outsidevaluestep count
66 outvalue = add outvalue outsidevalue
67 outvalue = mod outvalue 1.01
68 jumpnz outsideangle do_outang
69 work = mult count huestep
70 work = add work huebase
71 work = mod work 360
72 workp = hsv work 1 outvalue
73 ret workp
74 do_outang:
75 ang = atan2 ny nx
76 ang = mult ang 360
77 ang = div ang pi
78 ang = add ang outsidebase
79 workp = hsv ang outsidesat outvalue
80 ret workp
81EOS
82 constants=>
83 {
84 minx=>{ default=>-2, desc=>'Left of rendered area', },
85 miny=>{ default=>-1.5, desc=>'Top of rendered area', },
86 maxx=>{ default=>1, desc=>'Right of rendered area', },
87 maxy=>{ default=>1.5, desc=>'Bottom of rendered area', },
88 maxcount=>{ default=>100, desc=>'Maximum iterations', },
89 huestep=>{ default=>21.1, desc=>'Hue step for number of iterations', },
90 huebase=>{ default=>0, desc=>'Base hue for number of iterations', },
91 insideangle=>
92 {
93 default=>0,
94 desc=>'Non-zero to use angle of final as hue for inside',
95 },
96 insidebase=>
97 {
98 default=>0,
99 desc=>'Base angle for inside colours if insideangle is non-zero',
100 },
101 outsideangle=>
102 {
103 default=>0,
104 desc=>'Non-zero to use angle of final as hue for outside',
105 },
106 outsidebase=>
107 {
108 default=>0,
109 desc=>'Base angle if outsideangle is true',
110 },
111 outsidevalue=>
112 {
113 default=>1,
114 desc=>'Brightness for outside pixels',
115 },
116 outsidevaluestep=>
117 {
118 default=>0,
119 desc=>'Brightness step for each count for outside pixels',
120 },
121 outsidesat=>
122 {
123 default=>1,
124 desc=>'Saturation for outside pixels',
125 },
126 },
127 inputs=>[],
128 },
129 julia=>
130 {
131 desc=>"Julia set",
132 type=>'assem',
133 assem=><<EOS,
134# print x
135# x treated as in range minx..maxx
136# y treated as in range miny..maxy
137 var nx:n ; var ny:n
138 var diffx:n ; var diffy:n
139# conx/y are x/y adjusted to min..max ranges
140 var conx:n ; var cony:n
141 diffx = subtract maxx minx
142 conx = div x w
143 conx = mult conx diffx
144 conx = add conx minx
145 diffy = subtract maxy miny
146 cony = div y h
147 cony = mult cony diffy
148 cony = add cony miny
149 nx = conx
150 ny = cony
151 var count:n
152 count = 0
153loop:
154# calculate (nx,ny)**2 +(x,y)->
155# (nx*nx-ny*ny+x, 2.nx.ny+y)
156 var wx:n ; var wy:n ; var work:n
157 wx = mult nx nx
158 wy = mult ny ny
159 wx = subtract wx wy
160 ny = mult ny nx
161 ny = mult ny 2
162 nx = wx
163 nx = add nx zx
164 ny = add ny zy
165 work = distance nx ny 0 0
166 work = gt work 2
167 jumpnz work docol
168 count = add count 1
169 work = lt count maxcount
170 jumpnz work loop
171 jumpnz insideangle doinang
172 var workp:p
173 workp = rgb 0 0 0
174 ret workp
175 doinang:
176 var ang:n
177 ang = atan2 ny nx
178 ang = mult ang 360
179 ang = div ang pi
180 workp = hsv ang 255 0.5
181 ret workp
182 docol:
183 var outvalue:n
184 outvalue = mult outsidevaluestep count
185 outvalue = add outvalue outsidevalue
186 outvalue = mod outvalue 1.01
187 jumpnz outsideangle do_outang
188 work = mult count huestep
189 work = add work huebase
190 work = mod work 360
191 workp = hsv work 1 outvalue
192 ret workp
193 do_outang:
194 ang = atan2 ny nx
195 ang = mult ang 360
196 ang = div ang pi
197 ang = add ang outsidebase
198 workp = hsv ang outsidesat outvalue
199 ret workp
200EOS
201 constants=>
202 {
203 zx=>{default=>0.7, desc=>'Real part of initial Z', },
204 zy=>{default=>0.2, desc=>'Imaginary part of initial Z', },
205 minx=>{ default=>-1.5, desc=>'Left of rendered area', },
206 miny=>{ default=>-1.5, desc=>'Top of rendered area', },
207 maxx=>{ default=>1.5, desc=>'Right of rendered area', },
208 maxy=>{ default=>1.5, desc=>'Bottom of rendered area', },
209 maxcount=>{ default=>100, desc=>'Maximum iterations', },
210 huestep=>{ default=>21.1, desc=>'Hue step for number of iterations', },
211 huebase=>{ default=>0, desc=>'Base hue for number of iterations', },
212 insideangle=>
213 {
214 default=>0,
215 desc=>'Non-zero to use angle of final as hue for inside',
216 },
217 insidebase=>
218 {
219 default=>0,
220 desc=>'Base angle for inside colours if insideangle is non-zero',
221 },
222 outsideangle=>
223 {
224 default=>0,
225 desc=>'Non-zero to use angle of final as hue for outside',
226 },
227 outsidebase=>
228 {
229 default=>0,
230 desc=>'Base angle if outsideangle is true',
231 },
232 outsidevalue=>
233 {
234 default=>1,
235 desc=>'Brightness for outside pixels',
236 },
237 outsidevaluestep=>
238 {
239 default=>0,
240 desc=>'Brightness step for each count for outside pixels',
241 },
242 outsidesat=>
243 {
244 default=>1,
245 desc=>'Saturation for outside pixels',
246 },
247 },
248 inputs=>[],
249 },
250 circleripple=>
251 {
252 type=>'rpnexpr',
faa9b3e7 253 desc=>'Adds a circular ripple effect',
02d1d628
AMH
254 rpnexpr=><<'EOS',
255x y cx cy distance !dist
256@dist freq / sin !scale
257@scale depth * @dist + !adj
258y cy - x cx - atan2 !ang
259cx @ang cos @adj * + cy @ang sin @adj * + getp1 @scale shadow + shadow 1 + / *
260EOS
261 constants=>
262 {
263 freq=> { desc=>'Frequency of ripples', default=>5 },
264 depth=> { desc=>'Depth of ripples', default=>10 },
265 shadow=> { desc=>'Fraction of shadow', default=>20 },
266 },
267 inputs=>
268 [
269 { desc=>'Image to ripple' }
270 ],
271 },
272 spiral=>
273 {
274 type=>'rpnexpr',
faa9b3e7 275 desc=>'Render a colorful spiral',
02d1d628
AMH
276 rpnexpr=><<'EOS',
277x y cx cy distance !d y cy - x cx - atan2 !a
278@d spacing / @a + pi 2 * % !a2
279@a 180 * pi / 1 @a2 sin 1 + 2 / hsv
280EOS
281 constants=>
282 {
283 spacing=>{ desc=>'Spacing between arms', default=>10 },
284 },
285 inputs=>[],
286 },
287 diagripple=>
288 {
289 type=>'rpnexpr',
290 desc=>'Adds diagonal ripples to an image',
291 rpnexpr=><<'EOS',
292x y + !dist @dist freq / sin !scale
293@scale depth * !adj
294 x @adj + y @adj + getp1 @scale shadow + shadow 1 + / *
295EOS
296 constants=>
297 {
298 freq=>{ desc=>'Frequency of ripples', default=>5, },
299 depth=>{desc=>'Depth of ripples', default=>3,},
300 shadow=>
301 {
302 desc=>'Fraction of brightness to remove for shadows',
303 default=>20,
304 },
305 },
306 inputs=>
307 [
308 { desc=>'Image to add ripples to' }
309 ],
310 },
311 twist=>
312 {
313 type=>'rpnexpr',
314 desc=>'Twist an image',
315 rpnexpr=><<'EOS',
316x y cx cy distance !dist
317 y cy - x cx - atan2 @dist twist / + !ang
318cx @ang cos @dist * + cy @ang sin @dist * + getp1
319EOS
320 constants=>
321 {
322 twist=>{ desc=>'Amount of twist', default=>2.5, },
323 },
324 inputs=>
325 [
326 { desc=>'Image to twist' },
327 ],
328 },
329 # any other functions can wait until Imager::Expr::Infix supports
330 # jumps
331 );
332
333sub new {
334 my ($class, $name) = @_;
335
336 exists $funcs{$name} or return;
337
338 bless { func=>$funcs{$name}, name=>$name }, $class;
339}
340
341sub inputs {
342 my ($self) = @_;
343 return @{$self->{func}{inputs}}
344}
345
346sub constants {
347 my $self = shift;
348 if (@_) {
349 return @{$self->{func}{constants}}{@_};
350 }
351 else {
352 return keys %{$self->{func}{constants}};
353 }
354}
355
356sub transform {
357 my ($self, $opts, $constants, @in) = @_;
358
359 my $func = $self->{func};
360 my %opts = %$opts;
361 $opts{$func->{type}} = $func->{$func->{type}};
362 my %con = %$constants;
9d540150 363 for my $name (keys %{$func->{'constants'}}) {
02d1d628 364 unless (exists $con{$name}) {
9d540150
TC
365 if (exists $func->{'constants'}{$name}{default}) {
366 $con{$name} = $func->{'constants'}{$name}{default};
02d1d628
AMH
367 }
368 else {
369 $self->{error} = "No value or default for constant $name";
370 return;
371 }
372 }
373 }
9d540150
TC
374 $opts{'constants'} = \%con;
375 unless (@in == @{$func->{'inputs'}}) {
02d1d628 376 $self->{error} = @in." input images given, ".
9d540150 377 @{$func->{'inputs'}}." supplied";
02d1d628
AMH
378 return;
379 }
380
381 my $out = Imager::transform2(\%opts, @in);
382 unless ($out) {
383 $self->{error} = $Imager::ERRSTR;
384 return;
385 }
386 return $out;
387}
388
389sub errstr {
390 return $_[0]{error};
391}
392
393sub list {
394 return keys %funcs;
395}
396
397sub describe {
398 my ($class, $name) = @_;
399
400 my $func;
401 if (ref $class && !$name) {
402 $func = $class->{func};
403 $name = $class->{name}
404 }
405 else {
406 $func = $funcs{$name}
407 or return undef;
408 }
409 my $desc = <<EOS;
410Function : $name
411Description: $func->{desc}
412EOS
9d540150 413 if ($func->{'inputs'} && @{$func->{'inputs'}}) {
02d1d628
AMH
414 $desc .= "Input images:\n";
415 my $i = 1;
9d540150 416 for my $in (@{$func->{'inputs'}}) {
02d1d628
AMH
417 $desc .= " $i: $in->{desc}\n";
418 }
419 }
420 else {
421 $desc .= "There are no input images\n";
422 }
9d540150 423 if ($func->{'constants'} && keys %{$func->{'constants'}}) {
02d1d628 424 $desc .= "Input constants:\n";
9d540150
TC
425 for my $key (keys %{$func->{'constants'}}) {
426 $desc .= " $key: $func->{'constants'}{$key}{desc}\n";
427 $desc .= " Default: $func->{'constants'}{$key}{default}\n";
02d1d628
AMH
428 }
429 }
430 else {
431 $desc .= "There are no constants\n";
432 }
433
434 return $desc;
435}
436
437
4381;
439
440__END__
441
442=head1 NAME
443
444 Imager::Transform - a library of register machine image transformations
445
446=head1 SYNOPSIS
447
448 # get a list of transformations
449 my @funcs = Imager::Transform->list;
450 # create a transformation object
451 my $tran = Imager::Transform->new($name);
452 # describe it
453 print $tran->describe;
454 # a list of constant names
455 my @constants = $tran->constants;
456 # information about some of the constants
457 my @info = $tran->constants(@constants);
458
459=head1 DESCRIPTION
460
461This module provides a library of transformations that use the Imager
462transform2() function.
463
464The aim is to provide a place to collect these transformations.
465
466At some point there might be an interface to add new functions, but
467there's not a whole lot of point to that.
468
469The interface is a little sparse as yet.
470
471=head1 METHODS
472
473=over 4
474
475=item my @names = Imager::Transform->list
476
477Returns a list of the transformations.
478
479=item my $desc = Imager::Transform->describe($name);
480
481=item my $desc = $tran->describe()
482
483Describes a transformation specified either by name (as a class
484method) or by reference (as an instance method).
485
486The class method returns undef if there is no such transformation.
487
488=item my $tran = Imager::Transform->new($name)
489
490Create a new transformation object. Returns undef if there is no such
491transformation.
492
493=item my @inputs = $tran->inputs;
494
495=item my $inputs = $tran->inputs;
496
497Returns a list of input image descriptions, or the number of them,
498depending on content.
499
500The list contains hashrefs, which current contain only one member,
faa9b3e7 501desc, a description of the use of the input image.
02d1d628
AMH
502
503=item my $out = $tran->transform(\%opts, \%constants, @imgs)
504
505Perform the image transformation.
506
507Returns the new image on success, or undef on failure, in which case
508you can use $tran->errstr to get an error message.
509
510=item $tran->errstr
511
512The error message, if any from the last image transformation.
513
514=back
515
516=head1 BUGS
517
518Needs more transformations.
519
520=head1 SEE ALSO
521
522Imager(3), transform.perl
523
524=cut