Gimp/plug-ins/perl/examples/pixelmap

#!/usr/bin/perl -w

use Gimp::Feature 'pdl';
use Gimp 1.099;
use Gimp::Fu;
use Gimp::Util;
use PDL;

use constant PI => 4 * atan2 1,1;

sub pixelmap {					# es folgt das eigentliche Skript...
   my($image,$drawable,$_expr)=@_;

   Gimp->progress_init ("Mapping pixels...");
   
   my $init="";

   $_expr =~ /\$p/   and $init.='$p = $src->data;';
   $_expr =~ /\$P/   and $init.= $drawable->has_alpha ? '$P = $src->data;' : '$P = $src->data->slice("0:-1");';
   $_expr =~ /\$x/   and $init.='$x = (zeroes(long,$w)->xvals + $_dst->x)->dummy(1,$h)->sever;';
   $_expr =~ /\$y/   and $init.='$y = (zeroes(long,$h)->xvals + $_dst->y)->dummy(0,$w)->sever;';
   $_expr =~ /\$bpp/ and $init.='$bpp = $_dst->bpp;';

   my($p,$P,$x,$y,$bpp,$w,$h);

   $_expr = "sub{$init\n#line 1\n$_expr\n;}";

   my @_bounds = $drawable->bounds;
   {
      # $src and $dst must either be scoped or explicitly undef'ed
      # before merge_shadow.
      my $src  = new PixelRgn $drawable->get,@_bounds,0,0;
      my $_dst = new PixelRgn $drawable,@_bounds,1,1;

      $_expr = eval $_expr; die "$@" if $@;

      $_iter = Gimp->pixel_rgns_register ($src, $_dst);
      my $_area = 0;

      do {
         ($w,$h)=($src->w,$src->h);
         $_area += $w*$h/($_bounds[2]*$_bounds[3]);
         $_dst->data(&$_expr);
         Gimp->progress_update ($_area);
      } while (Gimp->pixel_rgns_process ($_iter));
   }

   $drawable->merge_shadow (1);
   $drawable->update (@_bounds);

   ();		# wir haben kein neues Bild erzeugt
}

register "pixelmap",
         "Maps Pixel values and coordinates through general Perl expressions",
         "=pod(DESCRIPTION)",
         "Marc Lehmann",
         "Marc Lehmann <pcg\@goof.com>",
         "19991115",
         N_"<Image>/Filters/Map/Pixelmap",
         "*",	
         [
           [PF_TEXT,		"expression"	, "The perl expression to use",	"outer(\$x*0.1,\$y*0.2)\n->slice(\"*\$bpp\")"]
         ],
         \&pixelmap;

register "pixelgen",
         "Generate the pixels of an image by expressions (in PDL)",
         "=pod(DESCRIPTION)",
         "Marc Lehmann",
         "Marc Lehmann <pcg\@goof.com>",
         "19991115",
         N_"<Toolbox>/Xtns/Render/Pixelgenerator",
         "*",	
         [
           [PF_SPINNER,		"width"		, "The width of the new image to generate",	512, [1, 4096, 1]],
           [PF_SPINNER,		"height"	, "The height of the new image to generate",	512, [1, 4096, 1]],
           [PF_RADIO,		"type"		, "The type of the layer to create (same as gimp_layer_new.type)",
           			RGB_IMAGE	, [RGB => RGB_IMAGE, RGBA => RGBA_IMAGE, GRAY => GRAY_IMAGE,
                                		   GRAYA => GRAYA_IMAGE, INDEXED => INDEXED_IMAGE, INDEXEDA => INDEXEDA_IMAGE]],
           [PF_TEXT,		"expression"	, "The perl expression to use",	"outer(\$x*0.1,\$y*0.2)\n->slice(\"*\$bpp\")"]
         ],
         [PF_IMAGE],
         sub {
   my($w,$h,$type,$expr)=@_;
   my $image = new Image $w, $h, Gimp->layer2imagetype($type);
   my $layer = new Layer $image, $w, $h, $type, $expr, 100, NORMAL_MODE;
   $image->add_layer($layer, 0);
   eval { pixelmap($image, $layer, $expr) };
   if ($@) {
      my $error = $@;
      $image->delete;
      die $error;
   };
   $image;
};

exit main;

=head1 DESCRIPTION

Not yet written yet, sorry...

=over 4

=item $p

The source pixels (1..4 bytes per pixel, depending on format). Use like this:

 $p*3.5		# the return value is the result

=item $P

The source pixels without alpha. Use it like this:

 $P *= 0.5; $p	# modify $P inplace, return also modified $p as result

=item $x

A two-dimensional vector containing the x-coordinates of each point in the current tile:

 $x = (zeroes(long,$w)->xvals + $destination->x)->dummy(1,$h)->sever;

=item $y

A two-dimensional vector containing the y-coordinates of each point in the current tile:

 $y = (zeroes(long,$h)->xvals + $destination->y)->dummy(0,$w)->sever;

=item $bpp

The bytes per pixel value of the destination area.

=back