root/ImageMagick/trunk/PerlMagick/demo/pixel_fx.pl

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