File Coverage

lib/Settlers/Game.pm

Criterion	Covered	Total	%
statement	624	659	94.6
branch	242	416	58.1
condition	108	199	54.2
subroutine	69	72	95.8
pod	0	52	0.0
total	1043	1398	74.6

package Settlers::Game;
$Settlers::Game::VERSION = '0.07';
use strict;
use 5.20.0;
use experimental qw/postderef signatures/;
use warnings;
no warnings 'experimental';
use Settlers::Event::Monopoly;
use Settlers::Event::RoadBuilding;
use Settlers::Event::Robber;
use Settlers::Event::YearOfPlenty;
use Settlers::Game::Bank;
use Settlers::Game::Player;
use Settlers::Game::Trade;
use Settlers::Map;
use Data::Dumper;
use Data::UUID;
use JSON::XS 'encode_json';
use List::Util qw/all/;
use Time::Piece;

#ABSTRACT: a class for managing games of Settlers

# valid phases
our @phases = qw/Setup Deployment Play End/;

our %events = (
  BC => \&build_city,
  BD => \&build_dc,
  BR => \&build_road,
  BS => \&build_settlement,
  CH => \&chat,
  CR => \&concede_resources,
  DR => \&dice_roll,
  MD => \&map_define,
  MO => \&monopoly,
  PA => \&player_add,
  PD => \&play_dc,
  PE => \&phase_end,
  RM => \&robber_move,
  RP => \&resource_production,
  RR => \&robber_rob,
  TA => \&trade_accept,
  TB => \&trade_bank,
  TC => \&trade_cancel,
  TE => \&turn_end,
  TO => \&trade_offer,
  TS => \&turn_start,
  YP => \&year_of_plenty,
  PS => \&phase_start,
  GO => \&game_over,
  LA => \&largest_army,
  LR => \&longest_road,
  RA => \&robber_activate,
  RD => \&robber_deactivate,
  RE => \&round_end,
  RS => \&round_start,
);

sub new ($class, $args = {})
{
  my $start_time = gmtime;
  my $self = bless {
    bank                => Settlers::Game::Bank->new,
    log                 => [],
    map                 => undef,
    max_players         => 4,
    max_victory_points  => 10,
    monopoly            => undef,
    phase_index         => -1,
    players             => [],
    road_building       => undef,
    round               => 0,
    trades              => {},
    turn_index          => -1,
    year_of_plenty      => undef,
    uuid                => Data::UUID->new->create_str,
    start_time          => $start_time,
  }, $class;

  # begin setup phase (and print to log if present)
  $self->event({
    player => 'A',
    event  => 'PS',
    value  => {phase => 'Setup'},
  });
  return $self;
}

sub event ($self, $args)
{
  my $code   = $args->{event};
  my $value  = $args->{value};
  my $sender = $args->{player};
  my $uuid   = $args->{uuid} || Data::UUID->new->create_str;

  my @event_history = ();

  if (!$code || !$value || ref $value ne 'HASH' || !$sender)
  {
    push @event_history, {
      player => 'A',
      uuid   => $uuid,
      event  => 'CH',
      value  => $self->chat({player => 'A', msg => "events require an event code, value and sender argument\n"})->[0]{CH},
    };
  }
  elsif (exists $value->{player} && $sender ne 'A' && $value->{player} ne $sender)
  {
    push @event_history, {
      player => 'A',
      uuid   => $uuid,
      event  => 'CH',
      value  => $self->chat({player => 'A', msg => "player $sender may not send commands on another player's behalf\n"})->[0]{CH},
    };
  }
  elsif (!exists $events{$code})
  {
    push @event_history, {
      player => 'A',
      uuid   => $uuid,
      event  => 'CH',
      value  => $self->chat({player => 'A', msg => "action type $code is unknown\n"})->[0]{CH},
    };
  }
  else
  {
    my $results = eval { $events{$code}->($self, $value) };
    my $first = 1;
    for (@$results)
    {
      if ($first)
      {
        push @event_history, {
          player => $sender,
          uuid   => $uuid,
          event  => $code,
          value  => $_->{$code},
        };
        undef $first;
      }
      else
      {
        my ($code) = keys %$_;
        push @event_history, {
          player => 'A',
          uuid   => Data::UUID->new->create_str,
          event  => $code,
          value  => $_->{$code},
        };
      }
    }
    push @event_history, {
      player => 'A',
      uuid   => $uuid,
      event  => 'CH',
      value  => $self->chat({player => 'A', msg => $@})->[0]{CH},
    } if $@;
  }
  $self->_log(\@event_history);
  return \@event_history;
}

sub build_road ($self, $args)
{
  my $player_number = $args->{player};
  my $location = $args->{path};

  die "deploy road requires player and path arguments!\n"
    unless $player_number && $location;

  die "It is not player $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "You can only build during the Deployment and Play phases\n"
    unless $self->phase =~ /^(?:Deployment|Play)$/;

  die "Player $player_number must build a settlement first\n"
    if $self->phase eq 'Deployment'
       && $self->round == 2
       && scalar @{$self->player->settlements} == 1;

  die "Player $player_number has already deployed a road this turn!\n"
    if $self->player->has_built_road && $self->phase eq 'Deployment';

  die "Player $player_number hasn't rolled the dice yet\n"
    unless $self->phase eq 'Deployment' || $self->player->has_rolled_dice
      || (defined $self->{road_building} && $self->{road_building}->can_build_road);

  die "Player $player_number must move the robber first\n"
    if $self->robber->active;

  die "Invalid path\n" unless my $path = $self->map->find_path($location);

  for my $player (@{$self->players})
  {
    die "That path is occupied\n"
      if grep($path->is_colliding($_->location), @{$player->roads});
  }

  my $free = ($self->phase eq 'Deployment' ||
    (defined $self->{road_building} && $self->{road_building}->can_build_road())) ? 1 : 0;
  $self->player->road_build($path, $self->bank, $free);

  my @actions = ();
  push @actions, { BR => { player => $player_number, path => $location }},
    @{$self->longest_road};
  return \@actions;
}

sub longest_road ($self)
{
  my @actions = ();

  my @properties = map { @{$_->properties} } @{$self->players};
  my $players_by_road_length = {};
  for (@{$self->players})
  {
    my $length = scalar @{$_->max_road_calculate(\@properties)};
    push @{ $players_by_road_length->{ $length } }, $_;
  }

  my $have_tested_leading_road;
  for my $road_length (sort {$b <=> $a} keys %$players_by_road_length)
  {
    my @players = @{$players_by_road_length->{$road_length}};

    for my $player (@players)
    {
      if ($have_tested_leading_road)
      {
        $player->longest_road_toggle if $player->longest_road;
      }
      elsif (@players == 1 && $road_length >= 5 && !$player->longest_road)
      {
        $player->longest_road_toggle;
        push @actions, { LR => {player => $player->number, length => $road_length}};
      }
    }
    $have_tested_leading_road = 1;
  }
  # check for player victory from longest road
  if (my $game_over = $self->game_over)
  {
    push @actions, @$game_over;
  }
  return \@actions;
}

sub game_over ($self)
{
  if (my $player = $self->player_victory_check)
  {
    return [{ GO => { player => $player->number } }, @{$self->phase_end}];
  }
}

sub build_settlement ($self, $args)
{
  my $player_number = $args->{player};
  my $location = $args->{intersection};

  die "You can only build during the Deployment and Play phases\n"
    unless $self->phase =~ /^(?:Deployment|Play)$/;

  die "deploy settlement requires player and intersection arguments!\n"
    unless $player_number && $location;

  die "It is not $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "Player $player_number hasn't rolled the dice yet\n"
    unless $self->phase eq 'Deployment' || $self->player->has_rolled_dice;

  die "Player $player_number has already deployed a settlement this turn!\n"
    if $self->player->has_built_settlement && $self->phase eq 'Deployment';

  die "Player $player_number must move the robber first\n"
    if $self->robber->active;

  die "Invalid intersection\n" unless my $intersection = $self->map->find_intersection($location);

  for my $player (@{$self->players})
  {
    die "That intersection is occupied or too close to another property\n"
      unless 0 == grep(($intersection->is_colliding($_->location)
            || $intersection->is_adjacent($_->location)), @{$player->properties});
  }

  my $free = $self->phase eq 'Deployment' ? 1 : 0;
  my $settlement = $self->player->settlement_build($intersection, $self->bank, $free);
  my @actions = ({ BS => { player => $player_number, intersection => $location } });
  $self->player->update_ratios($self->map); # in case they built next to a harbor

  # special resource production on deploying 2nd settlement
  if ($self->phase eq 'Deployment' && $self->round == 2)
  {
    push @actions, @{$self->resource_production_deployment($settlement->location)};
  }
  push @actions, @{$self->longest_road};
  return \@actions;
}

sub build_city ($self, $args)
{
  my $player_number = $args->{player};
  my $location = $args->{intersection};

  die "You can only build during the Deployment and Play phases\n"
    unless $self->phase =~ /^(?:Deployment|Play)$/;

  die "build settlement requires player and intersection arguments!\n"
    unless $player_number && $location;

  die "It is not Player $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "Player $player_number hasn't rolled the dice yet\n"
    unless $self->player->has_rolled_dice;

  die "Player $player_number must move the robber first\n"
    if $self->robber->active;

  die "Invalid intersection\n" unless my $intersection = $self->map->find_intersection($location);

  $self->player->city_build($intersection, $self->bank);
  return [{ BC => { player => $player_number, intersection => $location } }];
}

sub build_dc ($self, $args)
{
  my $player_number = $args->{player};
  my $type = $args->{type};

  die "You can only build during the Deployment and Play phases\n"
    unless $self->phase =~ /^(?:Deployment|Play)$/;

  die "deploy settlement requires a player argument!\n"
    unless $player_number;

  die "It is not $player_number\'s turn!\n"
   unless $self->player->number == $player_number;

  die "Player $player_number hasn't rolled the dice yet\n"
    unless $self->player->has_rolled_dice;

  die "Player $player_number must move the robber first\n"
    if $self->robber->active;

  my $card = $self->player->development_card_build($self->bank->deck_draw($type), $self->bank);
  return [{ BD => { player => $player_number, type => $card->type } }];
}

sub play_dc ($self, $args)
{
  my $player_number = $args->{player};
  my $type = $args->{type};

  die "play development card requires player and development card type arguments!\n"
    unless $player_number && $type;

  die "You can only play development cards during the Play phase\n"
    unless $self->phase eq 'Play';

  die "It is not Player $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "Player $player_number has already played a development card this turn!\n"
    if $self->player->has_played_dc;

  die "Player $player_number must move the robber first\n"
    if $self->robber->active;

  my $card = $self->player->development_card_play($type);

  my @actions = ();
  push @actions, { PD => { player => $player_number, type => $card->type } };

  if ($card->type eq 'KN')
  {
    $self->player->add_knight;
    push @actions, @{$self->robber_activate({from_7 => undef})},
      @{$self->largest_army};
  }
  elsif ($card->type eq 'YP')
  {
    $self->{year_of_plenty} = Settlers::Event::YearOfPlenty->new;
  }
  elsif ($card->type eq 'MO')
  {
    $self->{monopoly} = Settlers::Event::Monopoly->new();
  }
  elsif ($card->type eq 'RB')
  {
    $self->{road_building} = Settlers::Event::RoadBuilding->new($self->player);
  }
  else
  {
    die sprintf "Invalid development card type %s\n", $card->type;
  }

  return \@actions;
}

sub largest_army
{
  my $self = shift;

  # largest army is the player who has played at least 3 knights
  # and more knights than any other player
  my %players_by_knights;
  for (@{$self->players})
  {
    push @{$players_by_knights{ $_->knights }}, $_;
  }

  my @actions = ();
  my $have_tested_leaders;
  for my $knights_played (sort {$b <=> $a} keys %players_by_knights)
  {
    my @players = @{$players_by_knights{$knights_played}};

    for my $player (@players)
    {
      if ($have_tested_leaders)
      {
        $player->largest_army->toggle if $player->largest_army;
      }
      elsif (@players == 1 && $knights_played >= 3 && !$player->largest_army)
      {
        $player->largest_army_toggle;
        push @actions, {LA => {player => $player->number, strength => $knights_played}};
      }
    }
    $have_tested_leaders = 1;
  }

  # check for player victory
  if (my $game_over = $self->game_over)
  {
    push @actions, @$game_over;
  }
  return \@actions;
}

sub monopoly ($self, $args)
{
  my $player_number = $args->{player};
  my $code = $args->{resource_code};

  die "Monopoly requires player and resource code arguments!\n"
    unless $player_number && $code;

  die "It is not Player $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "Player $player_number does not have a monopoly!\n"
    unless defined $self->{monopoly};

  die "Player $player_number must move the robber first\n"
    if $self->robber->active;

  my $resources = $self->{monopoly}->calculate($player_number, $code, $self->players, $self->bank);
  undef $self->{monopoly};

  return [{MO => {resources => $resources} }];
}

sub year_of_plenty ($self, $args)
{
  my $player_number = $args->{player};
  my $resources = $args->{resources};

  die "Year of Plenty requires player and resource arguments!\n"
    unless $player_number && $resources && ref $resources eq 'HASH';

  die "It is not Player $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "Player $player_number does not have year of plenty!\n"
    unless defined $self->{year_of_plenty};

  my $trade = Settlers::Game::Trade->new($self->bank, $self->players, $resources, 1);

  $self->{year_of_plenty}->validate($trade);
  $trade->execute;
  undef $self->{year_of_plenty};

  return [{YP => {resources => $trade->as_hashref} }];
}

sub phase_start ($self, $args = {})
{
  die "The end phase is the last phase!\n" if $self->{phase_index} == $#phases;

  my $new_phase = $phases[ ++$self->{phase_index} ];

  # reset the round and turns counters
  $self->{round} = 0;
  $self->{turn_index} = -1;

  my @actions = ({PS => {phase => $new_phase}});

  # deploy the robber, start deployment round 1
  if ($new_phase eq 'Deployment')
  {
    push @actions, @{$self->robber_setup}, @{$self->round_start};
  }
  elsif ($new_phase eq 'Play')
  {
    push @actions, @{$self->round_start};
  }
  return \@actions;
}

sub concede_resources ($self, $args)
{
  my $player_number = $args->{player};
  my $resources     = $args->{resources};
  my $player        = $self->player_by_number($player_number);

  die "Concede resources requires player and resource argument for 1 player!\n"
    unless $player && $resources && ref $resources eq 'HASH'
      && (1 == keys %$resources)
      && (exists $resources->{$player_number});

  die "Conceded resource amounts must be negative!\n"
    unless (all { $_ < 0 } values %{$resources->{$player_number}});

  die "Player $player_number doesn't need to concede any resources at this time\n"
    unless ($self->phase eq 'Play' && 1 == grep($player_number == $_->{player}->number, @{$self->robber->check_players_to_concede}));

  my @actions = ();

  my $trade = Settlers::Game::Trade->new($self->bank, $self->players, $resources, 1);
  my $summary = $trade->execute;

  push @actions, {CR => { player => $player_number, resources => $summary }};

  my $msg;
  for (@{$self->robber->check_players_to_concede})
  {
    $msg .= sprintf "Player %d must concede %d resources. ",
      $_->{player}->number, ($_->{player}->resource_total - $_->{target_total});
  }
  push(@actions, @{$self->chat({player => 'A', msg => $msg})}) if $msg;

  return \@actions;
}

sub chat ($self,$args)
{
  my $player_number = $args->{player};
  my $msg           = $args->{msg};

  die "Chat requires player and msg arguments\n"
    unless ($player_number eq 'A' || grep($player_number eq $_->number, @{$self->players}) ) && $msg;

  return [{ CH => {player => $player_number, msg => $msg} }];
}

sub robber_setup ($self, $args = {})
{
  $self->{robber} = Settlers::Event::Robber->new({map => $self->map});
  return [ { RM => { player => 'A', tile => [$self->robber->location->{q}, $self->robber->location->{r}]} } ];
}

sub robber_activate ($self, $args = {})
{
  my @actions = ({ RA => {player => $self->player->number}});

  my $players = $args->{from_7} ? $self->players : [];

  my $msg;
  for (@{$self->robber->activate($players)})
  {
    $msg .= sprintf "Player %d must concede %d resources. ",
      $_->{player}->number, ($_->{player}->resource_total - $_->{target_total});
  }
  push(@actions, @{$self->chat({player => 'A', msg => $msg})}) if $msg;
  return \@actions;
}

sub robber_deactivate ($self, $args = {})
{
  $self->robber->deactivate;
  return [ { RD => {player => $self->player->number} } ];
}

# steal and deactivate
sub robber_rob ($self, $args)
{
  my $player = $self->player_by_number($args->{player});
  my $target_player = $self->player_by_number($args->{target_player});
  my $code          = $args->{code};

  die "robber steal requires a player and target player arguments\n"
    unless $player && $target_player;

  die "It is not $player\'s turn\n" unless $self->is_players_turn($player->number);

  $code ||= $self->robber->steal($target_player);
  my $trade         = Settlers::Game::Trade->new($self->bank, $self->players, {
      $target_player->number=> {$code =>-1},
      $player->number       => {$code => 1},
  });
  $trade->execute;
  return [
    { RR => {target_player => $args->{target_player}, resources => $trade->as_hashref }},
    @{$self->robber_deactivate},
  ];
}

sub robber_move ($self, $args)
{
  my $player_number = $args->{player};
  my $location = $args->{tile};

  die "build settlement requires player and tile arguments!\n"
    unless $player_number && $location;

  die "It is not player $player_number\'s turn!"
    unless $player_number == $self->player->number;

  my $tile = $self->map->find_tile($location);

  $self->robber->move($tile, $self->player, $self->players);
  my @actions;
  push @actions, { RM => { player => $self->player->number, tile => [$tile->{q}, $tile->{r}]} };

  # deactivate if there are no eligible players to steal from
  push @actions, @{$self->robber_deactivate} unless $self->robber->can_steal;
  return \@actions;
}

sub phase_end ($self, $args = {})
{
  # check a map is defined, and there are 3+ players
  if ($self->phase eq 'Setup')
  {
    die "The Setup phase cannot end until a map has been defined (MD)\n"
      unless defined $self->map;

    die "The Setup phase cannot end until there are at least 3 players\n"
      unless @{$self->players} >= 3;
  }
  elsif ($self->phase eq 'Deployment')
  {
    my $player = $self->player;
    die "The Deployment phase cannot end until all players have gone $player\n"
      unless $self->round == 2 && $self->player->number eq "1";
  }
  elsif ($self->phase eq 'Play')
  {
    die "The Play phase cannot end until a player has won the game\n"
      unless defined $self->player_victory_check;
  }

  return [ { PE => {phase => $self->phase} }, @{$self->phase_start} ];
}

sub round_start ($self, $args = {})
{
  return [ { RS => {round => ++$self->{round}} }, @{$self->turn_start} ];
}

sub round_end ($self, $args = {})
{
  $_->actions_clear for (@{$self->players});

  # 2 round limit on deployment phase
  if ($self->phase eq 'Deployment' && $self->round == 2)
  {
    return [ { RE => {round => $self->round}}, @{$self->phase_end}  ];
  }
  return [ { RE => {round => $self->round}}, @{$self->round_start} ];
}

sub turn_start ($self, $args = {})
{
  die "cannot start turn during setup\n" if $self->phase eq 'Setup';

  if ($self->turn == 0)
  {
    $self->{turn_index}++;
  }
  # if its the last players turn in deployment
  # & they haven't deployed 2 settlements
  # it's their turn again
  elsif ($self->phase eq 'Deployment'
         && $self->turn == @{$self->players}
         && @{$self->player->settlements} == 1)
  {
    $self->{turn_index} = $self->{turn_index};
  }
  # if its deployment and the current player
  # has deployed 2 settlements
  # switch to the previous player
  elsif ($self->phase eq 'Deployment'
         && @{$self->player->settlements} == 2)
  {
    $self->{turn_index}--;
  }
  elsif ($self->phase eq 'Play'
         && $self->{turn_index} + 1 == @{$self->players})
  {
    $self->{turn_index} = 0;
  }
  else
  {
    $self->{turn_index}++;
  }

  my @actions = ({ TS => {player => $self->player->number}});
  return \@actions;
}

sub turn_end ($self, $args = {})
{
  my $player_number = $args->{player};

  die "It is not Player $player_number\'s turn!\n"
   unless $self->is_players_turn($player_number);

  die "Player $player_number hasn't rolled the dice yet\n"
    unless $self->phase eq 'Deployment' || $self->player->has_rolled_dice;

  die "Player has not built a road and a settlement\n"
    if $self->phase eq 'Deployment'
      && !($self->player->has_built_road && $self->player->has_built_settlement);

  my @actions = ();

  if ($self->robber->active)
  {
    die "Player $player_number must steal a resource before ending their turn\n"
      if $self->robber->can_steal;
    push @actions, @{$self->robber_deactivate};
  }

  # clear outstanding events, open trades
  $self->trades_clear;
  undef $self->{monopoly};
  undef $self->{road_building};
  undef $self->{year_of_plenty};

  push @actions, { TE => {player => $self->player->number }};

  # if it's the last players turn
  # or its development phase & the current player has two properties
  # and it's player #1
  if (($self->turn == @{$self->players}
      && $self->phase eq 'Play')
      || ($self->phase eq 'Deployment'
          && @{$self->player->properties} == 2
          && $self->turn == 1)
      || ($self->phase eq 'Deployment'
          && @{$self->player->properties} == 1
          && $self->turn == @{$self->players}))
  {
    push @actions, @{$self->round_end};
  }
  # else move to the next player
  else
  {
    push @actions, @{$self->turn_start};
  }
  return \@actions;
}

sub player_victory_check ($self, $args = {})
{
  my @players_by_vps = sort {
    $b->victory_points_count <=> $a->victory_points_count } @{$self->players};

  return $players_by_vps[0] if $players_by_vps[0]->victory_points_count >= 10;
}

sub player_add ($self, $args = {})
{
  die "cannot add player outside of setup phase\n" unless $self->phase eq 'Setup';
  die "cannot add player as max players has been reached\n"
    unless $self->{max_players} > @{$self->players};

  my $number = @{$self->players} + 1;
  my $player = Settlers::Game::Player->new({number => "$number"});
  push @{$self->players}, $player;
  return [{PA => {player => $player->number} }];
}

sub dice_roll ($self, $args)
{
  my $player_number = $args->{player};

  die "It is not Player $player_number\'s turn\n"
    unless $self->is_players_turn($player_number);

  die "Player $player_number has already rolled the dice!\n"
    if $self->player->has_rolled_dice;

  my $dice_roll = $self->player->roll_dice($args->{result});
  my @actions = ({ DR => {player => $self->player->number, result => $dice_roll} });

  # trigger robber action
  if ($dice_roll == 7)
  {
    push @actions, @{$self->robber_activate({from_7 => 1})};
  }
  else
  {
    push @actions, @{$self->resource_production({resource_number => $dice_roll})};
  }
  return \@actions;
}

sub resource_production ($self, $args)
{
  my %resources = ();
  my $tiles = $self->map->tiles_by_resource_number($args->{resource_number});

  for my $tile (@$tiles)
  {
    # the robber prevents resource production
    next if $self->robber->location->uuid eq $tile->uuid;

    for my $player (@{$self->players})
    {
      for my $property (@{$player->properties})
      {
        if ($property->location->is_adjacent($tile))
        {
          # update the player and bank resource amounts
          my $amount = $property->isa('Settlers::Asset::Settlement') ? 1 : 2;
          next unless my $resource = $tile->yields($amount);
          $resources{$player->number}{$resource->code} += $amount;
        }
      }
    }
  }
  for my $player (@{$self->players})
  {
    if (exists $resources{$player->number})
    {
      my $trade = Settlers::Game::Trade->new(
        $self->bank, $self->players, {$player->number => $resources{$player->number}}, 1);
      my $results = $trade->execute;
      for (keys %{$results->{$self->bank->number}})
      {
        $resources{$self->bank->number}{$_} += $results->{$self->bank->number}{$_};
      }
    }
  }
  return [{ RP => {resources => \%resources} }];
}

# during deployment each player collects adjacent resources for their 2nd property
sub resource_production_deployment ($self, $intersection)
{
  my %resources = ();

  for my $tile (@{$self->map->tiles_by_intersection($intersection)})
  {
    # update the player and bank resource amounts
    my $resource = $tile->yields(1);
    # sea tiles don't give out!
    next unless $resource;

    $resources{$self->player->number}{$resource->code} += 1;
  }
  my $trade = Settlers::Game::Trade->new($self->bank, $self->players, \%resources, 1);
  $trade->execute;
  return [{ RP => {resources => \%resources} }];
}

sub trade_offer ($self, $args)
{
  my $offering_player = $args->{player};
  my $details         = $args->{resources};
  my $uuid            = $args->{uuid} || Data::UUID->new->create_str;

  die "Trades can only be made during the Play phase\n"
    unless $self->phase eq 'Play';

  die "Offer is not for current player!\n"
    unless grep($self->player->number == $_, keys %$details);

  die "Offer does not include offering player!\n"
    unless grep($offering_player == $_, keys %$details);

  die "Player $offering_player hasn't rolled the dice yet\n"
    unless $self->player->has_rolled_dice;

  die "UUID $uuid is not unique!\n" if exists $self->trades->{$uuid};

  my $trade = Settlers::Game::Trade->new($self->bank, $self->players, $details);
  my $trade_offer = {
    trade  => $trade,
    uuid   => $uuid,
    player => $offering_player,
  };
  $self->trade_add($trade_offer);
  return [{TO => { player => $offering_player, uuid => $uuid, resources => $details}}];
}

sub trade_bank ($self, $args)
{
  my $player_number = $args->{player};
  my $details       = $args->{resources};

  die "Offer is not for current player!\n"
    unless grep($self->player->number == $_, keys %$details)
      && $player_number == $self->player->number;

  my $trade = Settlers::Game::Trade->new($self->bank, $self->players, $details);
  my $resources = $trade->execute;
  return [{TB => {resources => $resources} }];
}

sub trade_add ($self, $trade)
{
  $self->{trades}{$trade->{uuid}} = $trade;
}

sub trades_clear ($self)
{
  $self->{trades} = {};
}

sub trades { $_[0]->{trades} }

sub trade_accept ($self, $args)
{
  my $player_number = $args->{player};
  my $uuid = $args->{uuid} || '';

  die "Player $player_number does not have an active trade with uuid: $uuid\n"
    unless $player_number
      && $uuid && exists $self->trades->{$uuid}
      && $self->trades->{$uuid}{player} != $player_number
      && $self->trades->{$uuid}{trade}->resources($player_number);

  my @actions = ();
  push @actions, { TA => {player => $player_number, uuid => $uuid} };
  my $trade = $self->trades->{$uuid}{trade};
  my $details = $trade->execute;
  push @actions, { TR => { resources => $details }};
  delete $self->trades->{$uuid};
  return \@actions;
}

sub trade_cancel ($self, $args)
{
  my $player_number = $args->{player};
  my $uuid = $args->{uuid} || '';

  die "Player $player_number does not have an active trade with uuid: $uuid\n"
    unless $player_number
      && $uuid && exists $self->trades->{$uuid}
      && $self->trades->{$uuid}{player} == $player_number
      && $self->trades->{$uuid}{trade}->resources($player_number);

  delete $self->trades->{$uuid};
  return [{TC => {player => $player_number, uuid => $uuid}}];
}

sub map_define ($self, $args)
{
  die "map can only be defined during setup phase\n" unless $self->phase eq 'Setup';
  $self->{map} = Settlers::Map->new({type => $args->{type}, schema => $args->{schema}});
  return [{MD => { %{$self->{map}->schema}, type => $args->{type}}}];
}

sub robber     { $_[0]->{robber} }
sub players    { $_[0]->{players} }
sub player     { $_[0]->{players}[$_[0]->{turn_index}] }
sub bank       { $_[0]->{bank} }
sub map        { $_[0]->{map} }
sub phase      { $phases[$_[0]->{phase_index}] }
sub round      { $_[0]->{round} }
sub turn       { $_[0]->{turn_index} + 1 }
sub uuid       { $_[0]->{uuid} }
sub start_time { $_[0]->{start_time} }

sub player_by_number ($self, $number)
{
  die "player_by_number requires a number argument!\n" unless $number;
  my @player = grep ($number == $_->number, @{$self->players});
  die "No players with nnumber $number found!\n" unless @player;
  return $player[0];
}

sub is_players_turn ($self, $number)
{
  die "is_players_turn requires a number argument!\n" unless $number;
  return $self->player->number == $number;
}

sub _log
{
  my ($self, $msgs) = @_;
  die "log requires an arrayref of msgs\n" unless $msgs && ref $msgs eq 'ARRAY';
  push @{$self->{log}}, @$msgs;
}

sub log { $_[0]->{log} }
sub log_json { encode_json($_[0]->{log}) }

1;

__END__