01 #!/usr/local/bin/perl -w
02 use strict;
03 use Imager;
04 use YAML qw(Dump);
05 
06 my($file) = @ARGV;
07 die "No file given" unless defined $file;
08 
09 my $img = Imager->new();
10 $img->read(file => $file) or
11     die "Can't read $file";
12 
13   # Blur
14 $img->filter(
15     type   => "gaussian",
16     stddev => 10 ) or die $img->errstr;
17 
18 my $y     = int( $img->getheight() / 2 );
19 my $width = $img->getwidth();
20 
21 my @intens_ring = ();
22 my @diff_ring   = ();
23 my $found       = 0;
24 my @ctl_points  = ();
25 
26 for my $x (0..$width-1) {
27   my $color = $img->getpixel( x => $x,
28                               y => $y );
29   my @components = $color->rgba();
30 
31     # Save current intensity in ring buffer
32   my $intens = @components[0,1,2];
33   push @intens_ring, $intens;
34   shift @intens_ring if @intens_ring > 50;
35 
36     # Store slope between x and x-50
37   push @diff_ring,
38        abs($intens - $intens_ring[0]);
39   shift @diff_ring if @diff_ring > 50;
40 
41   if($found) {
42       # Inside flat region
43     if(avg(@diff_ring) > 10) {
44       $found = 0;
45     }
46   } else {
47       # Outside flat region
48     if($x > $width/3 and
49        $x < 2/3*$width and
50        avg(@diff_ring) < 3) {
51       $found = 1;
52       push @ctl_points,
53            [@components[0,1,2]];
54     }
55   }
56 }
57 
58 my $out = {};
59 my @labels = qw(low medium high);
60 
61   # Sort by intensity
62 for my $ctl_point (sort {
63         $a->[0] + $a->[1] + $a->[2] <=>
64         $b->[0] + $b->[1] + $b->[2] }
65         @ctl_points) {
66   my $label = shift @labels;
67   $out->{$label}->{red}  = $ctl_point->[0];
68   $out->{$label}->{green}= $ctl_point->[1];
69   $out->{$label}->{blue} = $ctl_point->[2];
70   last unless @labels;
71 }
72 
73 print Dump($out);
74 
75 ###########################################
76 sub avg {
77 ###########################################
78     my($arr) = @_;
79 
80     my $sum = 0;
81     $sum += $_ for @$arr;
82     return $sum/@$arr;
83 }