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

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 $divider = "   ---   ---   ---   ---   ---\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 

KB

my @lines = (
	[ ( '   ' ) x 5 ],
	[ ( '   ' ) x 5 ],
	[ ( '   ' ) x 5 ],
	[ ( '   ' ) x 5 ],
	[ ( '   ' ) x 5 ],
	[ ( '   ' ) x 5 ],
	);
my $curr_line = 0;

my %dict;
{
	open my $FH, '<', '/usr/share/dict/words' or die "Cannot open '/usr/share/dict/words' because: $!";
	@dict{ map uc, grep /[aeiou]|.y./, map /^([a-z]{5})$/, <$FH> } = ();
	}
my $curr_word = ( keys %dict )[ rand keys %dict ];

{	local $| = 1;

	print
		$clear,
		"   ${white_on_gray}Letter not used.$reset\n",
		"   ${white_on_yellow}Letter is used.$reset\n",
		"   ${white_on_green}Letter in correct place.$reset\n",
		"   ${white_on_red}Not a valid word.$reset\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;
		}

	print 'Enter five letter word: ';
	my ( $word ) = map uc, <STDIN> =~ /^([a-zA-Z]{5})/;
	my @letters = split //, $word;
	@letters == 5 or redo;

	# 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/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$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/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_gray $letter $reset/;
		}

	# Find exact matches
	my @found = ( 0 ) x 5;
	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/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_green $letter $reset/;
		}

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

	# Find other correct letters
	for my $index ( 0 .. $#letters ) {
		next if $found[ $index ];
		my $letter = $letters[ $index ];
		if ( $curr_remains =~ s/$letter/ / ) {
			$lines[ $curr_line ][ $index ] = "$white_on_yellow $letter $reset";
			$kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_yellow $letter $reset/;
			}
		}

	++$curr_line;
	redo;
	}