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     rpnexpr=><<'EOS',
 251 x y cx cy distance !dist
 252 @dist freq / sin !scale
 253 @scale depth * @dist + !adj
 254 y cy - x cx - atan2 !ang
 255 cx @ang cos @adj * + cy @ang sin @adj * + getp1 @scale shadow + shadow 1 + / *
 256 EOS
 257     constants=>
 258     {
 259      freq=> { desc=>'Frequency of ripples', default=>5 },
 260      depth=> { desc=>'Depth of ripples', default=>10 },
 261      shadow=> { desc=>'Fraction of shadow', default=>20 },
 262     },
 263     inputs=>
 264         [
 265          { desc=>'Image to ripple' }
 266          ],
 267    },
 268    spiral=>
 269    {
 270     type=>'rpnexpr',
 271     rpnexpr=><<'EOS',
 272 x y cx cy distance !d y cy - x cx - atan2 !a
 273 @d spacing / @a + pi 2 * % !a2
 274 @a 180 * pi / 1 @a2 sin 1 + 2 / hsv
 275 EOS
 276     constants=>
 277     {
 278      spacing=>{ desc=>'Spacing between arms', default=>10 },
 279     },
 280     inputs=>[],
 281    },
 282    diagripple=>
 283    {
 284     type=>'rpnexpr',
 285     desc=>'Adds diagonal ripples to an image',
 286     rpnexpr=><<'EOS',
 287 x y + !dist @dist freq / sin !scale
 288 @scale depth * !adj
 289  x @adj + y @adj + getp1 @scale shadow + shadow 1 + / *
 290 EOS
 291     constants=>
 292     {
 293      freq=>{ desc=>'Frequency of ripples', default=>5, },
 294      depth=>{desc=>'Depth of ripples', default=>3,},
 295      shadow=>
 296      {
 297          desc=>'Fraction of brightness to remove for shadows',
 298          default=>20,
 299      },
 300     },
 301     inputs=>
 302         [
 303          { desc=>'Image to add ripples to' }
 304          ],
 305    },
 306    twist=>
 307    {
 308     type=>'rpnexpr',
 309     desc=>'Twist an image',
 310     rpnexpr=><<'EOS',
 311 x y cx cy distance !dist
 312  y cy - x cx - atan2 @dist twist / + !ang
 313 cx @ang cos @dist * + cy @ang sin @dist * + getp1
 314 EOS
 315     constants=>
 316     {
 317      twist=>{ desc=>'Amount of twist', default=>2.5, },
 318     },
 319     inputs=>
 320     [
 321      { desc=>'Image to twist' },
 322     ],
 323    },
 324    # any other functions can wait until Imager::Expr::Infix supports
 325    # jumps
 326   );
 327
 328 sub new {
 329   my ($class, $name) = @_;
 330
 331   exists $funcs{$name} or return;
 332
 333   bless { func=>$funcs{$name}, name=>$name }, $class;
 334 }
 335
 336 sub inputs {
 337   my ($self) = @_;
 338   return @{$self->{func}{inputs}}
 339 }
 340
 341 sub constants {
 342   my $self = shift;
 343   if (@_) {
 344     return @{$self->{func}{constants}}{@_};
 345   }
 346   else {
 347     return keys %{$self->{func}{constants}};
 348   }
 349 }
 350
 351 sub transform {
 352   my ($self, $opts, $constants, @in) = @_;
 353
 354   my $func = $self->{func};
 355   my %opts = %$opts;
 356   $opts{$func->{type}} = $func->{$func->{type}};
 357   my %con = %$constants;
 358   for my $name (keys %{$func->{constants}}) {
 359     unless (exists $con{$name}) {
 360       if (exists $func->{constants}{$name}{default}) {
 361         $con{$name} = $func->{constants}{$name}{default};
 362       }
 363       else {
 364         $self->{error} = "No value or default for constant $name";
 365         return;
 366       }
 367     }
 368   }
 369   $opts{constants} = \%con;
 370   unless (@in == @{$func->{inputs}}) {
 371     $self->{error} = @in." input images given, ".
 372       @{$func->{inputs}}." supplied";
 373     return;
 374   }
 375
 376   my $out = Imager::transform2(\%opts, @in);
 377   unless ($out) {
 378     $self->{error} = $Imager::ERRSTR;
 379     return;
 380   }
 381   return $out;
 382 }
 383
 384 sub errstr {
 385   return $_[0]{error};
 386 }
 387
 388 sub list {
 389   return keys %funcs;
 390 }
 391
 392 sub describe {
 393   my ($class, $name) = @_;
 394
 395   my $func;
 396   if (ref $class && !$name) {
 397     $func = $class->{func};
 398     $name = $class->{name}
 399   }
 400   else {
 401     $func = $funcs{$name}
 402       or return undef;
 403   }
 404   my $desc = <<EOS;
 405 Function   : $name
 406 Description: $func->{desc}
 407 EOS
 408   if ($func->{inputs} && @{$func->{inputs}}) {
 409     $desc .= "Input images:\n";
 410     my $i = 1;
 411     for my $in (@{$func->{inputs}}) {
 412       $desc .= "  $i: $in->{desc}\n";
 413     }
 414   }
 415   else {
 416     $desc .= "There are no input images\n";
 417   }
 418   if ($func->{constants} && keys %{$func->{constants}}) {
 419     $desc .= "Input constants:\n";
 420     for my $key (keys %{$func->{constants}}) {
 421       $desc .= "  $key: $func->{constants}{$key}{desc}\n";
 422       $desc .= "       Default: $func->{constants}{$key}{default}\n";
 423     }
 424   }
 425   else {
 426     $desc .= "There are no constants\n";
 427   }
 428
 429   return $desc;
 430 }
 431
 432
 433 1;
 434
 435 __END__
 436
 437 =head1 NAME
 438
 439   Imager::Transform - a library of register machine image transformations
 440
 441 =head1 SYNOPSIS
 442
 443   # get a list of transformations
 444   my @funcs = Imager::Transform->list;
 445   # create a transformation object
 446   my $tran = Imager::Transform->new($name);
 447   # describe it
 448   print $tran->describe;
 449   # a list of constant names
 450   my @constants = $tran->constants;
 451   # information about some of the constants
 452   my @info = $tran->constants(@constants);
 453
 454 =head1 DESCRIPTION
 455
 456 This module provides a library of transformations that use the Imager
 457 transform2() function.
 458
 459 The aim is to provide a place to collect these transformations.
 460
 461 At some point there might be an interface to add new functions, but
 462 there's not a whole lot of point to that.
 463
 464 The interface is a little sparse as yet.
 465
 466 =head1 METHODS
 467
 468 =over 4
 469
 470 =item my @names = Imager::Transform->list
 471
 472 Returns a list of the transformations.
 473
 474 =item my $desc = Imager::Transform->describe($name);
 475
 476 =item my $desc = $tran->describe()
 477
 478 Describes a transformation specified either by name (as a class
 479 method) or by reference (as an instance method).
 480
 481 The class method returns undef if there is no such transformation.
 482
 483 =item my $tran = Imager::Transform->new($name)
 484
 485 Create a new transformation object.  Returns undef if there is no such
 486 transformation.
 487
 488 =item my @inputs = $tran->inputs;
 489
 490 =item my $inputs = $tran->inputs;
 491
 492 Returns a list of input image descriptions, or the number of them,
 493 depending on content.
 494
 495 The list contains hashrefs, which current contain only one member,
 496 desc, a description of the use of the image.
 497
 498 =item my $out = $tran->transform(\%opts, \%constants, @imgs)
 499
 500 Perform the image transformation.
 501
 502 Returns the new image on success, or undef on failure, in which case
 503 you can use $tran->errstr to get an error message.
 504
 505 =item $tran->errstr
 506
 507 The error message, if any from the last image transformation.
 508
 509 =back
 510
 511 =head1 BUGS
 512
 513 Needs more transformations.
 514
 515 =head1 SEE ALSO
 516
 517 Imager(3), transform.perl
 518
 519 =cut