Hangman in Perl 5: a simple example

Inspired by an article on blogs.perl.org I decided to write down a small version of the hangman game using Perl 5.

It was interesting and quite nice.

Here it is my version, with an eye on italian words (wovels marked as '+' on the guessing line), find it only on GitHub.

#!/usr/bin/env perl

use v5.10;
use Term::ReadKey;

my $word;

# search for a word
open my $word_fh, '<', '/usr/share/dict/words' || die "\nCannot read words!\n$!\n";
srand;
rand( $. ) < 1 && ( $word = lc( ( split( /[\s']/, $_ ) )[ 0 ] ) ) while( <$word_fh> );
close $word_fh;

# wovels converted to +
my ( %guess_status ) = map { $_  , ( /[aeiouèéòà ùì]/ ? '+' : '_' ) } ( split // , $word );
my $current_guessing = '';
my $max_trials       = 10;
my @wrong_chars      = ();

ReadMode 3; # allow for signals

# while there are undiscovered chars or other trials to do, go for it!
while( grep( /[+_]/,  values %guess_status ) &&  $max_trials > 0 ){

    # build the guessing line
    $current_guessing = join ' ' , map { $guess_status{ $_ } } ( split // , $word );

    say "\n\n|| $current_guessing ||\t" . join( ',', @wrong_chars );
    say "guess a char: ";
    my $current_char = lc ReadKey( 0 );


    if ( ! $guess_status{ $current_char } ){
        # not guessed
        $max_trials--;
        push @wrong_chars, $current_char;
        say "No [$current_char] in the word, you still have $max_trials trials.";
    }
    else{
        say "You guessed right [$current_char]!";
        $guess_status{ $current_char } = $current_char;
    }



}

say "You guessed [$word] !\n" if ( $max_trials > 0 );
say "Sorry, the word you were looking for was [$word]\n" if ( ! $max_trials );


ReadMode 0;

First of all, I read in a random word from a words file, using a quite well know "read-radom-line" approach (at least it is well documented in the Perl community, see ). Since the dictionary could contain multiple words per line, I cut them taking only the first one of them and excluding also shortings, and of course making the whole result lower case for ease of comparison. In other words something like "Bud's" become simply "bud", something like "Smooth words" become simply "smooth" and so on.

The selected word is split into its chars and each char is mapped either to a '+' or a '_'. The result is placed into an hash indexed by the plain char itself, so that the word 'hello' results in an hash as follows:

%guess_status = {
  h => '_',
  e => '+',
  l => '_',
  l => '_',
  o => '+',
}

(of course the hash is not sorted on the keys, and that does not matter).

Now the main loop: unless no more '+' or '_' are present in the hash, meaning that the user has guessed all occuriences of all chars, the user is prompted with the guessing line and asked for a char. I use Term::ReadKey for getting a single char, that is of course lowered and compared against the hash keys. If the current char is a key for the hash, the character is discovered and the guessing line re-prompted with the right character in the right place(s), otherwise the character is appended to an array of missed chars and the loop continues.

Each time the user inputs a wrong char a counter is decreased to allow the game to stop in a fixed number of missed trials.

There is of course a lot of room for improvements: for instance the guessing line does not need to be updated each time, but only when the user guesses a char. Therefore a little different version of the main loop becomes as follows:

$current_guessing = join ' ' , map { $guess_status{ $_ } } ( split // , $word );
while( $current_guessing =~ /[+_]/ &&  $max_trials > 0 ){


    say "\n\n|| $current_guessing ||\t" . join( ',', @wrong_chars );
    say "guess a char: ";
    my $current_char = lc ReadKey( 0 );


    if ( ! $guess_status{ $current_char } ){
        # not guessed
        $max_trials--;
        push @wrong_chars, $current_char;
        say "No [$current_char] in the word, you still have $max_trials trials.";
    }
    else{
        say "You guessed right [$current_char]!";
        $guess_status{ $current_char } = $current_char;
        # build the guessing line
        $current_guessing = join ' ' , map { $guess_status{ $_ } } ( split // , $word );
    }
}

where the guessing line is updated only when a good character is inserted. Having the guessing line built before the main loop allows me for searching directly for undiscovered chars in the line itself, instead of among the values of the hash (so avoiding a grep() applied to a values() ).

And in the case you are wondering why I don't compare the guessin line against the word to guess in the while condition, well, it is because I like to print the guessing line with spaces between letters to be guessed.

Hope it can be useful as simple base Perl program for someone!