#for($xp++){@game=@me}

# Get a list of perl functions matching /^[a-z]+$/. $; is a special
# variable but is never used that way. The list will be contained in
# the @[ array.
$per='per';map{map{s/^\s+//;$_{$_}++ unless /[^a-z]/}split(/[\s,]+/,$_,0
) if /alpha.*$per/i .. /wait/}`${per}ldoc ${per}ltoc`;@words=keys%_;

@print=('Just ','another ','Perl ','hacker',',');

# $p = "a b c d ... z ";
for('a'..'z'){$p.=$_.' ';}

$g = 5;

# Pick a random word. It happens to be from the first part of the list
# of words but that list is random anyway.
$word = @words[ rand 201 ];

# @pop will hold a series of placeholders for letters in the word.
@pop = ( '-' ) x length $word;

$tmp = '';

# 24 guesses.
while ( 1 ) {
    clear();
    
    print( "\n", @print, "\n\n",
	   text_image( scalar @print ), "\n\n",
	   @pop, "\n\n",
	   "$p\n" );
    
    if ( not @print ) {
        # Out of chances!
        die;
    }
    elsif ( join( '', @pop ) =~ /$word/i ) {
        # Got it!
        exit;
    }
    
    # Prompt for a letter that hasn't been guessed and is valid, etc.
    do {
	print "Enter a Letter:";
	chomp( $g = <STDIN> );
    } until ( $p =~ /$g/i
	      and $g =~ /^[a-z]$/i );
    
    # Remove that letter from the list of available characters.
    $p =~ s/$g/-/i;
    
    # Copy the found characters into @pop. I improved this slightly to
    # use $word so the case is preserved.
    pos( $word ) = 0;
    my $matched;
    while ( $word =~ /$g/gi ) {
	$matched = 1;
        $pop[ $-[0] ] = substr $word, $-[0], 1;
    }
    
    # If there were no matches, lose a limb or something.
    if ( not $matched ) {
        pop @print;
    }

}

END {
    print"The correct function was $word!\n"
}

sub text_image {

    my $a = <<'HANGMAN_0';
|========
 \\//   |
  ||   \O/
  ||    X
  ||   / \
  ||
_/  \
HANGMAN_0

    my $b = <<'HANGMAN_1';
|========
 \\//   |
  ||   \O/
  ||    X
  ||
  ||
_/  \
HANGMAN_1

    my $c = <<'HANGMAN_2';
|========
 \\//   |
  ||    O
  ||    X
  ||
  ||
_/  \
HANGMAN_2

    my $d = <<'HANGMAN_3';
|========
 \\//   |
  ||    O
  ||
  ||
  ||
_/  \
HANGMAN_3

    my $f = <<'HANGMAN_4';
|========
 \\//   |
  ||
  ||
  ||
  ||
_/  \
HANGMAN_4

    my $num_ok = shift;
    return( 0 == $num_ok ? $a :
            1 == $num_ok ? $b :
            2 == $num_ok ? $c :
            3 == $num_ok ? $d :
                           $f );
}

sub clear {
    system( $^O eq "MSWin32"
            ? "cls"
            : "clear" );
}