• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/perl
2#
3# Methods for to Get and Set single pixels in images using PerlMagick
4#
5use strict;
6use Image::Magick;
7
8# read image
9my $im=Image::Magick->new();
10$im->Read('logo:');
11
12# ---
13
14# Get/Set a single pixel as a string
15my $skin=$im->Get('pixel[400,200]');
16print "Get('pixel[x,y]') = ", $skin, "\n";
17
18$im->Set('pixel[1,1]'=>'0,0,0,0');
19$im->Set('pixel[2,1]'=>$skin);
20$im->Set('pixel[3,1]'=>'green');
21$im->Set('pixel[4,1]'=>'rgb(255,0,255)');
22
23# ---
24
25# More direct single pixel access
26my @pixel = $im->GetPixel( x=>400, y=>200 );
27print "GetPixel() = ", "@pixel", "\n";
28
29# modify the pixel values (as normalized floats)
30$pixel[0] = $pixel[0]/2;      # darken red value
31$pixel[1] = 0.0;              # junk green value
32$pixel[2] = 0.0;              # junk blue value
33
34# write pixel to destination
35# (quantization and clipping happens here)
36$im->SetPixel(x=>5,y=>1,color=>\@pixel);
37
38# ---
39
40# crop, scale, display the changed pixels
41$im->Crop(geometry=>'7x3+0+0');
42$im->Set(page=>'0x0+0+0');
43$im->Scale('1000%');
44
45# Output the changed pixels
46$im->Write('win:');
47$im->Write('single-pixels.gif');
48
49