hangman1.cgi (5558B) - raw
1 #!/usr/bin/perl 2 3 # file: hangman1.cgi 4 # hangman game using hidden fields to maintain state 5 6 use IO::File(); 7 use CGI qw( :standard ); 8 use warnings; 9 use strict; 10 11 use constant WORDS => '/usr/share/dict/hangman_words'; 12 use constant TRIES => 6; 13 14 # retrieve the state 15 my $state = get_state(); # $state is a hash reference 16 17 # reinitialize if we need to 18 $state = initialize($state) if !$state or param('restart'); 19 20 # process the current guess, if any 21 my ($message, $status) = process_guess(param('guess') || '', $state); 22 23 # generate the HTML page 24 print header(-charset => 'utf-8'), 25 start_html( -Title => 'Hangman 1', 26 -bgcolor => 'white', 27 -onLoad => 'if (document.gf) document.gf.guess.focus()'), 28 h1( 'Hangman 1 Interactive Game' ); 29 30 # draw the statistics 31 status( $message, $state ); 32 33 # prompt the user to restart or to enter the next guess 34 if ( $status =~ /^(won|lost)$/ ) { 35 show_restart_form($state); 36 } else { 37 show_guess_form($state); 38 } 39 print hr, 40 a( {-href => '/'}, "Home"), 41 p( cite( {-style => "fontsize: 10pt"}, 42 'graphics courtesy of Andy Wardley')), 43 end_html(); 44 45 # This is called to initialize a whole new state object 46 # or to create a new game. 47 sub initialize { 48 my $state = shift; 49 $state = {} unless $state; 50 $state->{WORD} = pick_random_word(); 51 $state->{GUESSES_LEFT} = TRIES; 52 $state->{GUESSED} = ''; # empty hash reference 53 $state->{GAMENO} += 1; 54 $state->{WON} += 0; 55 $state->{TOTAL} += 0; 56 return $state; 57 } 58 59 sub save_state { 60 my $state = shift; 61 foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) { 62 print hidden( 63 -name => $_, -value=> $state->{$_}, -override => 1 64 ); 65 } 66 } 67 68 sub get_state { 69 return undef unless param(); 70 my $state = {}; 71 foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) { 72 $state->{$_} = param($_); 73 } 74 return $state; 75 } 76 77 sub show_guess_form { 78 my $state = shift; 79 print start_form(-name => 'gf'), 80 "Your guess: ", 81 textfield(-name => 'guess', -value => '', -override => 1), 82 submit(-value => 'Guess'); 83 save_state($state); 84 print end_form; 85 } 86 87 sub show_restart_form { 88 my $state = shift; 89 print start_form, 90 "Do you want to play again?", 91 submit(-name => 'restart', -value => 'Another game'); 92 #delete $state->{WORD}; 93 save_state($state); 94 print end_form; 95 } 96 97 sub process_guess { # returns message and status 98 my ( $guess, $state ) = @_; 99 100 # lose immediately if user has no more guesses left 101 #return ('', 'lost') unless $state->{GUESSES_LEFT} > 0; 102 #return ('', 'lost') unless $state->{GUESSES_LEFT}; 103 104 my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g; 105 my %letters = map { $_ => 1 } $state->{WORD} =~ /(.)/g; 106 107 # return immediately if user has already guessed the word 108 return ('', 'won') unless grep(!$guessed{$_}, keys %letters); 109 110 # do nothing more if no guess 111 return ('', 'continue') unless $guess; 112 113 # this section processes individual letter guesses 114 $guess = lc $guess; 115 return ("Not a valid letter or word", 'error') 116 unless $guess =~ /^[a-z]+$/; 117 return ("You already guessed that letter", 'error') 118 if $guessed{$guess}; 119 120 # this section is called when the user guesses the whole word 121 if (length($guess) > 1 and $guess ne $state->{WORD}) { 122 $state->{TOTAL} += $state->{GUESSES_LEFT}; 123 return (qq(You lose. The word was "$state->{WORD}".), 'lost'); 124 } 125 126 # update the list of guesses 127 $guessed{$_}++ foreach ($guess =~ /(.)/g); 128 $state->{GUESSED} = join '', sort keys %guessed; 129 130 # correct guess -- word completely filled in 131 unless (grep(!$guessed{$_}, keys %letters)) { 132 $state->{WON}++; 133 return (qq(You won! The word was "$state->{WORD}".), 'won'); 134 } 135 136 # incorrect guess 137 if (!$letters{$guess}) { 138 $state->{TOTAL}++; 139 $state->{GUESSES_LEFT}--; 140 # user out of turns 141 return (qq(Sorry, you're out of turns. The word was "$state->{WORD}".), 142 'lost') if $state->{GUESSES_LEFT} <= 0; 143 # user still has some turns 144 return ("Wrong guess", 'continue'); 145 } 146 147 # correct guess but word still incomplete 148 return ("Good guess.", 'continue'); 149 } 150 151 sub status { 152 my ( $message, $state ) = @_; 153 154 # print the word with underscores replacing unguessed letters 155 print table( { -width => '50%' }, 156 TR( 157 td(b('Word #:'), $state->{GAMENO}), 158 td(b('Guessed:'), $state->{GUESSED}) 159 ), 160 TR( 161 td(b('Won:'), $state->{WON}), 162 td(b('Current average:'), 163 sprintf("%2.3f", $state->{TOTAL}/$state->{GAMENO})), 164 td(b('Overall average:'), 165 $state->{GAMENO} > 1 ? 166 sprintf("%2.3f", 167 ($state->{TOTAL}-(TRIES-$state->{GUESSES_LEFT}))/ 168 ($state->{GAMENO}-1)) 169 : '0.000') 170 ) 171 ); 172 173 my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g; 174 print h2("Word:", 175 map {$guessed{$_} ? $_ : '_'} $state->{WORD} =~ /(.)/g); 176 print h2(font({-color => 'red'}, $message)) if $message; 177 } 178 179 # pick a word, any word 180 sub pick_random_word { 181 my $list = IO::File->new(WORDS) 182 || die "Couldn't open ${\WORDS}: $!\n"; 183 my $word; 184 rand($.) < 1 && ($word = $_) while <$list>; 185 chomp $word; 186 $word; 187 }