#!/usr/local/bin/perl

# a graphical hangman game
# OK, no little man, just a count of wrong guesses :-) 

use Tk;

$user = "" unless $user = shift;

# create a toplevel window
$m = new MainWindow(-title,"Hangman");

# create 5 frames for the five rows of widgets

$mframe = $m->Frame();   # message frame
$gframe = $m->Frame();   # word/guess frame
$a1frame= $m->Frame();   # 1st row of letters
$a2frame= $m->Frame();   # 2nd row of letters
$bframe= $m->Frame();    # new game, cancel buttons, won/lost scores

# pack the frames
$mframe->pack(-side,'top');
$gframe->pack(-side,'top');
$a1frame->pack(-side,'top');
$a2frame->pack(-side,'top');
$bframe->pack(-side,'top');

# make two rows of buttons for the letters 
foreach $x ('a'..'m') {   # top row
	$b = $a1frame->Button(-text=>$x);
	$b->bind("<1>"=>\&doLetter);
	$b->pack(-side=>"left");
	push(@alpha,$b);
}
foreach $x ('n'..'z') {    # bottom row
	$b = $a2frame->Button(-text=>$x);
	$b->bind("<1>"=>\&doLetter);
	$b->pack(-side=>"left");
	push(@alpha,$b);
}

# make a button which starts a game
$b1 = $bframe->Button(-text=>"Start Game",-command=>\&startgame);
# make a button which exits the game
$b2 = $bframe->Button(-text=>"Quit",-command=>[$m,"destroy"]);
# make a label for # games won
$mwins = $bframe->Label(-text=>"Won: 0");
# make a label for # games lost
$mlosses = $bframe->Label(-text=>"Lost: 0");
# pack the buttons and lables
$mwins->pack(-side,'left');
$b1->pack(-side,'left');
$b2->pack(-side,'left');
$mlosses->pack(-side,'left');

# pack the message, which is "Good Luck!" or "Guessed ..." or "You (Win|Lose)!"
$x = ", $user" if $user;
$msg = $mframe->Label(-text=>"Good Luck$x!");
$msg->pack();

# seed the random number generator
srand();

$numwords = readwords();
$max = 5;   # max number of guesses
$wins = 0;
$losses = 0;

MainLoop;


sub doLetter {
	my $butt = shift;

	# get letter from button
	$let = $butt->cget(-text);

	# ignore letters already pressed	
	return if $seen{$let};

	# mark letter as seen...
	$seen{$let}++; 

	# ... and make it a different color
	$butt->configure(-fg=>"red",-activeforeground=>"red");

	my $oldfound = $found;
	foreach $i (0..@guessletters) {
		if ($wordletters[$i] eq $let) {
			$guessletters[$i]->configure(-text,$let);
			$found++;
		}
	}
	if ($found == $oldfound) {  # nothing new found
		$wrong++;
	}

	if ($wrong > $max) {
		$msg->configure(-text,"YOU LOSE!");
		$losses++;
		$mlosses->configure(-text,"Lost: $losses");
		foreach $i (0..@guessletters) {
			$let = $wordletters[$i];
			$guessletters[$i]->configure(-text,$let);
			$seen{$let}++;
		}
	}
	else {
		if ($found == $numletters) {
			$msg->configure(-text,"YOU WIN!");
			foreach $let (@guessletters) {
				$let->configure(-fg=>"navy",-activeforeground=>"navy");
			}
			$wins++;
			$mwins->configure(-text,"Won: $wins");
		}
		else {
			$msg->configure(-text,
				"Guessed: ".join("",sort keys(%seen))."  Wrong: $wrong");
		}
	}
}

sub startgame {
	$found = 0;
	$wrong = 0;
	%seen = ();
	$msg->configure(-text,"Good Luck$x!");
	$w = $words[rand($numwords)];
#	print "word is $w\n";   # debugging statement (uncomment to cheat ;) )
	foreach $b (@guessletters) {
		$b->destroy();
	}
	foreach $b (@alpha) {
		$b->configure(-fg=>"black",-activeforeground=>"black");
	}
	@guessletters = ();
	@wordletters = ();
	foreach $let (split(//,$w)) {
		$b = $gframe->Button();
		$b->pack(-side,'left');
		push(@guessletters,$b);
		push(@wordletters,$let);
	}
	$numletters = @wordletters;
}

sub readwords {
	my $wf;
@word_loc = ("words.txt","c:/words.txt","/usr/local/lib/words.txt",
	"C:/lib/words.txt","C:/local/lib/words.txt");
	foreach $x (@word_loc) {
		if (-e $x) {
			$wf = $x;  # use first one found
			last;
		}
	}
	die "No word file\n" unless $wf;
	open(W,$wf) or die("Unable to open $wf: $!\n");
	@words = <W>;
	close(W);
	chomp(@words);
	return(@words + 0);
}