File Coverage

blib/lib/Game/Cribbage/Round.pm

Criterion	Covered	Total	%
statement	146	167	87.4
branch	21	40	52.5
condition	8	15	53.3
subroutine	31	34	91.1
pod	0	29	0.0
total	206	285	72.2

package Game::Cribbage::Round;

use strict;
use warnings;

use Object::Proto::Sugar -types;

use Game::Cribbage::Round::Score;
use Game::Cribbage::Hands;

has id => (
	is => 'rw',
	isa => Int
);

has number => (
	is => 'ro',
	isa => Int
);

has [qw/score current_hands/] => (
	is => 'rw',
	isa => Object
);

has complete => (
	is => 'rw',
	isa => Bool,
	default => 0
);

has history => (
	is => 'rw',
	isa => ArrayRef,
	default => []
);

sub init {
	my ($self, $game) = @_;
	my %score = ();
	for (@{$game->players}) {
		$score{$_->player} = {
			current =>  0,
			last => 0
		};
	}
	$self->score(Game::Cribbage::Round::Score->new(%score));
	$self->next_hands($game);
}

sub reset_hands {
	my ($self, $game) = @_;
	$self->history([]);
	my %score = ();
	for (@{$game->players}) {
		$score{$_->player} = {
			current => 0,
			last => 0
		};
	}
	$self->score(Game::Cribbage::Round::Score->new(%score));
	$self->next_hands($game);
}

sub next_hands {
	my ($self, $game, %args) = @_;
	$game->shuffle();
	my $hands = Game::Cribbage::Hands->new(%args)->init($game);
	$self->current_hands($hands);
	push @{$self->history}, $hands;
	return $self;
}

sub end_hands {
	my ($self, $game) = @_;
	my $scored = $self->current_hands->score_hands();
	for my $hand (keys %{$scored}) {
		$self->score->$hand->{last} = $self->score->$hand->{current};
		$self->score->$hand->{current} += $scored->{$hand};
	}
	$self->next_hands($game, crib_player => $self->next_crib_player($game));
}

sub add_player_card_by_index {
	my ($self, $index, $player, $card) = @_;
	my $hand = ref $player ? $player->player : $player;
	$self->current_hands->$hand->add_by_index($index, $card);
}

sub add_player_card {
	my ($self, $player, $card) = @_;
	my $hand = ref $player ? $player->player : $player;
	$self->current_hands->$hand->add($card);
}

sub add_starter_card {
	my ($self, $player, $card) = @_;
	my $score = $self->current_hands->add_starter_card($player, $card);
	if (ref $score && $score->score) {
		my $hand = ref $player ? $player->player : $player;
		$self->score->$hand->{last} = $self->score->$hand->{current};
		$self->score->$hand->{current} += $score->score;
		push @{$self->current_hands->$hand->play_scored}, $score;
	}
	return $score;
}

sub validate_crib_cards {
	my ($self, $cards) = @_;
	my $crib = $self->current_hands->crib_player;
	$self->current_hands->$crib->validate_crib_cards($cards);
}

sub next_to_play {
	my ($self, $game) = @_;
	my $next = $self->current_hands->play->next_to_play;
	my $player;
	for (@{$game->players}) {
		if ($next eq $_->player) {
			$player = $_;
			last;
		}
	}
	return $player;
}

sub next_to_play_id {
	my ($self, $game) = @_;
	my $next = $self->next_to_play($game);
	return $next->id;
}

sub get_crib_player {
	my ($self, $game) = @_;
	my $player;
	for (@{$game->players}) {
		if ($self->current_hands->crib_player eq $_->player) {
			$player = $_;
			last;
		}
	}
	return $player;
}

sub next_crib_player {
	my ($self, $game) = @_;
	my $current = $self->get_crib_player($game);
	my $next;
	if (scalar @{$game->players} == $current->number) {
		$next = 'player1';
	} else {
		$next = 'player' . ($current->number + 1);
	}
	return $next;
}

sub crib_player_id {
	my ($self, $game) = @_;
	my $player = $self->get_crib_player($game);
	return $player ? $player->id : $player;
}

sub crib_player_name {
	my ($self, $game) = @_;
	my $player = $self->get_crib_player($game);
	return $player ? $player->name : $player;
}

sub crib_player_number {
	my ($self, $game) = @_;
	my $player = $self->get_crib_player($game);
	return $player ? $player->number : $player;
}

sub crib_player_cards {
	my ($self, $player, $cards) = @_;
	my $hand = ref $player ? $player->player : $player;
	my $crib = $self->current_hands->crib_player;
	return $self->current_hands->$hand->discard_cards($cards, $self->current_hands->$crib);
}

sub crib_player_card {
	my ($self, $player, $card_index) = @_;
	my $hand = $player->player;
	my $crib = $self->current_hands->crib_player;
	$self->current_hands->$hand->discard($card_index, $self->current_hands->$crib);
}

sub force_play_card {
	my ($self, $card) = @_;
	my ($score, $player) = $self->current_hands->force_play_card($card);
	if (ref $score && $score->score) {
		my $hand = ref $player ? $player->player : $player;
		$self->score->$hand->{last} = $self->score->$hand->{current};
		$self->score->$hand->{current} += $score->score;
		push @{$self->current_hands->$hand->play_scored}, $score;
	}
	return $score;
}

sub play_player_card {
	my ($self, $player, $card_index) = @_;
	my $score = $self->current_hands->play_card($player, $card_index);
	if (ref $score && $score->score) {
		my $hand = ref $player ? $player->player : $player;
		$self->score->$hand->{last} = $self->score->$hand->{current};
		$self->score->$hand->{current} += $score->score;
		push @{$self->current_hands->$hand->play_scored}, $score;
	}
	return $score;
}

sub card_exists {
	my ($self, $player, $card) = @_;
	return $self->current_hands->card_exists($player, $card);
}

sub get_player_card {
	my ($self, $player, $card_index) = @_;
	$self->current_hands->get_card($player, $card_index);
}

sub current_play_score {
	my ($self) = @_;
	$self->current_hands->play_score();
}

sub last_play_score {
	my ($self) = @_;
	$self->current_hands->last_play_score();
}

sub cannot_play_a_card {
	my ($self, $player) = @_;
	$self->current_hands->cannot_play_a_card($player);
}

sub next_play {
	my ($self, $game) = @_;
	my $score = $self->current_hands->next_play($game);
	if (ref $score && $score->score) {
		my $hand = ref $score->player ? $score->player->player : $score->player;
		$self->score->$hand->{last} = $self->score->$hand->{current};
		$self->score->$hand->{current} += $score->score;
		push @{$self->current_hands->$hand->play_scored}, $score;
	}
	return $self->current_hands->play;
}

sub end_play {
	my ($self) = @_;
	my $score = $self->current_hands->end_play();
	if (ref $score && $score->score) {
		my $hand = ref $score->player ? $score->player->player : $score->player;
		$self->score->$hand->{last} = $self->score->$hand->{current};
		$self->score->$hand->{current} += $score->score;
		push @{$self->current_hands->$hand->play_scored}, $score;
	}
	return 1;
}

sub identify_worst_cards {
	my ($self, $player) = @_;
	my $hand = ref $player ? $player->player : $player;
	$self->current_hands->$hand->identify_worst_cards();
}

sub best_run_play {
	my ($self, $player) = @_;
	$self->current_hands->best_run_play($player);
}

sub hand_play_history {
	my ($self, $player) = @_;
	my @history = @{$self->current_hands->play_history};
	my $current = pop @history;
	my $count_cards = 0;
	for (@history) {
		$count_cards += scalar @{$_->cards};
	}
	return {
		used_count => $count_cards,
		current_play => $current
	};
}

1;