1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
#!/opt/bin/perl
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",
undef,
"Marc Lehmann",
"Marc Lehmann <pcg\@goof.com>",
"19991115",
N_"<Image>/Filters/Generic/Pixelmap...",
"*",
[
[PF_TEXT, "expression" , "The perl expression to use", "(\$x*\$y*0.01)\n->slice(\"*\$bpp\")"]
],
\&pixelmap;
register "pixelgen",
"Generate the pixels of an image by expressions (in PDL)",
undef,
"Marc Lehmann",
"Marc Lehmann <pcg\@goof.com>",
"19991115",
N_"<Toolbox>/Xtns/Render/Pixelgenerator...",
undef,
[
[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", "(\$x*\$y*0.01)\n->slice(\"*\$bpp\")"]
],
[PF_IMAGE],
sub {
my($w,$h,$type,$expr)=@_;
my $image = new Image $w, $h, Gimp->layer2imagetype($type);
my $layername = $expr;
$layername =~ s/\n//g;
my $layer = new Layer $image, $w, $h, $type, $layername, 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
A PDL user-defined mapping plug-in
=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
=head1 LICENSE
Copyright Marc Lehman.
Distrubuted under the same terms as Gimp-Perl.
=cut
=cut
|
