File Coverage

blib/lib/Game/Cribbage/Hands.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.0

package Game::Cribbage::Hands;

use strict;
use warnings;

use Rope;
use Rope::Autoload;
use Game::Cribbage::Player::Hand;
use Game::Cribbage::Play;
use Game::Cribbage::Error;

property number => (
	initable => 1,
	writeable => 0,
	configurable => 0,
	enumerable => 1
);

property [qw/starter play crib_player crib_complete player1 player2 player3 player4/] => (
	initable => 1,
	writeable => 1,
	configurable => 0,
	enumerable => 1,
);

property cannot_play => (
	initable => 1,
	writeable => 1,
	configurable => 0,
	enumerable => 1,
	value => {}
);

property play_history => (
	initable => 1,
	writeable => 1,
	configurable => 0,
	enumerable => 1,
	value => []
);

function INITIALISED => sub {
	my ($self, $options) = @_;
	$self->crib_player = 'player1' if (!$options->{crib_player});
	for (@{$options->{_game}->players}) {
		my $player = $_->player;
		$self->$player = Game::Cribbage::Player::Hand->new(
			player => $player
		);
	}
	$self->new_play();
	$self;
};

function add_starter_card => sub {
	my ($self, $player, $card) = @_;
	$self->starter = $card;

	my $scored = 0;
	if ($card->symbol =~ m/^J$/) {
		$scored = Game::Cribbage::Play::Score->new(
			player => $player,
			card => $card,
			flipped => 1
		);
		push @{$self->play->scored}, $scored;
	}

	for (qw/player1 player2 player3 player4/) {
		if ($self->$_) {
			$self->$_->starter = $card;
		}
	}

	return $scored;
};

function find_player_card => sub {
	my ($self, $card) = @_;
	my $player;
	for my $p (qw/player1 player2 player3 player4/) {
		if ($self->$p) {
			for (@{$self->$p->cards}) {
				if ($_->match($card)) {
					$card = $_;
					$player = $p;
					last;
				}
			}
		}
	}
	return ($card, $player);
};

function force_play_card => sub {
	my ($self, $card) = @_;
	my $player;
	($card, $player) = $self->find_player_card($card);
	$card->used = 1;
	my $scored = $self->play->force_card($player, $card);
	$self->set_next_to_play();
	return ($scored, $player);
};

function play_card => sub {
	my ($self, $player, $card_index) = @_;
	my $hand = ref $player ? $player->player : $player;
	if ($self->play->next_to_play ne $hand) {
		return Game::Cribbage::Error->new( message => 'It is not the turn of ' . $hand );
	}
	my $card = ref $card_index ? $card_index : $self->$hand->get($card_index);
	if (!$card || $card->used) {
		die 'CARD HAS ALREADY BEEN PLAYED IN THIS ROUND';
	}

	my $total = $self->play->total;
	if ($card->value + $total > 31) {
		return Game::Cribbage::Error->new( over => 1, message => 'Playing this card will make the score greater than 31');
	}
	$card->used = 1;
	my $scored = $self->play->card($player, $card);
	$self->set_next_to_play();
	return $scored;
};

function cannot_play_a_card => sub {
	my ($self, $player) = @_;

	my $hand = ref $player ? $player->player : $player;
	if ($self->play->next_to_play ne $hand) {
		return Game::Cribbage::Error->new( message => 'It is not the turn of ' . $hand );
	}

	my $current_total = $self->play->total;

	my @can_be_played;
	for (@{$self->$hand->cards}) {
		next if $_->used;
		if ( $current_total + $_->value < 31 ) {
			push @can_be_played, $_;
		}
	}

	return \@can_be_played if scalar @can_be_played;

	$self->set_next_to_play();

	$self->cannot_play->{$hand} = 1;

	return 1;
};

function set_next_to_play => sub {
	my ($self) = @_;
	my $next = $self->parse_next_to_play($self->play->next_to_play);
	$self->play->next_to_play = $next;
};

function parse_next_to_play => sub {
	my ($self, $player_string) = @_;
	$player_string =~ m/player(\d)/;
	my $index = $1;
	$index++;
	my $next = 'player' . $index;
	if ($self->$next) {
		return $next;
	} else {
		return 'player1';
	}
};

function set_player_hand_id => sub {
	my ($self, $player, $id) = @_;
	my $hand = ref $player ? $player->player : $player;
	$self->$hand->id = $id;
	return $id;
};

function get_player_hand_id => sub {
	my ($self, $player) = @_;
	my $hand = ref $player ? $player->player : $player;
	return $self->$hand->id;
};

function get_crib_player_hand_id => sub {
	my ($self) = @_;
	my $hand = $self->crib_player;
	return $self->$hand->id;
};

function get_card => sub {
	my ($self, $player, $card_index) = @_;
	my $hand = ref $player ? $player->player : $player;
	my $card = $self->$hand->get($card_index);
	return $card;
};

function play_score => sub {
	my ($self) = @_;
	return $self->play->total || 0;
};

function last_play_score => sub {
	my ($self) = @_;
	return $self->play_history->[-2]->total || 'This is the first play';
};

function new_play => sub {
	my ($self) = @_;
	my $next_to_play = $self->crib_player;
	if ($self->play) {
		$next_to_play = $self->parse_next_to_play(ref $self->play->cards->[-1]->player ? $self->play->cards->[-1]->player->player : $self->play->cards->[-1]->player);
	}
	$self->play = Game::Cribbage::Play->new(
		next_to_play => $next_to_play
	);
	push @{$self->play_history}, $self->play;
};

function next_play => sub {
	my ($self, $game) = @_;

	# first check whether any players can play on the current 'play'
	# if they can they must use those cards first.
	my $current_total = $self->play->total;

	my $available_cards = 0;
	for my $hand (qw/player1 player2 player3 player4/) {
		if ($self->$hand) {
			my @can_be_played;
			for (@{$self->$hand->cards}) {
				next if $_->used;
				$available_cards = 1;
				if ( $current_total + $_->value < 31 ) {
					push @can_be_played, $_;
				}
			}
			if (scalar @can_be_played) {
				return Game::Cribbage::Error->new(
					message => 'Cards can be played',
					player => $hand,
					cards => \@can_be_played
				);
			}
		}
	}

	$self->cannot_play = {};
	# now we know cards can't be played confirm we have cards left to Play another 'play'.
	return $game->end_hands() if !$available_cards;
	my $scored;

	if (!$self->play->scored->[-1] || !$self->play->scored->[-1]->go) {
		$scored = $self->play->end_play();
	}

	$self->new_play();

	return $scored;
};

function end_play => sub {
	my ($self) = @_;

	my $scored;

	if (!$self->play->scored->[-1] || !$self->play->scored->[-1]->go) {
		$scored = $self->play->end_play();
	}

	$self->play = undef;

	return $scored;
};

function score_hands => sub {
	my ($self) = @_;
	my %scored;
	for (qw/player1 player2 player3 player4/) {
		$scored{$_} = $self->$_->calculate_score()
			if ($self->$_);
	}
	return \%scored;
};

function card_exists => sub {
	my ($self, $player, $card) = @_;
	$player = ref $player ? $player->player : $player;
	return $self->$player->card_exists($card);
};

function set_crib_complete => sub {
	my ($self) = @_;
	$self->crib_complete = 1;
};

function best_run_play => sub {
	my ($self, $player) = @_;
	$player = ref $player ? $player->player : $player;
	return $self->$player->best_run_play($self->play);
};

function next_to_play_id => sub {
	my ($self, $game) = @_;
	my $hand = $self->play->next_to_play;
	return $hand;
};

1;