#!/usr/bin/perl

# file: hangman2.cgi
# hangman game using simple cookie maintain state

use IO::File();
use CGI qw( :standard );
use CGI::Cookie ();
use warnings;
use strict;

use constant WORDS => '/usr/share/dict/hangman_words';
use constant TRIES => 6;
use constant COOKIE_NAME => 'Hangman';

# retrieve the state
#my $state = get_state(); # $state is a hash reference
my $state = get_state() unless param('clear');

# reinitialize if we need to
$state    = initialize($state) if !$state or param('restart');

# process the current guess, if any
my ($message, $status) = process_guess(param('guess') || '', $state);

# generate the HTML page
print   header(-charset    => 'utf-8',
               -cookie => save_state($state)
              ),
        start_html( -Title   => 'Hangman 1',
                    -bgcolor => 'white',
                    -onLoad  => 'if (document.gf) document.gf.guess.focus()'),
        h1( 'Hangman 1 Interactive Game' );

# draw the statistics
status( $message, $state );

# prompt the user to restart or to enter the next guess
if ( $status =~ /^(won|lost)$/ ) {
    show_restart_form($state);
} else {
    show_guess_form($state);
}
print   hr,
        a( {-href => '/'}, "Home"),
        p( cite( {-style => "fontsize: 10pt"},
                 'graphics courtesy of Andy Wardley')),
        end_html();

# This is called to initialize a whole new state object
# or to create a new game.
sub initialize {
    my $state = shift;
    $state = {} unless $state;
    $state->{WORD}              = pick_random_word();
    $state->{GUESSES_LEFT}      = TRIES;
    $state->{GUESSED}           = ''; # empty hash reference
    $state->{GAMENO}            += 1;
    $state->{WON}               += 0;
    $state->{TOTAL}             += 0;
    return $state;
}

#sub save_state {
#    my $state = shift;
#    foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) {
#        print hidden(
#                -name => $_, -value=> $state->{$_}, -override => 1
#        );
#    }
#}

sub save_state {
    my $state = shift;
    return CGI::Cookie->new (
        -name   => COOKIE_NAME,
        -value  => $state,
        -expires => '+1M'
    );
}

#sub get_state {
#    return undef unless param();
#    my $state = {};
#    foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) {
#        $state->{$_} = param($_);
#    }
#    return $state;
#}

sub get_state {
    my %cookie = cookie( COOKIE_NAME );
    return undef unless %cookie;
    return \%cookie;
}

sub show_guess_form {
   my $state = shift;
   print start_form(-name => 'gf'),
         "Your guess: ",
         textfield(-name => 'guess', -value => '', -override => 1),
         submit(-value => 'Guess');
   #save_state($state);
   print end_form;
}

sub show_restart_form {
   my $state = shift;
   print start_form,
         "Do you want to play again?",
         submit(-name => 'restart',
                -value => 'Another game'),
         checkbox(-name => 'clear', -label => 'Clear history');
   delete $state->{WORD};
   #save_state($state);
   print end_form;
}

sub process_guess { # returns message and status
    my ( $guess, $state ) = @_;

    # lose immediately if user has no more guesses left
    #return ('', 'lost') unless $state->{GUESSES_LEFT} > 0;
    #return ('', 'lost') unless $state->{GUESSES_LEFT};

    my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g;
    my %letters = map { $_ => 1 } $state->{WORD}    =~ /(.)/g;

    # return immediately  if user has already guessed the word
    return ('', 'won') unless grep(!$guessed{$_}, keys %letters);

    # do nothing more if no guess
    return ('', 'continue') unless $guess;

    # this section processes individual letter guesses
    $guess = lc $guess;
    return ("Not a valid letter or word", 'error')
        unless $guess =~ /^[a-z]+$/;
    return ("You already guessed that letter", 'error')
        if $guessed{$guess};

    # this section is called when the user guesses the whole word
    if (length($guess) > 1 and $guess ne $state->{WORD}) {
        $state->{TOTAL} += $state->{GUESSES_LEFT};
        return (qq(You lose. The word was "$state->{WORD}".), 'lost');
    }

    # update the list of guesses
    $guessed{$_}++ foreach ($guess =~ /(.)/g);
    $state->{GUESSED} = join '', sort keys %guessed;

    # correct guess -- word completely filled in
    unless (grep(!$guessed{$_}, keys %letters)) {
        $state->{WON}++;
        return (qq(You won! The word was "$state->{WORD}".), 'won');
    }

    # incorrect guess
    if (!$letters{$guess}) {
        $state->{TOTAL}++;
        $state->{GUESSES_LEFT}--;
        # user out of turns
        return (qq(Sorry, you're out of turns. The word was "$state->{WORD}".),
            'lost') if $state->{GUESSES_LEFT} <= 0;
        # user still has some turns
        return ("Wrong guess", 'continue');
    }

    # correct guess but word still incomplete
    return ("Good guess.", 'continue');
}

sub status {
    my ( $message, $state ) = @_;

    # print the word with underscores replacing unguessed letters
    print table( { -width => '50%' },
        TR(
            td(b('Word #:'), $state->{GAMENO}),
            td(b('Guessed:'), $state->{GUESSED})
          ),
        TR(
            td(b('Won:'), $state->{WON}),
            td(b('Current average:'),
                sprintf("%2.3f", $state->{TOTAL}/$state->{GAMENO})),
            td(b('Overall average:'),
                $state->{GAMENO} > 1 ?
                    sprintf("%2.3f",
                        ($state->{TOTAL}-(TRIES-$state->{GUESSES_LEFT}))/
                            ($state->{GAMENO}-1))
                    : '0.000')
           )
    );

    my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g;
    print h2("Word:",
        map {$guessed{$_} ? $_ : '_'} $state->{WORD} =~ /(.)/g);
    print h2(font({-color => 'red'}, $message)) if $message;
}

# pick a word, any word
sub pick_random_word {
   my $list = IO::File->new(WORDS)
      || die "Couldn't open ${\WORDS}: $!\n";
   my $word;
   rand($.) < 1 && ($word = $_) while <$list>;
   chomp $word;
   $word;
}