#!/usr/bin/perl -w
#
# Read an imlist (x y pathname) from stdin, choose images from it as specified.
# See also: pickim.
#	- Cameron Simpson <cs@zip.com.au> 16jun2004
#

use strict qw(vars);
use Getopt::Std;
sub loadfrom($);
sub offset2index($);

($::cmd=$0) =~ s:.*/::;
$::Usage="Usage: $::cmd [-p path] [-owt] [-x lx] [-y ly] [-n nitems] [words...] <imlist
	-o	OR words instead of ANDing them.
	-w	Choose wide (landscape) pictures.
	-t	Choose tall (portrait) pictures.
	-s	Check that the file exists and is not empty.
	-n n	Choose n items. Default: 1
	-x lx	Choose pictures lx pixels or more wide.
	-y ly	Choose pictures ly pixels or more high.
";

@::IMPath=();
$::DoStat=0;
$::AndWords=1;
$::PickN=1;
$::MinX=1;
$::MinY=1;
undef $::Aspect;

{ my $badopts=0;
  my %opt;

  if (! getopts('owtsx:y:n:p:',\%opt))
  { warn "$::cmd: bad options\n";
    $badopts=1;
  }

  if ($opt{'o'})		{ $::AndWords=0; }
  if ($opt{'p'})		{ @::IMPath=grep(length,split(/:+/,$opt{'p'})); }
  if ($opt{'t'})		{ $::Aspect=PORTRAIT; }
  if ($opt{'w'})		{ $::Aspect=LANDSCAPE; }
  if ($opt{'s'})		{ $::DoStat=1; }
  if (defined $opt{'x'})	{ $::MinX=$opt{'x'}+0; }
  if (defined $opt{'y'})	{ $::MinY=$opt{'y'}+0; }
  if (defined $opt{'n'})	{ $::PickN=$opt{'n'}+0; }

  @::NotWords=map(qr($_)i,grep(defined,map(/^!/ ? $' : undef, @ARGV)));
  @::Words=map(qr($_)i,grep(defined,map(/^[^!]/ ? $_ : undef, @ARGV)));

  die $::Usage if $badopts;
}

$::MinX=1 if $::MinX < 1;
$::MinY=1 if $::MinY < 1;

@::IM=();	# list of image paths
@::IMOffset=();	# list of float image offsets

my $offset=0.0;
my $nimages=0;

@::IMPath=('-') if ! @::IMPath;

$::Xit=0;

SEARCH:
for my $search (@::IMPath)
{
  if ($search eq '-')
  { if (-t 0)
    { warn "$::cmd: stdin may not be a tty\n";
      $::Xit=1;
      next SEARCH;
    }

    undef $::Context;
    loadfrom(STDIN);
  }
  elsif (stat($search))
  { if (-f _)
    { $::Context=cs::Pathname::dirname($search);
      if (! open(SEARCH,
		 ( $search =~ /\.gz$/
		   ? "gunzip <'$search' |"
		   : "< $search\0"
		 )))
      { warn "$::cmd: can't open $search: $!\n";
	$::Xit=1;
	next SEARCH;
      }
    }
    elsif (-d _)
    { $::Context=$search;
      if (! ( -f "$search/INDEX.gz"
	      ? open(SEARCH,"gunzip <'$search/INDEX.gz' |")
	      : open(SEARCH,"< $search/INDEX\0")
	    ))
      { warn "$::cmd: can't open INDEX in $search: $!\n";
	$::Xit=1;
	next SEARCH;
      }
    }
    else
    { warn "$::cmd: can't handle search object: $search\n";
      $::Xit=1;
      next SEARCH;
    }

    loadfrom(SEARCH);
    close(SEARCH);
  }
}

die "$::cmd: nothing to pick!\n" if ! @::IM;

# optimisation
if (@::IM <= $::PickN)
{ for (@::IM)
  { print "$_\n";
  }
  exit 0;
}

my $nitems = @::IM;
my @s;
PICK:
while ($::PickN > 0 && $nitems > 0)
{
  my $poff = rand($offset);
  my $pndx = offset2index($poff);
  my $impath = $::IM[$pndx];
  $::IM[$pndx]='';
  $nitems--;

  next PICK if ! length $impath;

  if ($::DoStat)
  { if (! stat($impath))
    { warn "$::cmd: $impath: stat: $!, skipping\n";
      next PICK;
    }
    if (! -f _ || ! -s _)
    { warn "$::cmd: $impath: not non-empty file\n";
      next PICK;
    }
  }

  print "$impath\n";
  $::PickN--;
}

sub offset2index($)
{ my($off)=@_;

  my($low,$high)=(0,$#::IM);

  while ($low+1 < $high)
  {
    my $mid = int(($low+$high)/2);
    my $ioff = $::IMOffset[$mid];
    if ($ioff <= $off)	{ $low=$mid; }
    else		{ $high=$mid; }
  }

  return $low;
}

sub loadfrom($)
{ my($FILE)=@_;

  IM:
  while (<$FILE>)
  {
    chomp;
    if (! /^\s*(\d+)\s+(\d+)\s+(\S.*)/)
    { warn "$::cmd: stdin, line $.: bad data: $_\n";
      next IM;
    }

    my ($dx,$dy,$impath)=($1,$2,$3);

    # skip small images
    next IM if $dx < $::MinX;
    next IM if $dy < $::MinY;

    # skip images that are the wrong shape
    next IM if defined $::Aspect
	    && (   ( $::Aspect eq PORTRAIT && $dx > $dy )
		|| ( $::Aspect eq LANDSCAPE && $dy > $dx )
	       );

    # skip !words
    REJECT:
    for my $re (@::NotWords)
    { next IM if $impath =~ $re;
    }

    # skip if missing required words
    if ($::AndWords)
    { TRY_AND:
      for my $re (@::Words)
      { next IM if $impath !~ $re;
      }
    }
    else
    { my $ok=0;
      TRY_OR:
      for my $re (@::Words)
      { if ($impath =~ $re)
	{ $ok=1;
	  last TRY_OR;
	}
      }
      next IM if !$ok;
    }

    # haven't needed image full path until now
    if (defined $::Context)
    { $impath="$::Context/$impath";
    }

    # image is ok, add to list
    push(@::IM,$impath);
    push(@::IMOffset,$offset);

    $offset+=$dx*$dy;
    $nimages++;
  }
}