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 # 15 use strict; 16 use Image::Magick; 17 18 # read original image 19 my $orig = Image::Magick->new(); 20 my $w = $orig->Read('rose:'); 21 warn("$w") if $w; 22 exit if $w =~ /^Exception/; 23 24 25 # make a clone of the image (preserve input, modify output) 26 my $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... 33 my ($width, $height) = $dest->Get('width', 'height'); 34 35 for( 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
