[Kc] FW: Perl Quiz-of-the-Week #17 (hangman)

Tue Aug 10 17:33:59 CDT 2004

At 08:00 AM 5/26/2004, you wrote:

>From: mjd at plover.com [<mailto:mjd at plover.com>mailto:mjd at plover.com] On 
>Behalf Of Marco Baringer
>Sent: Wednesday, May 26, 2004 6:48 AM
>To: perl-qotw at plover.com
>Subject: Perl Quiz-of-the-Week #17 [x-adr]
>
>IMPORTANT: Please do not post solutions, hints, or other spoilers
>         until at least 60 hours after the date of this message.
>         Thanks.
>
>
>The Game of Hangman
>--------------------

Has it been 60 hours yet?  ;)

I sat on this one for quite awhile until I decided to use it to help my 15 
year old expand his programming skills.  He's writing this in Dark Basic 
but I hacked it out in Perl.  I'm finished.  He's not.  :)

I'm sure my code isn't the most efficient way of doing this, but I was 
mostly focusing on making the code readable.  My son doesn't know Perl, but 
I hoped that my code would be easy enough to read that he could use it when 
he gets stuck in his Dark Basic coding.

I have attached both the script "hangman.pl" and a dictionary "words.zip" 
if you don't have your own dictionary.  Usage is explained by running the 
script without arguments.

Comments and suggestions are welcomed.  I've done a fair bit of Perl 
coding, but this is my first Perl game (possibly my last?).  Most of my 
coding experience is either web related or system administration related.

One thing I've noticed with my son is that he wants to sit down and write a 
graphical Real Time Strategy (RTS) game (ie- Age of the Empires) before 
doing any of the more simple and practical things first.  Unfortunately, he 
doesn't have the skills it would take to do a complex graphical game yet.

When I was his age, I had a TRS-80 and taught myself BASIC.  There weren't 
any slick RTS or 3D games for the thing.  The skill level required to write 
an amusing game on the TRS-80 or Apple IIe was much lower.  He's been 
working on this hangman game, but he's really not very interested in 
it.  He doesn't see the benefit of this text-based game as a building block 
toward bigger & better things in the future.  He thinks he wants to be a 
game developer, but with his unwillingness to learn the basics of 
programming (loops, data structures, etc. -- all the things that aren't 
much fun), I'm really not sure if he's cut out to be a programmer.  Anybody 
else have similar experiences?

-dougl

____________________________________________________________

Doug Ledbetter -- Hagen Software, Inc.
dougl at dougledbetter.org
My PGP Public Key: http://dougledbetter.org/public_key.html
-------------- next part --------------
#!/usr/bin/perl

# hangman.pl game by Doug Ledbetter - 08/10/2004
#
# dougl (at) dougledbetter.org
#
# This is the traditional game of hangman except that the computer does the hard work of selecting the random word.
#
# Known issues:
#		-  if you guess correct letters again, they don't count against you.  Maybe they should?

use strict;

# declare some variables
my $words_file;
my $max_tries;
my $tries_made = 0;	# keep track of the number of tries made
my @words;	# array to store the words
my $magic_word;	# the word they're trying to guess
my @word;	# array to store the individual characters in the magic word
my @correct;	# array to store their correct guesses
my $debug = 0;

if ($ARGV[0] ne "")
{
	$words_file = $ARGV[0];
}
else
{
	print "ERROR: You must provide a file with a listing of words for me to use!\nUsage: hangman.pl words.txt [max_tries]\n\n";
	exit;
}

if ($ARGV[1] ne "")
{
	$max_tries = $ARGV[1];
}
else
{
	# they didn't provide a maximum number of tries, I'll give them 5
	$max_tries = 5;
}

# initialize the random number seed
srand(time() ^ ($$ + ($$ << 15)));

# print a welcome message with instructions for playing
print "\n\nWelcome to Hangman!\n\nIn this game you are given $max_tries tries to guess the random word I have chosen for you.\nYou will see blanks below representing each letter of the random word.\nYour job is to figure out what word I have chosen by guessing letters.\n\n";

# read all the words into an array
open(my $words_fh, "<$words_file") or die "Cannot open the words file you provided ($words_file): $!\n";	# open the file for reading
while (my $line = <$words_fh>)
{
	chomp($line);	# remove the newline character
	$line = lc($line);	# lowercase the word
	if ( (length($line) > 1) && ($line !~ m/\W+/ig) )
	{

		push(@words,$line);	# store the word in the array if it's longer than 1 character and doesn't contain any non-word characters
	}

	#if ($debug) { print "$line\n"; }
}

# make sure we have some words
if (scalar(@words) < 1)
{
	die "ERROR:  Not enough valid words to work with!\n";
}

# choose a random word
$magic_word = $words[int(rand(scalar(@words)))];
if ($debug) { print "MAGIC WORD: $magic_word\n"; }

# load the magic word into the array one character at a time
for (my $x=0; $x < length($magic_word); $x++)
{
	$word[$x] = substr($magic_word,$x,1);
	$correct[$x] = "";
	if ($debug) { print "Loading array: $word[$x]\n"; }
}

# main guessing loop
while ($tries_made < $max_tries)
{
	if ($debug) { print "TRIES: $tries_made\n"; }

   # check for correct guesses and print underlines
   if ($debug) { print "LENGTH: $#correct\n"; }
   print "Word: ";
   for (my $x=0; $x <= $#correct; $x++)
   {
   	#print "$x: ";
   	if ($correct[$x] ne "")
   	{
   		print $correct[$x];
   	}
   	else
   	{
   		print " _ ";
   	}
   }
   print "\n\n";	# new line

   # Get input
   print "Make your guess ($tries_made/$max_tries wrong so far): ";
   my $guess = <STDIN>;
   chomp($guess);	# strip off the newline

   # check input for validity
   if ($guess =~ m/[A-Za-z]{1}/i)
   {
   	$guess = lc($guess);	# lower-case it
   }
   else
   {
   	print "ERROR: You entered invalid information.  I only accept a single letter (a-z).\n";
   	die;
   }

   print "\nYou guessed: $guess - ";

   # Check answer loop
   my $found_correct_flag = 0;
   for (my $x=0; $x <= $#word; $x++)
   {
   	#if ($debug) { print "EXAMINING($x): $word[$x] AGAINST $guess\n"; }
   	if ($word[$x] eq $guess)
   	{
   		if ($debug) { print "CORRECT: $guess\n"; }
   		$correct[$x] = $word[$x];
   		$found_correct_flag = 1;
   	}
   }

   if (!$found_correct_flag)
   {	
   	print "Wrong!\n\n";
   	$tries_made++;	# increment the number of bad guesses made
   }
   else
   {
   	print "Right!\n\n";
   }

   # Check for a winner
   my $winner_flag = 1;	# assume they won
   for (my $x=0; $x <= $#correct; $x++)
   {
   	if ($correct[$x] eq "")
   	{
   		$winner_flag = 0;	# aw, they haven't guessed this one
   	}
   }

   if ($winner_flag)
   {
   	print "You win!  The word was \"$magic_word\".  Good job!\n";
   	exit(0);
   }
}

print "You made too many guesses and the poor guy hangs!  You lose!  The word was \"$magic_word\"\n";
exit(0);
-------------- next part --------------
A non-text attachment was scrubbed...
Name: words.zip
Type: application/zip
Size: 82969 bytes
Desc: not available
Url : http://mail.pm.org/pipermail/kc/attachments/20040810/aa283742/words-0001.zip