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