File Coverage

blib/lib/Games/Wumpus.pm

Criterion	Covered	Total	%
statement	24	87	27.5
branch	0	12	0.0
condition			n/a
subroutine	8	19	42.1
pod	10	11	90.9
total	42	129	32.5

package Games::Wumpus;

use 5.010;
use strict;
use warnings;
no  warnings 'syntax';

our $VERSION = '2009112401';

use Hash::Util::FieldHash qw [fieldhash];

use Games::Wumpus::Constants;
use Games::Wumpus::Cave;
use Games::Wumpus::Room;

fieldhash my %cave;
fieldhash my %arrows;
fieldhash my %finished;

sub new  {bless \do {my $var} => shift}
sub init {
    my $self = shift;
    my %args = @_;

    $cave     {$self} = Games::Wumpus::Cave -> new -> init (%args);
    $arrows   {$self} = $NR_OF_ARROWS;

    $cave     {$self} -> set_location ($cave {$self} -> start);

    $self;
}

#
# Accessors
#
sub cave       {   $cave     {$_ [0]}}
sub arrows     {   $arrows   {$_ [0]}}
sub lose_arrow {-- $arrows   {$_ [0]}}
sub finished   {   $finished {$_ [0]}}
sub win        {   $finished {$_ [0]} = 1}
sub lose       {   $finished {$_ [0]} = 0}


#
# Describe the current situation
#
sub describe {
    my $self = shift;

    my $text = $self -> cave -> describe;
    $text .= "You have " . $self -> arrows . " arrows left.\n";

    $text;
}

#
# Try to move a different room. The argument is well formatted,
# but not necessarely valid.
#
sub move {
    my $self = shift;
    my $new  = shift;

    unless ($self -> cave -> can_move_to ($new)) {
        return (0, "There's no tunnel to $new.");
    }

    my @hazards = $self -> cave -> move ($new);

    my @messages;
    foreach (@hazards) {
        when ($WUMPUS) {
            $self -> lose;
            push @messages => "Oops! Bumped into a Wumpus!";
        }
        when ($PIT) {
            $self -> lose;
            push @messages => "YYYIIIIEEEE! Fell in a pit!";
        }
        when ($BAT) {
            push @messages => "ZAP! Super bat snatch! Elsewhereville for you!";
        }
    }
    return 1, @messages;

}


#
# Try to move a different room. The argument is well formatted,
# but not necessarely valid.
#
sub shoot {
    my $self  = shift;
    my @rooms = @_;

    if ($self -> arrows < 1) {
        #
        # This shouldn't be able to happen.
        #
        $self -> lose;
        return 0, "You are out of arrows";
    }

    unless ($self -> cave -> can_move_to ($rooms [0])) {
        return (0, "There's no tunnel to " . $rooms [0]);
    }

    for (my $i = 2; $i < @rooms; $i ++) {
        if ($rooms [$i] eq $rooms [$i - 2]) {
            return 0, "Arrows aren't that crooked - try another path";
        }
    }

    my $hit = $self -> cave -> shoot (@rooms);

    my @mess;
    given ($hit) {
        when ($WUMPUS) {
            $self -> win;
            return 1, "Ha! You got the Wumpus!";
        }
        when ($PLAYER) {
            $self -> lose;
            return 1, "Ouch! Arrow got you!";
        }
        default {
            push @mess => "Missed!";
        }
    }

    $self -> cave -> stir_wumpus;

    if ($self -> cave -> wumpus == $self -> cave -> location) {
        $self -> lose;
        return 1, @mess, "Tsk Tsk Tsk - Wumpus got you!";
    }

    if ($self -> lose_arrow < 1) {
        $self -> lose;
        return 1, @mess,
                 "You ran out of arrows. Wumpus will eventually eat you."
    }

    return 1, @mess;
}


1;

__END__