#!/usr/bin/perl # # Example of modifying all the pixels in an image (like -fx). # # Currently this is slow as each pixel is being lokedup one pixel at a time. # The better technique of extracting and modifing a whole row of pixels at # a time has not been figured out, though perl functions have been provided # for this. # # Also access and controls for Area Re-sampling (EWA), beyond single pixel # lookup (interpolated unscaled lookup), is also not available at this time. # # Anthony Thyssen 5 October 2007 # use strict; use Image::Magick; # read original image my $orig = Image::Magick->new(); my $w = $orig->Read('rose:'); warn("$w") if $w; exit if $w =~ /^Exception/; # make a clone of the image (preserve input, modify output) my $dest = $orig->Clone(); # You could enlarge destination image here if you like. # And it is posible to modify the existing image directly # rather than modifying a clone as FX does. # Iterate over destination image... my ($width, $height) = $dest->Get('width', 'height'); for( my $j = 0; $j < $height; $j++ ) { for( my $i = 0; $i < $width; $i++ ) { # read original image color my @pixel = $orig->GetPixel( x=>$i, y=>$j ); # modify the pixel values (as normalized floats) $pixel[0] = $pixel[0]/2; # darken red # write pixel to destination # (quantization and clipping happens here) $dest->SetPixel(x=>$i,y=>$j,color=>\@pixel); } } # display the result (or you could save it) $dest->Write('win:'); $dest->Write('pixel-fx.gif');