#!/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 ", "19991115", N_"/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 ", "19991115", N_"/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