diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Imager/Transform.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Imager/Transform.pm | 534 |
1 files changed, 534 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Imager/Transform.pm b/Master/tlpkg/tlperl/lib/Imager/Transform.pm new file mode 100755 index 00000000000..4c43abbe1f7 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Imager/Transform.pm @@ -0,0 +1,534 @@ +package Imager::Transform; +use strict; +use Imager; +use Imager::Expr::Assem; +use vars qw($VERSION); + +$VERSION = "1.004"; + +my %funcs = + ( + mandel=> + { + desc=>"Mandelbrot set", + type=>'assem', + assem=><<EOS, +# x treated as in range minx..maxx +# y treated as in range miny..maxy + var nx:n ; var ny:n + var diffx:n ; var diffy:n +# conx/y are x/y adjusted to min..max ranges + var conx:n ; var cony:n + diffx = subtract maxx minx + conx = div x w + conx = mult conx diffx + conx = add conx minx + diffy = subtract maxy miny + cony = div y h + cony = mult cony diffy + cony = add cony miny + nx = 0 + ny = 0 + var count:n + count = 0 +loop: +# calculate (nx,ny)**2 +(x,y)-> +# (nx*nx-ny*ny+x, 2.nx.ny+y) + var wx:n ; var wy:n ; var work:n + wx = mult nx nx + wy = mult ny ny + wx = subtract wx wy + ny = mult ny nx + ny = mult ny 2 + nx = wx + nx = add nx conx + ny = add ny cony + work = distance nx ny 0 0 + work = gt work 2 + jumpnz work docol + count = add count 1 + work = lt count maxcount + jumpnz work loop + jumpnz insideangle doinang + var workp:p + workp = rgb 0 0 0 + ret workp + doinang: + var ang:n + ang = atan2 ny nx + ang = mult ang 360 + ang = div ang pi + workp = hsv ang 255 0.5 + ret workp + docol: + var outvalue:n + outvalue = mult outsidevaluestep count + outvalue = add outvalue outsidevalue + outvalue = mod outvalue 1.01 + jumpnz outsideangle do_outang + work = mult count huestep + work = add work huebase + work = mod work 360 + workp = hsv work 1 outvalue + ret workp + do_outang: + ang = atan2 ny nx + ang = mult ang 360 + ang = div ang pi + ang = add ang outsidebase + workp = hsv ang outsidesat outvalue + ret workp +EOS + constants=> + { + minx=>{ default=>-2, desc=>'Left of rendered area', }, + miny=>{ default=>-1.5, desc=>'Top of rendered area', }, + maxx=>{ default=>1, desc=>'Right of rendered area', }, + maxy=>{ default=>1.5, desc=>'Bottom of rendered area', }, + maxcount=>{ default=>100, desc=>'Maximum iterations', }, + huestep=>{ default=>21.1, desc=>'Hue step for number of iterations', }, + huebase=>{ default=>0, desc=>'Base hue for number of iterations', }, + insideangle=> + { + default=>0, + desc=>'Non-zero to use angle of final as hue for inside', + }, + insidebase=> + { + default=>0, + desc=>'Base angle for inside colours if insideangle is non-zero', + }, + outsideangle=> + { + default=>0, + desc=>'Non-zero to use angle of final as hue for outside', + }, + outsidebase=> + { + default=>0, + desc=>'Base angle if outsideangle is true', + }, + outsidevalue=> + { + default=>1, + desc=>'Brightness for outside pixels', + }, + outsidevaluestep=> + { + default=>0, + desc=>'Brightness step for each count for outside pixels', + }, + outsidesat=> + { + default=>1, + desc=>'Saturation for outside pixels', + }, + }, + inputs=>[], + }, + julia=> + { + desc=>"Julia set", + type=>'assem', + assem=><<EOS, +# print x +# x treated as in range minx..maxx +# y treated as in range miny..maxy + var nx:n ; var ny:n + var diffx:n ; var diffy:n +# conx/y are x/y adjusted to min..max ranges + var conx:n ; var cony:n + diffx = subtract maxx minx + conx = div x w + conx = mult conx diffx + conx = add conx minx + diffy = subtract maxy miny + cony = div y h + cony = mult cony diffy + cony = add cony miny + nx = conx + ny = cony + var count:n + count = 0 +loop: +# calculate (nx,ny)**2 +(x,y)-> +# (nx*nx-ny*ny+x, 2.nx.ny+y) + var wx:n ; var wy:n ; var work:n + wx = mult nx nx + wy = mult ny ny + wx = subtract wx wy + ny = mult ny nx + ny = mult ny 2 + nx = wx + nx = add nx zx + ny = add ny zy + work = distance nx ny 0 0 + work = gt work 2 + jumpnz work docol + count = add count 1 + work = lt count maxcount + jumpnz work loop + jumpnz insideangle doinang + var workp:p + workp = rgb 0 0 0 + ret workp + doinang: + var ang:n + ang = atan2 ny nx + ang = mult ang 360 + ang = div ang pi + workp = hsv ang 255 0.5 + ret workp + docol: + var outvalue:n + outvalue = mult outsidevaluestep count + outvalue = add outvalue outsidevalue + outvalue = mod outvalue 1.01 + jumpnz outsideangle do_outang + work = mult count huestep + work = add work huebase + work = mod work 360 + workp = hsv work 1 outvalue + ret workp + do_outang: + ang = atan2 ny nx + ang = mult ang 360 + ang = div ang pi + ang = add ang outsidebase + workp = hsv ang outsidesat outvalue + ret workp +EOS + constants=> + { + zx=>{default=>0.7, desc=>'Real part of initial Z', }, + zy=>{default=>0.2, desc=>'Imaginary part of initial Z', }, + minx=>{ default=>-1.5, desc=>'Left of rendered area', }, + miny=>{ default=>-1.5, desc=>'Top of rendered area', }, + maxx=>{ default=>1.5, desc=>'Right of rendered area', }, + maxy=>{ default=>1.5, desc=>'Bottom of rendered area', }, + maxcount=>{ default=>100, desc=>'Maximum iterations', }, + huestep=>{ default=>21.1, desc=>'Hue step for number of iterations', }, + huebase=>{ default=>0, desc=>'Base hue for number of iterations', }, + insideangle=> + { + default=>0, + desc=>'Non-zero to use angle of final as hue for inside', + }, + insidebase=> + { + default=>0, + desc=>'Base angle for inside colours if insideangle is non-zero', + }, + outsideangle=> + { + default=>0, + desc=>'Non-zero to use angle of final as hue for outside', + }, + outsidebase=> + { + default=>0, + desc=>'Base angle if outsideangle is true', + }, + outsidevalue=> + { + default=>1, + desc=>'Brightness for outside pixels', + }, + outsidevaluestep=> + { + default=>0, + desc=>'Brightness step for each count for outside pixels', + }, + outsidesat=> + { + default=>1, + desc=>'Saturation for outside pixels', + }, + }, + inputs=>[], + }, + circleripple=> + { + type=>'rpnexpr', + desc=>'Adds a circular ripple effect', + rpnexpr=><<'EOS', +x y cx cy distance !dist +@dist freq / sin !scale +@scale depth * @dist + !adj +y cy - x cx - atan2 !ang +cx @ang cos @adj * + cy @ang sin @adj * + getp1 @scale shadow + shadow 1 + / * +EOS + constants=> + { + freq=> { desc=>'Frequency of ripples', default=>5 }, + depth=> { desc=>'Depth of ripples', default=>10 }, + shadow=> { desc=>'Fraction of shadow', default=>20 }, + }, + inputs=> + [ + { desc=>'Image to ripple' } + ], + }, + spiral=> + { + type=>'rpnexpr', + desc=>'Render a colorful spiral', + rpnexpr=><<'EOS', +x y cx cy distance !d y cy - x cx - atan2 !a +@d spacing / @a + pi 2 * % !a2 +@a 180 * pi / 1 @a2 sin 1 + 2 / hsv +EOS + constants=> + { + spacing=>{ desc=>'Spacing between arms', default=>10 }, + }, + inputs=>[], + }, + diagripple=> + { + type=>'rpnexpr', + desc=>'Adds diagonal ripples to an image', + rpnexpr=><<'EOS', +x y + !dist @dist freq / sin !scale +@scale depth * !adj + x @adj + y @adj + getp1 @scale shadow + shadow 1 + / * +EOS + constants=> + { + freq=>{ desc=>'Frequency of ripples', default=>5, }, + depth=>{desc=>'Depth of ripples', default=>3,}, + shadow=> + { + desc=>'Fraction of brightness to remove for shadows', + default=>20, + }, + }, + inputs=> + [ + { desc=>'Image to add ripples to' } + ], + }, + twist=> + { + type=>'rpnexpr', + desc=>'Twist an image', + rpnexpr=><<'EOS', +x y cx cy distance !dist + y cy - x cx - atan2 @dist twist / + !ang +cx @ang cos @dist * + cy @ang sin @dist * + getp1 +EOS + constants=> + { + twist=>{ desc=>'Amount of twist', default=>2.5, }, + }, + inputs=> + [ + { desc=>'Image to twist' }, + ], + }, + # any other functions can wait until Imager::Expr::Infix supports + # jumps + ); + +sub new { + my ($class, $name) = @_; + + exists $funcs{$name} or return; + + bless { func=>$funcs{$name}, name=>$name }, $class; +} + +sub inputs { + my ($self) = @_; + return @{$self->{func}{inputs}} +} + +sub constants { + my $self = shift; + if (@_) { + return @{$self->{func}{constants}}{@_}; + } + else { + return keys %{$self->{func}{constants}}; + } +} + +sub transform { + my ($self, $opts, $constants, @in) = @_; + + my $func = $self->{func}; + my %opts = %$opts; + $opts{$func->{type}} = $func->{$func->{type}}; + my %con = %$constants; + for my $name (keys %{$func->{'constants'}}) { + unless (exists $con{$name}) { + if (exists $func->{'constants'}{$name}{default}) { + $con{$name} = $func->{'constants'}{$name}{default}; + } + else { + $self->{error} = "No value or default for constant $name"; + return; + } + } + } + $opts{'constants'} = \%con; + unless (@in == @{$func->{'inputs'}}) { + $self->{error} = @in." input images given, ". + @{$func->{'inputs'}}." supplied"; + return; + } + + my $out = Imager::transform2(\%opts, @in); + unless ($out) { + $self->{error} = $Imager::ERRSTR; + return; + } + return $out; +} + +sub errstr { + return $_[0]{error}; +} + +sub list { + return keys %funcs; +} + +sub describe { + my ($class, $name) = @_; + + my $func; + if (ref $class && !$name) { + $func = $class->{func}; + $name = $class->{name} + } + else { + $func = $funcs{$name} + or return undef; + } + my $desc = <<EOS; +Function : $name +Description: $func->{desc} +EOS + if ($func->{'inputs'} && @{$func->{'inputs'}}) { + $desc .= "Input images:\n"; + my $i = 1; + for my $in (@{$func->{'inputs'}}) { + $desc .= " $i: $in->{desc}\n"; + } + } + else { + $desc .= "There are no input images\n"; + } + if ($func->{'constants'} && keys %{$func->{'constants'}}) { + $desc .= "Input constants:\n"; + for my $key (keys %{$func->{'constants'}}) { + $desc .= " $key: $func->{'constants'}{$key}{desc}\n"; + $desc .= " Default: $func->{'constants'}{$key}{default}\n"; + } + } + else { + $desc .= "There are no constants\n"; + } + + return $desc; +} + + +1; + +__END__ + +=head1 NAME + + Imager::Transform - a library of register machine image transformations + +=head1 SYNOPSIS + + # get a list of transformations + my @funcs = Imager::Transform->list; + # create a transformation object + my $tran = Imager::Transform->new($name); + # describe it + print $tran->describe; + # a list of constant names + my @constants = $tran->constants; + # information about some of the constants + my @info = $tran->constants(@constants); + +=head1 DESCRIPTION + +This module provides a library of transformations that use the Imager +transform2() function. + +The aim is to provide a place to collect these transformations. + +At some point there might be an interface to add new functions, but +there's not a whole lot of point to that. + +The interface is a little sparse as yet. + +=head1 METHODS + +=over 4 + +=item my @names = Imager::Transform->list + +Returns a list of the transformations. + +=item my $desc = Imager::Transform->describe($name); + +=item my $desc = $tran->describe() + +Describes a transformation specified either by name (as a class +method) or by reference (as an instance method). + +The class method returns undef if there is no such transformation. + +=item my $tran = Imager::Transform->new($name) + +Create a new transformation object. Returns undef if there is no such +transformation. + +=item my @inputs = $tran->inputs; + +=item my $inputs = $tran->inputs; + +Returns a list of input image descriptions, or the number of them, +depending on content. + +The list contains hashrefs, which current contain only one member, +desc, a description of the use of the input image. + +=item $tran->constants + +Return's a list of names of constants that can be set for the +transformation. + +=item $tran->constants($name, $name, ...) + +Returns a hashref for each named constant, which contains the default +in key C<default> and a description in key C<desc>. + +=item my $out = $tran->transform(\%opts, \%constants, @imgs) + +Perform the image transformation. + +Returns the new image on success, or undef on failure, in which case +you can use $tran->errstr to get an error message. + +=item $tran->errstr + +The error message, if any from the last image transformation. + +=back + +=head1 BUGS + +Needs more transformations. + +=head1 SEE ALSO + +Imager(3), transform.perl + +=cut |