Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

A word game

by jwkrahn (Abbot)
on Nov 06, 2022 at 01:15 UTC ( [id://11148001]=CUFP: print w/replies, xml ) Need Help??

A word game program, similar to "Wordle".

Now with Term::ReadKey

#!/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' beca +use: $!"; # 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", @l +etters ]; 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", @lett +ers ]; for my $letter ( @letters ) { $kb =~ s/$pre? $letter $post?/$white_on_gray $letter $rese +t/; } # 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 $res +et/; } my $curr_remains = join '', ( split //, $curr_word )[ grep !$f +ound[ $_ ], 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 $le +tter $reset"; $kb =~ s/$pre? $letter $post?/$white_on_yellow $letter + $reset/; } } ++$curr_line; @letters = (); } redo; }

Replies are listed 'Best First'.
Re: A word game
by Tux (Canon) on Nov 07, 2022 at 07:12 UTC

    ++'d if not only for your closing-brace indentation style!. Yes, this is the correct way!


    Enjoy, Have FUN! H.Merijn

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://11148001]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (5)
As of 2024-03-28 20:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found