#!/usr/local/bin/perl -w
###########################################
# cardfind - Find reference cards in pic
# Mike Schilli, 2008 (
[email protected])
###########################################
use strict;
use Imager;
use YAML qw(Dump);
my($file) = @ARGV;
die "No file given" unless defined $file;
my $img = Imager->new();
$img->read(file => $file) or
die "Can't read $file";
# Blur
$img->filter(
type => "gaussian",
stddev => 10 ) or die $img->errstr;
my $y = int( $img->getheight() / 2 );
my $width = $img->getwidth();
my @intens_ring = ();
my @diff_ring = ();
my $found = 0;
my @ctl_points = ();
for my $x (0..$width-1) {
my $color = $img->getpixel( x => $x,
y => $y );
my @components = $color->rgba();
# Save current intensity in ring buffer
my $intens = @components[0,1,2];
push @intens_ring, $intens;
shift @intens_ring if @intens_ring > 50;
# Store slope between x and x-50
push @diff_ring,
abs($intens - $intens_ring[0]);
shift @diff_ring if @diff_ring > 50;
if($found) {
# Inside flat region
if(avg(\@diff_ring) > 10) {
$found = 0;
}
} else {
# Outside flat region
if($x > $width/3 and
$x < 2/3*$width and
avg(\@diff_ring) < 3) {
$found = 1;
push @ctl_points,
[@components[0,1,2]];
}
}
}
my $out = {};
my @labels = qw(low medium high);
# Sort by intensity
for my $ctl_point (sort {
$a->[0] + $a->[1] + $a->[2] <=>
$b->[0] + $b->[1] + $b->[2] }
@ctl_points) {
my $label = shift @labels;
$out->{$label}->{red} = $ctl_point->[0];
$out->{$label}->{green}= $ctl_point->[1];
$out->{$label}->{blue} = $ctl_point->[2];
last unless @labels;
}
print Dump($out);
###########################################
sub avg {
###########################################
my($arr) = @_;
my $sum = 0;
$sum += $_ for @$arr;
return $sum/@$arr;
}