$;='per';map{map{s/^\s+//;$_{$_}++ unless /[^a-z]/}split(/[\s,]+/,$_,0 ) if /alpha.*$;/i .. /wait/}`$;ldoc $;ltoc`;@[=keys%_;@print=('Just ', 'another ','Perl ','hacker',',');for('a'..'z'){$p.=$_.' ';};$g=5;$word =@[[rand(201)],@pop=split(//,$word);for(0..(@pop-1)){$pop[$_]='-'}$tmp =''; for ( 1..24 ){ system (($^O eq qq(\x4D\x53\x57\x69\x6E\x33\x32))? qq(\x63\x6c\x73):qq(\x63\x6c\x65\x61\x72)); print $/, @print, $/,$/; ; print&print(@print),$/,$/;print @pop,$/,$/;print $p,$/;(@print eq 0)?( die):();($tmp=~ m/$word/i)?(exit):();while(!($p=~ m/$g/gi)or($g eq' ') or($g eq '')){print"Enter a Letter:";chomp($g=<STDIN>);}$p=~ s/$g/-/gi ;pos($word)=0;while($word =~ m/$g/gi){($pop[(pos($word))-1]=$g)}($word =~ m#$g#gi)?():($devnul=pop(@print) );$g='';$tmp=join("",@pop); } END{ print"The correct function was $word!"}sub'print{my($a,$b,$c,$d,$f)= ( '|========'."$/".' \\\\// |'."$/".' || \O/'."$/".' || X'."$/" .' || / \\'."$/".' ||'."$/".'_/ \\','|========'."$/".''.""."".''. ' \\\\// |'."$/" .' || \\O/' ."$/" .' || X'."$/".' ||'."$/". ' ||'."$/".'_/ \\','|========'."$/".' \\\\// |' ."$/".' || O'. "$/".' || X'."$/".' ||'."$/".' ||'."$/" ."".''.'_/ \\','' ."" . '|========'."$/".' \\\\// |' ."$/".' || O'. "$/".' ||'."$/"."". ' ||'."$/".' ||'."$/".'_/ \\','|========'."$/".' \\\\// |' ."$/". ' ||'."$/".' ||' ."$/".' ||'."$/" .' ||'. "$/".'_/ \\');(@_ eq 4) ?(return $d):((@_ eq 3)?(return $c):((@_ eq 2)?(return$b):(((@_ eq 1)| (@_ eq 0))?(return$a):(return$f))));}$devnul='';#for($xp++){@game=@me}
The more clever bits are, of course, stolen from the Master

Replies are listed 'Best First'.
Re: Loading Times May Vary...
by diotalevi (Canon) on Jun 20, 2005 at 20:03 UTC

    Neat!

    The backticks were barely visible to me so I almost didn't get this. Here's your code, legible and with some small improvements.

    #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" ); }