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 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. 9# 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 (preserve input, modify output) 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 54