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.
If this is a copyright violation please remove it.
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; }
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: A Word Game
by Fletch (Bishop) on Feb 09, 2022 at 07:16 UTC | |
Re: A Word Game
by toolic (Bishop) on Feb 09, 2022 at 22:55 UTC | |
by LanX (Saint) on Feb 09, 2022 at 23:25 UTC | |
by jwkrahn (Abbot) on Feb 10, 2022 at 00:48 UTC | |
by toolic (Bishop) on Feb 10, 2022 at 18:32 UTC | |
by jwkrahn (Abbot) on Feb 10, 2022 at 21:28 UTC | |
by jwkrahn (Abbot) on Feb 13, 2022 at 00:47 UTC | |
by wazoox (Prior) on Feb 14, 2022 at 15:43 UTC | |
| |
Re: A Word Game
by toolic (Bishop) on Feb 09, 2022 at 20:16 UTC | |
by choroba (Cardinal) on Feb 09, 2022 at 21:28 UTC | |
by LanX (Saint) on Feb 09, 2022 at 20:42 UTC | |
by jdporter (Paladin) on Feb 09, 2022 at 21:15 UTC | |
by LanX (Saint) on Feb 09, 2022 at 21:56 UTC | |
by hippo (Bishop) on Feb 10, 2022 at 10:29 UTC | |
| |
by GotToBTru (Prior) on Feb 10, 2022 at 19:50 UTC | |
| |
by kcott (Archbishop) on Feb 10, 2022 at 01:49 UTC | |
by eyepopslikeamosquito (Archbishop) on Feb 11, 2022 at 07:12 UTC | |
by erix (Prior) on Feb 11, 2022 at 07:26 UTC | |
by LanX (Saint) on Feb 11, 2022 at 08:44 UTC | |
| |
by jdporter (Paladin) on Feb 10, 2022 at 20:52 UTC | |
by kcott (Archbishop) on Feb 11, 2022 at 02:57 UTC | |
| |
by LanX (Saint) on Feb 10, 2022 at 21:47 UTC | |
| |
Re: A Word Game
by LanX (Saint) on Feb 09, 2022 at 11:29 UTC | |
Re: A Word Game (my solution)
by jdporter (Paladin) on Feb 15, 2022 at 14:41 UTC | |
Re: A Word Game (Updated)
by jdporter (Paladin) on Feb 11, 2022 at 14:25 UTC | |
by LanX (Saint) on Feb 11, 2022 at 17:35 UTC | |
by jdporter (Paladin) on Feb 14, 2022 at 12:25 UTC |
Back to
Cool Uses for Perl