File Coverage

blib/lib/Games/Roshambo.pm

Criterion	Covered	Total	%
statement	6	49	12.2
branch	0	30	0.0
condition	0	24	0.0
subroutine	2	8	25.0
pod	3	6	50.0
total	11	117	9.4

##############################################################################
# Games::Roshambo - Object Oriented Rock/Paper/Scissors
# v1.01
# Copyright (c) 2008 Chris Thompson
##############################################################################
package Games::Roshambo;
$VERSION ="1.01";
use strict;
use Games::Roshambo::Thrownames;

sub new {
    my $class = shift;
    my %conf = @_;

    $conf{numthrows} = 3 unless defined $conf{numthrows};
    $conf{sortable} = 0 unless defined $conf{sortable};

    if (! ($conf{numthrows} % 2)) {
		warn "Cannot use an even number of throws: " . $conf{numthrows};
		return undef;
	}


    $conf{thrownames} = Games::Roshambo::Thrownames::getnames($conf{numthrows});
    return bless {%conf}, $class;
}

sub gen_throw {
	my $self = shift;
	return int(rand($self->{numthrows})) + 1;
}

sub judge {
	my $self = shift;

       #######################################################################
       ### MADNESS!
       ### throws are passed to this function as $x->judge($player1, $player2)
       ### but I'm reversing them when I grab them here. Why? well, this whole
       ### set of logic was based on a "Higher Throw Wins" set of math. Since
       ### I'm crazy enough to want this to play RPS-101 with throw names,
       ### and since I didn't realize that the whole RPS-101 is based on "Lower
       ### Throw Wins", I was resigned to rewriting the logic itself.
       ### Chris Prather helped me realize, however, that simply swapping the
       ### values was the same thing. This is why he gets to work at a cool
       ###  job doing cool perl things, while I have to edit badly formed HTML.
       ########################################################################

	my $player2 = shift || $self->gen_throw;
	my $player1 = shift || $self->gen_throw;

	$player1 = $self->name_to_num($player1) unless ($player1 !~ m/\D+/);
	$player2 = $self->name_to_num($player2) unless ($player2 !~ m/\D+/);

	return undef unless ($player1 && $player2);

	my $numthrows = $self->{numthrows};
        my $winrange = ($numthrows - 1) / 2;

	return 0 if ($player1 == $player2);

	my $onewins = $self->{sortable} ? -1 : 1;
	my $twowins = $self->{sortable} ? 1 : 2;

    return $onewins if (($player1 >= $winrange) &&
				 (($player1 > $player2) && ($player1 - $winrange <= $player2))
				);

	return $onewins if (($player1 <= $winrange) &&
				 (($player1 > $player2) || ($numthrows - ($winrange - $player1) <= $player2))
				);

	return $twowins;

}

sub num_to_name {
	my $self = shift;
	my $thrownum = shift;

	return $self->{thrownames}->{_names}->[$thrownum];

}

sub name_to_num {
	my $self = shift;
	my $throwname = uc(shift);

	my $thrownum = $self->{thrownames}->{$throwname};
	warn "Invalid Throw Name $throwname, returning undef" unless defined $thrownum;
        return $thrownum;
}

sub getaction {
	my $self = shift;
	my $a = shift;
	my $b = shift;

        if ($a =~ m/\D/) {
	   $a = $self->name_to_num($a);
	}

        if ($b =~ m/\D/) {
	   $b = $self->name_to_num($a);
	}

        return "ties" if $a == $b;

	my $ret = $self->{thrownames}->{_actions}->{$a}->{$b} ||
	       $self->{thrownames}->{_actions}->{$b}->{$a};

	return $ret;
}


1;
__END__