cgi-dev

Repository that serves as my CGI "scratchpad" to try things out.
git clone git://git.samirparikh.com/cgi-dev
Log | Files | Refs | README

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 }