Image autocrop

autocrop.pl

#!perl
use PDL;

my $file = shift || 'example.jpg'; # if no argument is passed use example.jpg
my $thres = 0.40;

# chopping the file path ...
my $s = rindex($f,'/');
my $fpath = ($s > 0) ? substr($f,0,$s) : '.';
my $filename = substr($file,$s+1);
my $p = rindex($filename,'.');
my $basen = ($p>0) ? substr($filename,0,$p) : $filename;
my $ext = lc substr($filename,$p+1);
#printf "%s %s %s %s\n",$fpath,$filename,$basen,$ext; exit;

my $cropfile = "${basen}_cropped.$ext"; # results

my $yc = pdl( [.299,.587,.114] ); # primaries sensitivity coefficients ...
our $pix = inner($yc,rpic($file));
my ($xsize, $ysize) = dims($pix);
printf "%s: %ux%u\n",$basen,$xsize,$ysize;

# ---------------------------------------------
# use the average brightness to determine ROI
my $level = avg($pix) * $thres;
my $mask = $pix>$level;
use PDL::Graphics::Gnuplot qw(image); image $mask;

my ($xmin,$xmax) = (undef,undef);
my ($ymin,$ymax) = (undef,undef);
# ---------------------------------------------
  
for my $j (0 .. $ysize-1) {
  my $k = $ysize-1 - $j;
  #printf "row%u: %u\n",$j,nelem(which($ppm->slice(":,($j)")));
  if (! defined $ymin && nelem(which($mask->slice(":,($j)"))) ) { $ymin = $j; last if defined $ymax; }
  if (! defined $ymax && nelem(which($mask->slice(":,($k)"))) ) { $ymax = $k; last if defined $ymin; }
}

for my $i (0 .. $xsize-1) {
  my $l = $xsize-1 - $i;
  #printf "col%u: %u %u %u\n",$i,nelem(which($ppm->slice("($i),:"))),$xmin,$xmax;
  if (! defined $xmin && nelem(which($mask->slice("($i),:")))) { $xmin = $i; last if defined $xmax; }
  if (! defined $xmax && nelem(which($mask->slice("($l),:")))) { $xmax = $l; last if defined $xmin; }
}
  
# ---------------------------------------------
  printf "y: min=%u, max=%u\n",$ymin,$ymax;
  printf "x: min=%u, max=%u\n",$xmin,$xmax; 
  my $ROI = sprintf '%u:%u,%u:%u',$xmin,$xmax,$ymin,$ymax;
  my $cropped = $pix->slice($ROI);
  wpic($cropped,$cropfile);
  
exit $?;
1; # $Source: /my/perl/scripts/at/ACE/autocrop.pl,v $