Automate your color correction with a Perl script

Card Trick

© articular, Fotolia

© articular, Fotolia

Article from Issue 95/2008

If you have grown tired of manually correcting color-casted images (as described in last month's Perl column), you might appreciate a script that automates this procedure.

Last month, I wrote about using reference cards to correct the white balance in digital photos by taking a test snapshot (see Figure 1) [2]. The black, white, and gray plastic cards, which are available from any good photography equipment dealer, should not generate any color values in a digital image. This provides three calibration points for low, medium, and high light intensity, which the GIMP photo editing tool can then reference to correct your snapshots.

Perl Magic

How can a simple Perl script find out which pixel values the three cards create, even though their position in the image is not known, without using artificial intelligence?

If the photographer manages to spread the cards in the center of the image as shown in Figure 1, the script can follow an imaginary horizontal line and identify the cards on the basis of pixel values along the x axis.

The light intensity measured along this line remains constant for a fairly substantial distance, as long as the line lies within one reference card.

Once the line touches the background, the pixel values will start to fluctuate significantly.

Listing 1, graphdraw, uses the CPAN Imager module to create the graphs shown in Figure 2.

The graphs represent the red, green, and blue components of the color values along the horizontal line drawn in Figure 1 on a coordinate system in which the x axis matches the x coordinates in the image and the y value represents the color component value with a range of 0 through 255.

The CPAN Imager module's read() (line 12) is a multi-talented beast that can identify, read, and convert any popular image format to its own internal Imager format for editing.

Listing 1


01 #!/usr/local/bin/perl -w
02 use strict;
03 use Imager;
04 use Imager::Plot;
05 use Log::Log4perl;
07 my ($file) = @ARGV;
08 die "No file given"
09   unless defined $file;
11 my $img = Imager->new();
12 $img->read( file => $file )
13   or die $img->errstr();
15 $img->filter(
16   type   => "gaussian",
17   stddev => 10
18 ) or die $img->errstr;
20 my $y = int(
21   $img->getheight() / 2 );
22 my $width = $img->getwidth();
24 my $data = {};
26 for my $x ( 0 .. $width - 1 )
27 {
28   push @{ $data->{x} }, $x;
30   my $color = $img->getpixel(
31     x => $x,
32     y => $y
33   );
34   my @components =
35     $color->rgba();
36   for my $color_name (
37     qw(red green blue))
38   {
39     push @{ $data
40         ->{$color_name} },
41       shift @components;
42   }
43 }
45 my $plot = Imager::Plot->new(
46   Width  => 550,
47   Height => 350,
48   GlobalFont =>
49 ,/usr/share/fonts/truetype/msttcorefonts/Verdana.ttf'
50 );
52 for my $color_name (
53   qw(red green blue))
54 {
55   $plot->AddDataSet(
56     X => $data->{x},
57     Y =>
58       $data->{$color_name},
59     style => {
60       marker => {
61         size   => 2,
62         symbol => ,circle',
63         color =>
64           Imager::Color->new(
65           $color_name),
66       }
67     }
68   );
69 }
71 my $graph = Imager->new(
72   xsize => 600,
73   ysize => 400
74 );
76 $graph->box(
77   filled => 1,
78   color  => ,white'
79 );
81 # Add text
82 $plot->{,Ylabel'} =
83   ,RGB Values';
84 $plot->{,Xlabel'} =
85   ,X-Pixel';
86 $plot->{,Title'} =
87   ,RGB-Distribution';
89 $plot->Render(
90   Image => $graph,
91   Xoff  => 40,
92   Yoff  => 370
93 );
95 $graph->write(
96   file => "graph.png" )
97   or die $graph->errstr();


If something goes wrong, the Imager methods return false values. For more details about an error, cautious programmers tend to call the errstr() method to return a cleartext description of the issue. The getpixel() method (line 30) examines the RGB values of a pixel in the image at a location defined by its x and y coordinates and returns an Imager::Color object, which contains the pixel's RGB values.

A call to rgba() (line 35) returns these values along with the value for the alpha channel. Here, you are just interested in the first three RGB values.

The script calls shift in line 41 to extract them one by one.

Image View

The Imager::Plot module represents boring numbers as graphs in an attractive coordinate system without too much hassle with respect to scaling, axis labeling, or graphical layout, and it returns image files in all popular formats, allowing the user to check them later with an image viewer or web browser. The new() constructor (line 45) accepts the dimensions for the resulting image and the path to an installed True Type font, which it then uses for axis labeling.

The script collects the required coordinates in a hash of hashes, to which $data points. It stores all the x coordinates in $data->{x} and all red values in $data->{red}; the green and blue values are stored in the same manner. The AddDataSet() method (line 55) then adds the data separately for each of the three graphs, each of which are drawn in a different color.

On completion, a new Imager object is created in line 71; later, it will create the resulting graphics file. Before this happens, the box() method colors the image background white, then Render() draws the coordinate system, the labels, and the three graphs in one fell swoop.

Finally, the write() method saves the output file on disk in PNG format.

Buy this article as PDF

Express-Checkout as PDF
Price $2.95
(incl. VAT)

Buy Linux Magazine

Get it on Google Play

US / Canada

Get it on Google Play

UK / Australia

Related content

  • Perl: Retouching Photos

    In many cases, whole series of digital images need the same kind of modifications, which forces the photo-grapher to repeat the same steps time and time again in GIMP. Have you ever considered retouching in Perl?

  • Perl: Photos Effects

    With the GIMP image editing program, and a little help from Perl, you can enhance your digital photos and transform a modern image into a nostalgic turn-of-the-century shot.

  • Perl: Sharpen Images

    How do you sharpen a digital image? A short introduction to the principles and a Perl plugin for GIMP help amateur digital photographers polish their snapshots in a professional way.

  • Perl: Google Chart Instructions

    A CPAN module passes drawing instructions in object-oriented Perl to Google Chart, which draws visually attractive diagrams.

  • Photo Processing with GIMP

    Touch up your digital images with the GIMP image processing tool.

comments powered by Disqus

Direct Download

Read full article as PDF:

072-076_perl.pdf  (801.31 kB)