]>
Commit | Line | Data |
---|---|---|
02d1d628 AMH |
1 | package Imager::Transform; |
2 | use strict; | |
3 | use Imager; | |
4 | use Imager::Expr::Assem; | |
f17b46d8 TC |
5 | use vars qw($VERSION); |
6 | ||
8ba1b8a6 | 7 | $VERSION = "1.006"; |
02d1d628 AMH |
8 | |
9 | my %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 | |
34 | loop: | |
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 | |
81 | EOS | |
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 | |
153 | loop: | |
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 | |
200 | EOS | |
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', |
255 | x y cx cy distance !dist | |
256 | @dist freq / sin !scale | |
257 | @scale depth * @dist + !adj | |
258 | y cy - x cx - atan2 !ang | |
259 | cx @ang cos @adj * + cy @ang sin @adj * + getp1 @scale shadow + shadow 1 + / * | |
260 | EOS | |
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', |
277 | x 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 | |
280 | EOS | |
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', | |
292 | x y + !dist @dist freq / sin !scale | |
293 | @scale depth * !adj | |
294 | x @adj + y @adj + getp1 @scale shadow + shadow 1 + / * | |
295 | EOS | |
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', | |
316 | x y cx cy distance !dist | |
317 | y cy - x cx - atan2 @dist twist / + !ang | |
318 | cx @ang cos @dist * + cy @ang sin @dist * + getp1 | |
319 | EOS | |
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 | ||
333 | sub new { | |
334 | my ($class, $name) = @_; | |
335 | ||
336 | exists $funcs{$name} or return; | |
337 | ||
338 | bless { func=>$funcs{$name}, name=>$name }, $class; | |
339 | } | |
340 | ||
341 | sub inputs { | |
342 | my ($self) = @_; | |
343 | return @{$self->{func}{inputs}} | |
344 | } | |
345 | ||
346 | sub constants { | |
347 | my $self = shift; | |
348 | if (@_) { | |
349 | return @{$self->{func}{constants}}{@_}; | |
350 | } | |
351 | else { | |
352 | return keys %{$self->{func}{constants}}; | |
353 | } | |
354 | } | |
355 | ||
356 | sub 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 | ||
389 | sub errstr { | |
390 | return $_[0]{error}; | |
391 | } | |
392 | ||
393 | sub list { | |
394 | return keys %funcs; | |
395 | } | |
396 | ||
397 | sub 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; | |
410 | Function : $name | |
411 | Description: $func->{desc} | |
412 | EOS | |
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 | ||
438 | 1; | |
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 | ||
461 | This module provides a library of transformations that use the Imager | |
462 | transform2() function. | |
463 | ||
464 | The aim is to provide a place to collect these transformations. | |
465 | ||
466 | At some point there might be an interface to add new functions, but | |
467 | there's not a whole lot of point to that. | |
468 | ||
469 | The interface is a little sparse as yet. | |
470 | ||
471 | =head1 METHODS | |
472 | ||
473 | =over 4 | |
474 | ||
475 | =item my @names = Imager::Transform->list | |
476 | ||
477 | Returns a list of the transformations. | |
478 | ||
479 | =item my $desc = Imager::Transform->describe($name); | |
480 | ||
481 | =item my $desc = $tran->describe() | |
482 | ||
483 | Describes a transformation specified either by name (as a class | |
484 | method) or by reference (as an instance method). | |
485 | ||
486 | The class method returns undef if there is no such transformation. | |
487 | ||
488 | =item my $tran = Imager::Transform->new($name) | |
489 | ||
490 | Create a new transformation object. Returns undef if there is no such | |
491 | transformation. | |
492 | ||
493 | =item my @inputs = $tran->inputs; | |
494 | ||
495 | =item my $inputs = $tran->inputs; | |
496 | ||
497 | Returns a list of input image descriptions, or the number of them, | |
498 | depending on content. | |
499 | ||
5715f7c3 TC |
500 | The list contains hash references, which current contain only one |
501 | member, C<desc>, a description of the use of the input image. | |
02d1d628 | 502 | |
8688bedd TC |
503 | =item $tran->constants |
504 | ||
5715f7c3 | 505 | Returns a list of names of constants that can be set for the |
8688bedd TC |
506 | transformation. |
507 | ||
508 | =item $tran->constants($name, $name, ...) | |
509 | ||
510 | Returns a hashref for each named constant, which contains the default | |
511 | in key C<default> and a description in key C<desc>. | |
512 | ||
02d1d628 AMH |
513 | =item my $out = $tran->transform(\%opts, \%constants, @imgs) |
514 | ||
515 | Perform the image transformation. | |
516 | ||
517 | Returns the new image on success, or undef on failure, in which case | |
518 | you can use $tran->errstr to get an error message. | |
519 | ||
520 | =item $tran->errstr | |
521 | ||
522 | The error message, if any from the last image transformation. | |
523 | ||
524 | =back | |
525 | ||
526 | =head1 BUGS | |
527 | ||
528 | Needs more transformations. | |
529 | ||
530 | =head1 SEE ALSO | |
531 | ||
5715f7c3 | 532 | Imager(3), F<transform.perl> |
02d1d628 | 533 | |
8ba1b8a6 TC |
534 | =head1 AUTHOR |
535 | ||
536 | Tony Cook <tonyc@cpan.org> | |
537 | ||
02d1d628 | 538 | =cut |