146 lines
3.9 KiB
Perl
Executable File
146 lines
3.9 KiB
Perl
Executable File
#!/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
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|