Yes I play this game every day on the web. I just wanted to see if I could do it.

There are probably still bugs!

Tested with xterm on Debian.

Update

I think I've fixed the bugs pointed out by toolic. Let me know if you find any more.

Update number 2

I think that this now works correctly, but if you find any bugs please let me know. TIA

Update number 3

Thanks to toolic and wazoox for helping to find bugs. I hope that this fix is the last.     :)

#!/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 '/us
+r/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", @lette
+rs ];
        redo;
        }

    # The correct answer
    if ( $word eq $curr_word ) {
        $lines[ $curr_line ] = [ map "$white_on_green $_ $reset", @let
+ters ];
        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_g
+ray $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 $re
+set";
        $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_g
+reen $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;
    }
[download]