Card Trick » Linux Magazine

Automate your color correction with a Perl script

Nicely Out of Focus

Before a script can reliably identify the three areas at the center of the image, you need to make some preparations. Figure 2 clearly shows how much the graph fluctuates, and this is obviously going to make it difficult to identify the somewhat flatter areas. Thus, the cardfind detection script (Listing 2) needs to run a blur filter that uses the "Gaussian Blur" method with a radius of 10 to defocus the image (lines 15ff.).

In an out-of-focus image (see Figure 3), the color transitions between individual pixels are less abrupt. Instead of jumping directly from a white to black pixel, an out-of-focus image will show a transition with several gray scale values. The graph shown in Figure 4, which represents the pixel values on the same horizontal line, is far smoother as a result of this, and also simplifies the task of identifying the three areas to be identified.

Figure 3: Setting the blur filter to "Gaussian Blur" with a radius of 10 pixels defocuses the image and smoothes the pixel values.

Figure 4: The image, defocused with the blur filter, has smoother graphs, making it easier to identify the flat spots caused by the three cards.

Listing 2

cardfind

001 #!/usr/local/bin/perl -w
002 use strict;
003 use Imager;
004 use YAML qw(Dump);
005
006 my ($file) = @ARGV;
007 die "No file given"
008   unless defined $file;
009
010 my $img = Imager->new();
011 $img->read( file => $file )
012   or die "Can't read $file";
013
014 # Blur
015 $img->filter(
016   type   => "gaussian",
017   stddev => 10
018 ) or die $img->errstr;
019
020 my $y = int(
021   $img->getheight() / 2 );
022 my $width = $img->getwidth();
023
024 my @intens_ring = ();
025 my @diff_ring   = ();
026 my $found       = 0;
027 my @ctl_points  = ();
028
029 for my $x ( 0 .. $width - 1 )
030 {
031   my $color = $img->getpixel(
032     x => $x,
033     y => $y
034   );
035   my @components =
036     $color->rgba();
037
038 # Save current intensity
039 # in ring buffer
040   my $intens =
041     @components[ 0, 1, 2 ];
042   push @intens_ring, $intens;
043   shift @intens_ring
044     if @intens_ring > 50;
045
046 # Store slope between
047 # x and x-50
048   push @diff_ring,
049     abs( $intens -
050       $intens_ring[0] );
051   shift @diff_ring
052     if @diff_ring > 50;
053
054   if ($found) {
055
056     # Inside flat region
057     if ( avg( \@diff_ring ) >
058       10 )
059     {
060       $found = 0;
061     }
062   }
063   else {
064
065     # Outside flat region
066     if (  $x > $width / 3
067       and $x < 2 / 3 * $width
068       and avg( \@diff_ring )
069       < 3 )
070     {
071       $found = 1;
072       push @ctl_points,
073         [ @components[ 0, 1,
074         2 ] ];
075     }
076   }
077 }
078
079 my $out = {};
080 my @labels =
081   qw(low medium high);
082
083 # Sort by intensity
084 for my $ctl_point (
085   sort {
086     $a->[0] +
087       $a->[1] +
088       $a->[2] <=> $b->[0] +
089       $b->[1] +
090       $b->[2]
091   } @ctl_points
092   )
093 {
094   my $label = shift @labels;
095   $out->{$label}->{red} =
096     $ctl_point->[0];
097   $out->{$label}->{green} =
098     $ctl_point->[1];
099   $out->{$label}->{blue} =
100     $ctl_point->[2];
101   last unless @labels;
102 }
103
104 print Dump($out);
105
106 #############################
107 sub avg {
108 #############################
109   my ($arr) = @_;
110
111   my $sum = 0;
112   $sum += $_ for @$arr;
113   return $sum / @$arr;
114 }

Back to School?

In these card areas, the curve is fairly flat over a length of hundreds of pixels. If you remember your math from school, you might recall that the first derivative of a graph like this at flat spots is constant and about zero, whereas the values will be far higher and fluctuate significantly everywhere else.

Figure 5 shows the first derivative of intensity values, which are calculated by adding the pixel values for the red, green, and blue channels. The recorded values are indicative of the fluctuation of the original graph and drop to zero over quite considerable distances.

Figure 5: The first derivative of the intensity graph tends toward zero for homogeneous sections of the image.

The cards, with their homogeneous gray scales, occupy these positions in the original image. Thus, the script just needs to follow this graph, create a ring buffer of about 50 investigated values, and alert when the buffer average drops to a value close to zero. When it does so, it has located a card.

Return to Search

When the buffer values start to fluctuate again, the script has left the card area and returns to the state "search for the next homogeneous location." The script should be able to find all three regions you are looking for and return the RGB values it finds there in YAML format. This lets the picfix script I discussed in last month's Perl column adjust the white balance of other images with the same light conditions.

« Previous 1 2 3 Next »

Our Services

Read full article as PDF » 072-076_perl.pdf (801.31 kB)

comments powered by Disqus

Visit Our Shop

Trial Subscription

Digital Subscription

Direct Download