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
|
#!/opt/bin/perl
use Gimp::Feature 'pdl';
use Gimp 1.1;
use Gimp::Fu;
use PDL::LiteF;
# convert to greyscale. could be improved, but should still be fast!
sub togrey {
my $pdl = shift;
$pdl->convert(ushort);
$pdl=$pdl->inner(pdl[54,183,18])/256;
$pdl->convert(byte);
$pdl;
}
register "map_to_gradient",
"map grayscale values to gradient",
"Map all the pixels to the colours of a gradient according to their greyscale value.",
"Marc Lehmann",
"Marc Lehmann <pcg\@goof.com>",
"19990802",
N_"<Image>/Filters/Colors/Map To Gradient...",
"RGB*, GRAY",
[
[PF_GRADIENT, "gradient", "The gradient to map to"],
],
sub {
my($image,$drawable,$gradient)=@_;
# 5.004 has problems with overlaying functions
Gimp->progress_init ("Mapping to '$gradient'", -1);
my $grad = pdl byte, map $_*255, @{(Gimp->gradients_get_gradient_data($gradient,256,0))[1]};
$grad->reshape(4,256);
my $alpha = $drawable->has_alpha;
$grad = $grad->slice('0:-2') unless $alpha;
$grad = togrey($grad)->dummy(0) unless $drawable->is_rgb;
my $depth = ($grad->dims)[0]; # precalculcate
$grad = $grad->xchg(0,1); # this form is later needed in index, so do it now
my @bounds = $drawable->bounds;
{
my $src = new PixelRgn ($drawable,@bounds,0,0);
my $dst = new PixelRgn ($drawable,@bounds,1,1);
my $iter = Gimp->pixel_rgns_register($src,$dst);
my $area = $bounds[2]*$bounds[3];
my $progress = 0;
do {
my $data = $src->data;
$data = $data->slice("0:-2") if $alpha; # get rid of alpha
$data = $src->bpp > 2 ? togrey($data) : $data->clump(2);
# now map from grey values to gradient
$dst->data( index($grad,$data->dummy(0,$depth)) );
$progress += ($src->w*$src->h)/$area;
Gimp->progress_update ($progress);
} while (Gimp->pixel_rgns_process ($iter));
}
Gimp->progress_update (1);
$drawable->merge_shadow (1);
$drawable->update (@bounds);
();
};
exit main;
=head1 LICENSE
Copyright Marc Lehman.
Distrubuted under the same terms as Gimp-Perl.
=cut
|
