[rt #85413] add a test for standard POD headings and fix the errors found
[imager.git] / lib / Imager / Transform.pm
1 package Imager::Transform;
2 use strict;
3 use Imager;
4 use Imager::Expr::Assem;
5 use vars qw($VERSION);
6
7 $VERSION = "1.006";
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',
253     desc=>'Adds a circular ripple effect',
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',
275     desc=>'Render a colorful spiral',
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;
363   for my $name (keys %{$func->{'constants'}}) {
364     unless (exists $con{$name}) {
365       if (exists $func->{'constants'}{$name}{default}) {
366         $con{$name} = $func->{'constants'}{$name}{default};
367       }
368       else {
369         $self->{error} = "No value or default for constant $name";
370         return;
371       }
372     }
373   }
374   $opts{'constants'} = \%con;
375   unless (@in == @{$func->{'inputs'}}) {
376     $self->{error} = @in." input images given, ".
377       @{$func->{'inputs'}}." supplied";
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
413   if ($func->{'inputs'} && @{$func->{'inputs'}}) {
414     $desc .= "Input images:\n";
415     my $i = 1;
416     for my $in (@{$func->{'inputs'}}) {
417       $desc .= "  $i: $in->{desc}\n";
418     }
419   }
420   else {
421     $desc .= "There are no input images\n";
422   }
423   if ($func->{'constants'} && keys %{$func->{'constants'}}) {
424     $desc .= "Input constants:\n";
425     for my $key (keys %{$func->{'constants'}}) {
426       $desc .= "  $key: $func->{'constants'}{$key}{desc}\n";
427       $desc .= "       Default: $func->{'constants'}{$key}{default}\n";
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
500 The list contains hash references, which current contain only one
501 member, C<desc>, a description of the use of the input image.
502
503 =item $tran->constants
504
505 Returns a list of names of constants that can be set for the
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
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
532 Imager(3), F<transform.perl>
533
534 =head1 AUTHOR
535
536 Tony Cook <tonyc@cpan.org>
537
538 =cut