#!/usr/local/bin/perl -w ########################################### # cardfind - Find reference cards in pic # Mike Schilli, 2008 (m@perlmeister.com) ########################################### 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; }