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