Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

ETJ / Gimp-2.38 / examples / gouge 

            

              
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

              
#!/usr/bin/perl -w
use Gimp;
use Gimp::Fu;
use PDL::LiteF;
use strict;
use warnings;
sub iterate {
   my ($drawable,$message,$kernel)=@_;
   Gimp->progress_init ($message);
   my @bounds = $drawable->bounds;
   my @off = $drawable->offsets;
   $bounds[2]-- if $bounds[0]+$bounds[2] >= $off[0]+$drawable->width;
   $bounds[3]-- if $bounds[1]+$bounds[3] >= $off[1]+$drawable->height;
   {
      my $src = new Gimp::PixelRgn ($drawable,@bounds[0,1],$bounds[2]+1,$bounds[3]+1,0,0);
      my $dst = new Gimp::PixelRgn ($drawable,@bounds,1,1);
      my $iter = Gimp->pixel_rgns_register ($dst);
      my $area = $bounds[2]*$bounds[3];
      my $progress = 0;
      do {
         my ($x,$y,$w,$h)=($dst->x,$dst->y,$dst->w,$dst->h);
         $dst->data($kernel->($src->get_rect($x,$y,$w+1,$h+1)->convert(short)));
         $progress += $w*$h/$area;
         Gimp->progress_update ($progress);
      } while (Gimp->pixel_rgns_process ($iter));
   }
   Gimp->progress_update (1);
   $drawable->merge_shadow (1);
   $drawable->update (@bounds);
   ();
}
register "blur_2x2",
         "smooth (low pass filter) an image using a fast 2x2 kernel",
         "Low-pass filtering (smoothing) using a fast 2x2 kernel",
         '', '', '',
       N_"<Image>/Filters/Blur/2x2 Blur",
         '', '',
         sub {
   my($image,$drawable)=@_;
   iterate $drawable,
           "2x2 smoothing...",
           sub {
              ($_[0]->slice(":,0:-2,0:-2")+
               $_[0]->slice(":,1:-1,0:-2")+
               $_[0]->slice(":,1:-1,1:-1")+
               $_[0]->slice(":,0:-2,1:-1"))>>2;
           };
};
register "contrast_enhance_2x2",
         "contrast enhance an image using a fast 2x2 kernel",
         "Contrast Enhance an image using a fast 2x2 kernel",
         '', '', '',
         N_"<Image>/Filters/Enhance/2x2 Contrast Enhance",
         '', '',
         sub {
   my($image,$drawable)=@_;
   iterate $drawable,
           "2x2 contrast enhancing...",
           sub {
              my $T = $_[0]->slice(":,0:-2,0:-2");
              my $D = $_[0]->slice(":,1:-1,1:-1");
              (($T<<1)-$D)->clip(0,255);
           };
};
register "edge_detect_2x2",
         "detects edges in an image using a fast 2x2 kernel",
         "Detect edges in the image using a 2x2 kernel. It is similar to Sobel, yet sharper (and lower quality).",
         '', '', '',
         N_"<Image>/Filters/Edge-Detect/2x2 Edge Detect",
         '', '',
         sub {
   my($image,$drawable)=@_;
   iterate $drawable,
           "2x2 cross gradient...",
           sub {
              my $T = $_[0]->slice(":,0:-2,0:-2");
              my $R = $_[0]->slice(":,1:-1,0:-2");
              my $D = $_[0]->slice(":,1:-1,1:-1");
              abs(cat($T-$R,$T-$D))
              ->convert(byte)
              ->mv(3,0)
              ->maximum;
           };
};
exit main;
__END__
=head1 NAME
blur_2x2/contrast_enhance_2x2/edge_detect_2x2 - Use a fast 2x2 kernel
to detect edges/enhance/smooth image
=head1 SYNOPSIS
  <Image>/Filters/Edge-Detect/2x2 Edge Detect
  <Image>/Filters/Blur/2x2 Blur
  <Image>/Filters/Enhance/2x2 Contrast Enhance
=head1 DESCRIPTION
Detect edges in the image using a 2x2 kernel. It is similar to Sobel,
yet sharper (and lower quality).
Implements some algorithms described in (the otherwise very bad)
L<http://www.biocomputer.com/Thesis.html>
These are all simple 2x2 kernels, fast but relatively effective.
=head1 PARAMETERS
 # none
=head1 IMAGE TYPES
RGB*, GRAY*
=head1 AUTHOR
Marc Lehmann <pcg@goof.com>
=head1 DATE
19990725
=head1 LICENSE
Distributed under the same terms as Gimp-Perl.