forked from openkylin/imagemagick
54 lines
1.5 KiB
Perl
Executable File
54 lines
1.5 KiB
Perl
Executable File
#!/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');
|
|
|