1#!/usr/bin/perl -w 2 3use Gimp; 4use Gimp::Fu; 5use Gimp::Util; 6use PDL; 7use strict; 8use warnings; 9 10use constant PI => 4 * atan2 1,1; 11 12# es folgt das eigentliche Skript... 13sub pixelmap { 14 my($image,$drawable,$_expr)=@_; 15 16 Gimp->progress_init ("Mapping pixels..."); 17 18 my $init=""; 19 20 $_expr =~ /\$p/ and $init.='$p = $src->data;'; 21 $_expr =~ /\$P/ and $init.= $drawable->has_alpha ? '$P = $src->data;' : '$P = $src->data->slice("0:-1");'; 22 $_expr =~ /\$x/ and $init.='$x = (zeroes(long,$w)->xvals + $_dst->x)->dummy(1,$h)->sever;'; 23 $_expr =~ /\$y/ and $init.='$y = (zeroes(long,$h)->xvals + $_dst->y)->dummy(0,$w)->sever;'; 24 $_expr =~ /\$bpp/ and $init.='$bpp = $_dst->bpp;'; 25 26 my($p,$P,$x,$y,$bpp,$w,$h); 27 28 $_expr = "sub{$init\n#line 1\n$_expr\n;}"; 29 30 my @_bounds = $drawable->bounds; 31 { 32 # $src and $dst must either be scoped or explicitly undef'ed 33 # before merge_shadow. 34 my $src = new Gimp::PixelRgn $drawable->get,@_bounds,0,0; 35 my $_dst = new Gimp::PixelRgn $drawable,@_bounds,1,1; 36 37 $_expr = eval $_expr; die "$@" if $@; 38 39 my $_iter = Gimp->pixel_rgns_register ($src, $_dst); 40 my $_area = 0; 41 42 do { 43 ($w,$h)=($src->w,$src->h); 44 $_area += $w*$h/($_bounds[2]*$_bounds[3]); 45 $_dst->data(&$_expr); 46 Gimp->progress_update ($_area); 47 } while (Gimp->pixel_rgns_process ($_iter)); 48 } 49 50 $drawable->merge_shadow (1); 51 $drawable->update (@_bounds); 52 53 (); # wir haben kein neues Bild erzeugt 54} 55 56register "pixelmap", 57 "Maps Pixel values and coordinates through general Perl expressions", 58 '', '', '', '', 59 N_"<Image>/Filters/Generic/Pixelmap...", 60 "*", 61 [ 62 [PF_TEXT, "expression", "The perl expression to use", '($x*$y*0.01)'."\n".'->slice("*$bpp")'] 63 ], 64 \&pixelmap; 65 66register "pixelgen", 67 "Generate the pixels of an image by expressions (in PDL)", 68 '', '', '', '', 69 N_"<Image>/File/Create/Logos/Pixelgenerator...", 70 undef, 71 [ 72 [PF_SPINNER, "width" , "The width of the new image to generate", 512, [1, 4096, 1]], 73 [PF_SPINNER, "height" , "The height of the new image to generate", 512, [1, 4096, 1]], 74 [PF_RADIO, "type" , "The type of the layer to create (same as gimp_layer_new.type)", 75 RGB_IMAGE , [RGB => RGB_IMAGE, RGBA => RGBA_IMAGE, GRAY => GRAY_IMAGE, 76 GRAYA => GRAYA_IMAGE, INDEXED => INDEXED_IMAGE, INDEXEDA => INDEXEDA_IMAGE]], 77 [PF_TEXT, "expression" , "The perl expression to use", "(\$x*\$y*0.01)\n->slice(\"*\$bpp\")"] 78 ], 79 sub { 80 my($w,$h,$type,$expr)=@_; 81 my $image = new Gimp::Image $w, $h, Gimp->layer2imagetype($type); 82 my $layername = $expr; 83 $layername =~ s/\n//g; 84 my $layer = new Gimp::Layer $image, $w, $h, $type, $layername, 100, NORMAL_MODE; 85 $image->insert_layer($layer, 0, 0); 86 eval { pixelmap($image, $layer, $expr) }; 87 if ($@) { 88 my $error = $@; 89 $image->delete; 90 die $error; 91 }; 92 eval { Gimp::Display->new($image); }; 93 $image; 94}; 95 96exit main; 97__END__ 98 99=head1 NAME 100 101pixelgen/pixelmap - Generate the pixels of an image by expressions (in PDL) 102 103=head1 SYNOPSIS 104 105 <Image>/File/Create/Logos/Pixelgenerator... 106 <Image>/Filters/Generic/Pixelmap... 107 108=head1 DESCRIPTION 109 110A PDL user-defined mapping plug-in 111 112=over 4 113 114=item $p 115 116The source pixels (1..4 bytes per pixel, depending on format). Use like this: 117 118 $p*3.5 # the return value is the result 119 120=item $P 121 122The source pixels without alpha. Use it like this: 123 124 $P *= 0.5; $p # modify $P inplace, return also modified $p as result 125 126=item $x 127 128A two-dimensional vector containing the x-coordinates of each point in the current tile: 129 130 $x = (zeroes(long,$w)->xvals + $destination->x)->dummy(1,$h)->sever; 131 132=item $y 133 134A two-dimensional vector containing the y-coordinates of each point in the current tile: 135 136 $y = (zeroes(long,$h)->xvals + $destination->y)->dummy(0,$w)->sever; 137 138=item $bpp 139 140The bytes per pixel value of the destination area. 141 142=back 143 144=head1 AUTHOR 145 146Marc Lehmann <pcg@goof.com> 147 148=head1 DATE 149 15019991115 151 152=head1 LICENSE 153 154Distributed under the same terms as Gimp-Perl. 155