#!/usr/bin/perl
#
# Hangman

BEGIN {
  if ($ENV{DEBUG}) {
    *debug = sub { print @_ };
  } else {
    *debug = sub {};
  }
}

my ($dict, $wrong_guesses) = @ARGV;
defined($wrong_guesses) or usage();

chomp(my @dict = grep /..../, grep !/[^a-z\n]/, qx{cat $dict});
@dict or usage();

my $wordlen = 0;
{ my %n;
  my $n=0;
  for my $word (@dict) {
    $n{length $word}++;
    $n++;
  } 
  my $maxct = 0;
  $wordlen = weighted_select(\%n, $n);
}      
@dict = grep length($_) == $wordlen, @dict;

my $display = "_" x $wordlen;

my %guessed;
while ($wrong_guesses > 0) {
  print "\t$display\n";
  chomp(my $guess = <STDIN>);
  last unless $guess =~ /^[a-z]$/;
  redo if $guessed{$guess}++;
  $wrong_guesses -= select_worst($guess, \@dict, \$display);
  unless ($display =~ /_/) {
    print "\tLIFE!\n";
    exit;
  }
}
print "\tDEATH!\n";
print "My word was '$dict[0]'.\n";
print "Loser.\n";

# return 0 if this was a correct guess, 1 if it was a wrong guess
# modify dictionary and display appropriately.
sub select_worst {
  my ($let, $dict, $disp) = @_;
  my %d;
  for my $word (@$dict) {
    my $key = $word;
    $key =~ s/[^$let]/_/g;
    push @{$d{$key}}, $word;
  }
  my $loc = "_" x length($$disp);
  my $n = @{$d{$loc}};
  if ($n == 0) {
    my %s = map { $_ => score(@{$d{$_}}) } keys %d;
    $loc = weighted_select(\%s);
  }
  debug "    selected '$loc'\n";
  @$dict = @{$d{$loc}};
  debug "    dictionary now contains ", scalar(@$dict), " words\n";
  for my $pos (0 .. length($disp)-1) {
    next if substr($$disp, $pos, 1) ne "_";
    substr($$disp, $pos, 1) = $let if substr($loc, $pos, 1) ne "_";
  }
  return $loc !~ /$let/;
}

sub score {
  my @set = @_;
  my $score = 0;
  for ('a' .. 'z') {
    for my $word (@set) {
      if (index($_, $word) == -1) {
        $score++; 
      }
    }
  }
  $score;
}

sub weighted_select {
  my ($h, $n) = @_;
  unless ($n) {
    $n += $_ for values %$h;
  }
  my $r = int(rand $n);
  for my $e (keys %$h) {
    $r -= $h->{$e};
    return $e if $r <= 0;
  }
  die;
}