Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Hangman

by Lysander (Monk)
on Sep 13, 2002 at 18:49 UTC ( #197693=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info Lysander
Description: This script is a Perl rendition of the game "Hangman". You can play it it two modes: Single Player or Challenge. Challenge mode allows two people to play. The challenger enters in a word/phrase and a clue. The challengee then tries to guess it. Also, any phrases/words entered in challenge mode will be stored in a DBM file for use in Single Player mode. Enjoy.
I'm still very new with Perl, so any comments on style or how to make this script more "perlish" are welcome.
#!/usr/bin/perl -w

use strict;
use diagnostics;
use AnyDBM_File;
use Fcntl;

sub print_results;
sub create_wordbank;
sub enter_challenge;
sub lowercase;

my ($letter, @letters, $display, @display, $word, @word, $wrong_letter
+s, $clue, $mode, $continue, $guess, $correct_guess);

my $dbfile = "wordbank";
tie (my %wordbank, "AnyDBM_File", $dbfile, O_CREAT|O_RDWR, 0600) or di
+e "
+Can't open $dbfile: $!\n";
&create_wordbank unless keys %wordbank;

print "\nWelcome to Hangman!! Would you care to have a dance with deat
+h?\n";
print "\n1. Single Player";
print "\n2. Challenge Mode";
print "\n3. Quit\n";
print "\nYour choice: ";
$mode = <STDIN>;
chomp($mode);

if ($mode ne "1" and $mode ne "2") { exit; }
else { $continue = "y"; }

while ($continue eq "y") {

    my ($max_key, $random_number);    

    if ($mode eq "2" ) {
        &enter_challenge;
    }
    else {
        
        $max_key = (keys(%wordbank)/2);
        $random_number = (rand($max_key)%$max_key) + 1;
        
        $word = $wordbank{$random_number,1};
        $clue = $wordbank{$random_number,2};
    }

    $wrong_letters = 0;
    @letters = ();
    @word = split(//, $word);
    $display = $word;
    $display =~ s/[a-zA-Z]/-/g;
    @display = split(//, $display);
    $correct_guess = 0;

    &print_results;

    while ($wrong_letters < 6 and $correct_guess == 0) {
        
        my ($index, $correct_letter) = (0, 0);

        print "\nLetter, please.";
        print "\nLetter: ";
        $letter = <STDIN>;
        chomp($letter);
        
        $letter = lowercase($letter);

        if (join("", @letters) =~ $letter) {
            print "---------------------------------------------------
+-------";
            print "\nYou already guessed that letter.\n";
            print "---------------------------------------------------
+-------";
            next;
        }

        push(@letters, $letter);

        foreach (@word) {
            if ( lowercase($_) eq $letter ) { 
                $display[$index] = $_;
                $correct_letter = 1;
            }
            $index +=1;
        }

        $display = join("", @display);
        if ($display !~ m/-/) {
            &print_results;
            last; 
        }

        if ($correct_letter == 0) { 
            $wrong_letters += 1;
            print "\nYou guessed wrong! The noose is getting tighter.\
+n"
        }
        else { print "\nYou guessed right! Still, you can't escape the
+ inevitable.\n"; }
        &print_results;
    }
    
    print "\nGame over.\n";
    if ($wrong_letters != 6) {
        print "Congratulations. You slipped the hangman's noose.";
    }
    else {
        print "Sorry. Looks like the crows will be feasting today.";
    }
    print "\nWould you like to play again?\n";
    
    $continue = <STDIN>;
    chomp($continue);
}

untie %wordbank;

sub print_results {
    
    print "\n\n-------------------------------------------------------
+---";
    print "\nClue: $clue";
    print "\nWord: $display";

    print "\nGuess list: [".join(",", @letters)."]";
        
    print "\n\n";
        print "__________\n";
        print "          |\n";
        print "          |";
    
    print "\n";
    if ($wrong_letters > 0 && $wrong_letters < 6) { print "          "
+.chr(2).""; }
    elsif ($wrong_letters == 6) { print "          ".chr(233).""; };
    
    print "\n";
    if ($wrong_letters == 2) { print "          ".chr(30).""; }
    if ($wrong_letters == 3) { print "         /".chr(30).""; }
    if ($wrong_letters >= 4) { print "         /".chr(30)."\\"; }
    
    print "\n";
    if ($wrong_letters == 5) { print "         /"; }
    if ($wrong_letters == 6) { print "         / \\"; }
    
    print "\n";
        print "_______________\n";
        print "_______________";
        print "\n\n";

    print "----------------------------------------------------------"
+;

    if ($correct_guess != 1 and $wrong_letters < 6) {
            print "\n\nCare to wager a guess? Just hit 'Enter' if you 
+don't know.";
            print "\nGuess: ";
            $guess = <STDIN>;
            chomp($guess);
        print "\nGuess: $guess\n";
    }

    if (lowercase($guess) eq lowercase($word)) {
        $correct_guess = 1;
    }
    else { print "\nIncorrect guess. You'll soon be mine.\n"; }
}

sub create_wordbank {
    $wordbank{1,1} = "Larry Wall";
    $wordbank{1,2} = "Creator of Perl.";
    $wordbank{2,1} = "Camel";
    $wordbank{2,2} = "On the cover of 'Programming Perl'.";
}

sub enter_challenge {
    my $x;

    print "\n\n-------------------------------------------------------
+---";
    print "\nPlease enter a word or phrase:\n";
    $word = <STDIN>;
    chomp($word);
    print "\nPlease enter a clue.\n";
    $clue = <STDIN>;
    chomp($clue);
    print "\----------------------------------------------------------
+\n\n";

    $x = (keys(%wordbank)/2) + 1;
    $wordbank{$x,1} = $word;
    $wordbank{$x,2} = $clue;
}

sub lowercase {
    my $temp = $_[0];
    $temp =~ tr/[A-Z]/[a-z]/;
    return $temp;
}

Comment on Hangman
Download Code
Re: Hangman
by belg4mit (Prior) on Sep 13, 2002 at 19:04 UTC
    Instead of lowercase, if you are using a modern perl you can use the builtin lc. I might also simply have the user enter the number of players as a command line option, so you can forgo the menu. diagnostics generally doesn't belong in production code. And maybe try using the algorythm (sic) for selecting a line (in perlfaq5) from /usr/dict/words (or equivalent). The algorythm is fast, and saves from having a seperate database.

    UPDATE: I just realized you use clues. Hmm, never played hangman that way, in that case the words list might not be as helpful :-/

    --
    perl -pew "s/\b;([mnst])/'$1/g"

Re: Hangman
by lanval (Novice) on Apr 30, 2004 at 06:00 UTC
    Here is my silly little version. It has no clues and does no hangman ASCII art so it is more like "word guess" :P

    Gratuitous screen shot:
    >>>hangman<<<
    
     a  _  a  p  _  a  b  _  l  _  _  _
    
    Incorrect guesses left: 7
           Already guessed: a b l m p r
                Your guess:
    

    You can specify both the number of incorrect guesses allowed and the word file on the command line, or accept the defaults like so:
    ./hangman.pl
    ./hangman.pl 10
    ./hangman.pl 7 /usr/share/dict/dictionary
    

    This version also does not allow words that begin with a capital letter (because I was finding guessing the proper nouns from /usr/share/dict/words too hard!)

    #!/usr/bin/perl my (%g, $w, $s); my $s = shift || 9; my $file = shift || '/usr/share/dict/words'; die "Number of guesses must be greater than 0\n" if ($s <= 0); open(F, $file) || die "Can't open that dictionary file\n"; my $count = `wc -l < $file`; chomp($count); $count =~ s/[ \t]*//g; $count = int(rand() * $count) + 1; while ($count > 0 || $w =~ /^[A-Z]/) { $w = <F>; seek(F, 0, 0) if (! $w); $count--; } chomp($w); while ($s >= 0) { my $x = length($w); print "\f"; print ">>>hangman<<<\n\n"; for (0..length($w)-1) { if (exists($g{substr($w, $_, 1)})) { print " " . substr($w, $_, 1) . " "; $x--; } else { print " _ "; } } if (! $x) { print "\n\nCongratulations!!! ;)\n\n"; exit; } my @g = sort keys %g; print "\n\n"; print "Incorrect guesses left: $s\n"; print " Already guessed: @g\n"; GUESS: print " Your guess: "; my $g = <>; $g = lc(substr($g, 0, 1)); goto GUESS unless ($g =~ /[a-z]/); $s-- if ($w !~ /$g/ && ! exists $g{$g}); $g{$g} = 1; } print " The word was: \"$w\"\n\n";

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://197693]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2014-12-28 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (181 votes), past polls