#!/usr/bin/perl -w
use strict;
use Getopt::Std;

my %opts=();
my $usage="usage: [-hprv] [-l <#>] [-w <word>] $0\n";
die $usage unless(getopts("hl:prvw:",\%opts));
die $usage if(@ARGV);
if($opts{h}) {
	print $usage,<<'EOD';
   -h     show this help message
   -l <#> deal with <#>-letter words (default: 5)
   -p     only show perfect (in-place) letters, not out-of-place letters
   -r     require a real word be guessed
   -v     require all guesses to match everything learned so far
   -w <w> specify the word to guess as <w>
 (entering "#" as your word will tell you how many possible words are left)
 (entering "?" as your word will suggest a word to guess)
 (entering "@" as your word will show what letters are possible)
EOD
	exit 0;
}
my $wordlen=5;
if($opts{l}) {
	die "invalid word length" unless($opts{l} =~ /^[1-9]\d*$/s);
	$wordlen=$opts{l};
}
my $onlyperfect=$opts{p};
my $requirereal=$opts{r};
my $requirevalid=$opts{v};
my $target="";
if($opts{w}) {
	die "invalid target word" unless($opts{w} =~ /^[a-z]+$/s);
	$target=$opts{w};
	$wordlen=length($target);
}

# Pick a dictionary word
my @words=();
open(DICT,"<",($ENV{DICT} or "/usr/share/dict/words")) or die "open: $!";
while(defined(my $line=<DICT>)) {
	push @words,$1 if($line =~ /^([a-z]{$wordlen})\n$/s);
}
close(DICT) or die;
if($target) {
	push @words,$target unless(grep {$_ eq $target} @words);
} else {
	$target=$words[int(rand(@words))];
}

# Calculate the stats
my %letters=();
foreach my $letter (split //,$target) {
	$letters{$letter}=0 unless($letters{$letter});
	$letters{$letter}++;
}
my @valid=@words;

while(defined(my $line=<STDIN>)) {
	chomp $line;
	if("#" eq $line) {
		if(1==@valid) {
			print "There is only 1 possible word\n";
		} else {
			print "There are ",scalar(@valid)," possible words\n";
		}
		next;
	}
	if("?" eq $line) {
		my @suggestions=grep {$_ ne $target} @valid;
		if(@suggestions) {
			print "How about ",$suggestions[rand(@suggestions)],"?\n";
		} else {
			print "There's only one option left!\n";
		}
		next;
	}
	if("\@" eq $line) {
		if(1==@valid) {
			print "There is only 1 possible word\n";
		} else {
			my %poss=();
			map {map {$poss{$_}=1} split //,$_} @valid;
			print "Possible letters: ".join("",sort keys %poss)."\n";
		}
		next;
	}
	$line=lc($line);
	unless($line =~ /^[a-z]{$wordlen}$/s) {
		print STDERR "Your guess should be a $wordlen-letter word\n";
		next;
	}
	if(($requirereal or $requirevalid) and not grep {$_ eq $line} @words) {
		print STDERR "That's not a real word\n";
		next;
	}
	if($requirevalid and not grep {$_ eq $line} @valid) {
		print STDERR "That can't be the answer\n";
		next;
	}
	my @guess=split //,$line;
	my %lettersleft=%letters;
# Mark the perfect letters (in place) first
	my $incorrect=0;
	for(my $i=0;$i<@guess;$i++) {
		if(substr($target,$i,1) eq $guess[$i]) {
			$lettersleft{$guess[$i]}--;
			$guess[$i]=uc($guess[$i]);
		} else {
			$incorrect++;
		}
	}
	unless($incorrect) {
		print "---CORRECT!---\n";
		last;
	}
	my @out=();
	foreach my $letter (@guess) {
		if($letter eq uc($letter)) {
			push @out,$letter;
		} elsif($lettersleft{$letter}) {
			push @out,$onlyperfect?" ":$letter;
			$lettersleft{$letter}--;
		} else {
			push @out," ";
		}
	}
	print @out,"\n";
# First throw out any non-perfect matches
	for(my $i=0;$i<$wordlen;$i++) {
		if($guess[$i] eq uc($guess[$i])) {
			@valid=grep {lc($guess[$i]) eq substr($_,$i,1)} @valid;
		} else {
			@valid=grep {$guess[$i] ne substr($_,$i,1)} @valid;
		}
	}
	unless($onlyperfect) {
# Calculate minimum count of each letter guessed
		my %minmax=map {($_,[0,$wordlen])} "a".."z";
		map {$minmax{lc($_)}[0]++} grep /[A-Za-z]/,@out;
# Set maximum to number seen if we saw a space for this guessed letter
		for(my $i=0;$i<$wordlen;$i++) {
			$minmax{$guess[$i]}[1]=$minmax{$guess[$i]}[0] if(" " eq $out[$i]);
		}
# For each word, count number of letters and throw out word if <min or >max
		@valid=grep {
			my %count=map {($_,0)} "a".."z";
			map {$count{$_}++} split //,$_;
			not grep {$count{$_}<$minmax{$_}[0] or $minmax{$_}[1]<$count{$_}} "a".."z";
		} @valid;
	}
}

0;