cristy | 3ed852e | 2009-09-05 21:47:34 +0000 | [diff] [blame^] | 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 | # |
| 14 | use strict; |
| 15 | use Image::Magick; |
| 16 | |
| 17 | # read original image |
| 18 | my $orig = Image::Magick->new(); |
| 19 | my $w = $orig->Read('rose:'); |
| 20 | warn("$w") if $w; |
| 21 | exit if $w =~ /^Exception/; |
| 22 | |
| 23 | |
| 24 | # make a clone of the image for modifications |
| 25 | my $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... |
| 32 | my ($width, $height) = $dest->Get('width', 'height'); |
| 33 | |
| 34 | for( 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'); |
| 52 | |