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