#!/usr/bin/perl
use warnings;
use strict;

# Version 1.0

my $me = $0 =~ s|.*/||r;
my $usage = <<USAGE;
usage: $me -h -g N -w N -f WORD_FILE

    -h   This help message.
    -g   Number of guesses
         Defaults to 6
    -w   Word length
         Defaults to 5
    -f   Word file to use
         Defaults to /usr/share/dict/words

USAGE


use Getopt::Std;

getopts( 'hg:w:f:', \my %opts ) or die $usage;
die $usage if exists $opts{ h };


use Term::ReadKey;

ReadMode 4;
END { ReadMode 0; }


use Term::ANSIColor ':constants';

my $clear = `clear`;
my $reset = RESET;
my $white_on_red    = BRIGHT_WHITE . ON_RED;
my $white_on_green  = BRIGHT_WHITE . ON_GREEN;
my $white_on_yellow = BRIGHT_WHITE . ON_YELLOW;
my $white_on_gray   = BRIGHT_WHITE . ON_BRIGHT_BLACK;
my $pre  = qr/\e\[\d+m\e\[\d+m/;	# colour
my $post = qr/\e\[0m/;				# reset


# guesses allowed = number of lines displayed
my $guesses   = $opts{ g } || 6;
# length of words to use
my $word_size = $opts{ w } || 5;
# file name to use
my $file_name = $opts{ f } || '/usr/share/dict/words';


my $divider = '   ---' x $word_size . "\n";

my $kb = <<KB;
  Q  W  E  R  T  Y  U  I  O  P 

   A  S  D  F  G  H  J  K  L 

    Z  X  C  V  B  N  M 

    BS    RET    ESC to exit

KB

my @lines = map [ ( '   ' ) x $word_size ], 1 .. $guesses;

my $curr_line = 0;

my %dict;
{
	open my $FH, '<', $file_name or die "Cannot open '$file_name' because: $!";
	# exclude proper nouns and punctuation
	# words must have at least one vowel
	@dict{ map uc, grep /[aeiouy]/, map /^([a-z]{$word_size})$/, <$FH> } = ();
	}
my $curr_word = ( keys %dict )[ rand keys %dict ];


my @letters;
{	local $| = 1;

	print
		$clear,
		"\n\n",
		map( { my $line = $_; $divider, ' ', map( " |$_|", @{ $lines[ $line ] } ), "\n", $divider } 0 .. $#lines ),
		"\n\n",
		$kb,
		"\n";

	if ( $curr_line == @lines ) {
		print "\L$curr_word\n";
		last;
		}

	# Only accept keys we want to use
	# alphabetic, back space, return or escape
	my $key;
	1 until defined( $key = ReadLine( -1 ) ) && $key =~ /\A[a-zA-Z\177\n\e]\z/;

	last if $key eq "\e";

	if ( $key eq "\177" ) {
		pop @letters if @letters;
		for my $index ( 0 .. $#{ $lines[ $curr_line ] } ) {
			$lines[ $curr_line ][ $index ] = defined $letters[ $index ] ? " $letters[$index] " : '   ';
			}
		redo;
		}

	if ( $key =~ /\A[a-zA-Z]\z/ ) {
		push @letters, uc $key if @letters < $word_size;
		for my $index ( 0 .. $#{ $lines[ $curr_line ] } ) {
			$lines[ $curr_line ][ $index ] = defined $letters[ $index ] ? " $letters[$index] " : '   ';
			}
		redo;
		}

	if ( $key eq "\n" && @letters == $word_size ) {

		my $word = join '', @letters;

		# Not a valid five letter word
		unless ( exists $dict{ $word } ) {
			$lines[ $curr_line ] = [ map "$white_on_red $_ $reset", @letters ];
			redo;
			}

		# The correct answer
		if ( $word eq $curr_word ) {
			$lines[ $curr_line ] = [ map "$white_on_green $_ $reset", @letters ];
			for my $letter ( @letters ) {
				$kb =~ s/$pre? $letter $post?/$white_on_green $letter $reset/;
				}
			$curr_line = @lines;
			redo;
			}

		# Default; all letters to white on gray
		$lines[ $curr_line ] = [ map "$white_on_gray $_ $reset", @letters ];
		for my $letter ( @letters ) {
			$kb =~ s/$pre? $letter $post?/$white_on_gray $letter $reset/;
			}

		# Find exact matches
		my @found = ( 0 ) x $word_size;
		my $xor_word = $word ^ $curr_word;
		while ( $xor_word =~ /\0/g ) {
			$found[ $-[ 0 ] ] = 1;
			my $letter = $letters[ $-[ 0 ] ];
			$lines[ $curr_line ][ $-[ 0 ] ] = "$white_on_green $letter $reset";
			$kb =~ s/$pre? $letter $post?/$white_on_green $letter $reset/;
			}

		my $curr_remains = join '', ( split //, $curr_word )[ grep !$found[ $_ ], 0 .. $#found ];

		# Find other correct letters
		while ( my ( $index, $letter ) = each @letters ) {
			next if $found[ $index ];
			if ( $curr_remains =~ s/$letter/ / ) {
				$lines[ $curr_line ][ $index ] = "$white_on_yellow $letter $reset";
				$kb =~ s/$pre? $letter $post?/$white_on_yellow $letter $reset/;
				}
			}

		++$curr_line;
		@letters = ();
		}
	redo;
	}