Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
Clear questions and runnable code
get the best and fastest answer
 
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 perusing the Monastery: (10)
As of 2014-04-21 14:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (495 votes), past polls