view release on metacpan or  search on metacpan

t/set_position.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Games::Backgammon;

use Test::More tests => 181;
use Test::Differences;
use Test::Exception;

use Data::Dumper;

use constant IDEAL_40 => {3 => 1, 4 => 1, 5 => 3, 6 => 3};
use constant IDEAL_79 => {4 => 3, 5 => 5, 6 => 7};

use constant TWENTY_CHECKERS => {
    whitepoints => {1 => 1, 2 => 19},
    blackpoints => {6 => 1},
    atroll      => 'black'
};

use constant DEFAULT_BOARDS => (
    {whitepoints => {off => 15}, blackpoints => {off => 15}, atroll => 'black'},
    {whitepoints => {},          blackpoints => {},          atroll => 'black'},
    {whitepoints => {off => 15}, blackpoints => {off => 15}},
    {atroll => 'black'},
    {},
);

use constant STARTING_POS => (
    map {($_ . "points" => {6 => 5, 8 => 3, 13 => 5, 24 => 2})} qw/white black/
);
use constant BOTH_PLAYERS_WITH_CLOSED_BOARD_AND_ON_BAR => (
    map {$_ . "points" => {map({$_ => 2} (1 .. 7)), bar => 1}} qw/white black/,
);

foreach my $atroll ('BLACK', 'WHITE') {

    my $game = Games::Backgammon->new(
        position => {
          whitepoints => {%{IDEAL_40()}, bar => 1},
          blackpoints => IDEAL_79(),
          atroll      => $atroll
        }
    );
    
    eq_or_diff {$game->whitepoints}, 
               {off => 15-9, bar => 1, %{IDEAL_40()}}, 
               "White points in ideal 40";
    eq_or_diff {$game->blackpoints}, 
               IDEAL_79,
               "Black points in ideal 79";

    is $game->atroll, lc($atroll), "$atroll was at roll and should be lc now";

    my %white = $game->whitepoints;
    my %black = $game->blackpoints;

    for (1 .. 24, 'off', 'bar') {
        is $game->whitepoints($_), ($white{$_} || 0), "Point $_ of white";
        is $game->blackpoints($_), ($black{$_} || 0), "Point $_ of black";
    }
      
}

foreach my $pos (DEFAULT_BOARDS) {
    my $game = Games::Backgammon->new(position => $pos);
    eq_or_diff {$game->whitepoints}, {off => 15}, "White points at default";