blob: 37e98aae549b1976216b098933297bd4852fa2d1 [file] [log] [blame]
cristy3ed852e2009-09-05 21:47:34 +00001#!/usr/bin/perl
2#
cristyb32b90a2009-09-07 21:45:48 +00003# Example of modifying all the pixels in an image (like -fx).
cristy3ed852e2009-09-05 21:47:34 +00004#
anthony285167e2010-09-29 07:24:06 +00005# Currently this is slow as each pixel is being lokedup one pixel at a time.
6# The better technique of extracting and modifing a whole row of pixels at
7# a time has not been figured out, though perl functions have been provided
8# for this.
cristy3ed852e2009-09-05 21:47:34 +00009#
10# Also access and controls for Area Re-sampling (EWA), beyond single pixel
11# lookup (interpolated unscaled lookup), is also not available at this time.
12#
13# Anthony Thyssen 5 October 2007
14#
15use strict;
16use Image::Magick;
17
18# read original image
19my $orig = Image::Magick->new();
20my $w = $orig->Read('rose:');
21warn("$w") if $w;
22exit if $w =~ /^Exception/;
23
24
25# make a clone of the image for modifications
26my $dest = $orig->Clone();
27
28# You could enlarge destination image here if you like.
29# And it is posible to modify the existing image directly
30# rather than modifying a clone as FX does.
31
32# Iterate over destination image...
33my ($width, $height) = $dest->Get('width', 'height');
34
35for( my $j = 0; $j < $height; $j++ ) {
36 for( my $i = 0; $i < $width; $i++ ) {
37
38 # read original image color
39 my @pixel = $orig->GetPixel( x=>$i, y=>$j );
40
41 # modify the pixel values (as normalized floats)
42 $pixel[0] = $pixel[0]/2; # darken red
43
44 # write pixel to destination
45 # (quantization and clipping happens here)
46 $dest->SetPixel(x=>$i,y=>$j,color=>\@pixel);
47 }
48}
49
50# display the result (or you could save it)
51$dest->Write('win:');
52$dest->Write('pixel_fx.gif');
53