#! /usr/local/bin/perl -w

use strict;

use Test;
BEGIN { plan tests => 3 };

use IO::Socket::INET;
use BaldLies::Backgammon::Match;
use BaldLies::Backgammon::Board;
use BaldLies::Const qw (:colors);

my $socket = IO::Socket::INET->new (
    PeerHost => 'localhost',
    PeerPort => 9999,
    Timeout => 3,
    Proto => 'tcp',
);

die "Please start gnubg external interface on port 9999" unless $socket;

my ($got, $wanted);

# Match1 is a match with white on roll/move.
my $match1 = BaldLies::Backgammon::Match->new (player1 =>  'player_a',
                                               player2 =>  'player_b');
$match1->do (roll => 0, 1, 3);
# Match2 is the same match but with black on roll/move.
my $match2 = BaldLies::Backgammon::Match->new (player1 =>  'player_a',
                                               player2 =>  'player_b');
$match2->do (roll => 0, 3, 1);

$match1->do (move => BLACK, 17, 20, 19, 20);
$match2->do (move => WHITE, 8, 5, 6, 5);

# Clearly not a double.
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;

# Set the score to 1-4.
$match1->setScore (1, 4);
$match2->setScore (4, 1);

# And the length to unlimited.
$match1->setLength (-1);
$match2->setLength (-1);

# Still not a double.
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;

# Now set match length to 5 but disable the Crawford rule.
$match1->setLength (5);
$match2->setLength (5);
$match1->setCrawford (0);
$match2->setCrawford (0);

# Now it is a clear double.
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;

# Enable the Crawford rule and make it the crawford game.
$match1->setCrawford (1);
$match2->setCrawford (1);
$match1->setCrawfordGame (1);
$match2->setCrawfordGame (1);

# Doubling is not possible now.
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'roll';
ok $got, $wanted;

# And now test a clear double beyond all Crawford stuff.
$match1->setLength (25);
$match2->setLength (25);
my $board1 = BaldLies::Backgammon::Board->new;
my $board2 = BaldLies::Backgammon::Board->new;
$match1->setBoard ($board1);
$match2->setBoard ($board2);
$board1->clear;
$board1->[1] = 9;
$board1->[2] = 6;
$board1->[19] = -9;
$board1->[20] = -6;
$board2->clear;
$board2->[6] = 9;
$board2->[5] = 6;
$board2->[23] = -9;
$board2->[24] = -6;
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'double';
ok $got, $wanted;

# Test, whether the reply is a drop.
$board1->[1] = 1;
$board1->[2] = 1;
$board2->[23] = -1;
$board2->[24] = -1;
$match1->do (double => WHITE);
$match2->do (double => BLACK);
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;

$match1->do (accept => BLACK);
$match2->do (accept => WHITE);

# General test with forced move:
$board1->clear;
$board1->[6] = 1;
$board1->[20] = -9;
$match1->do (roll => WHITE, 1, 1);
$board2->clear;
$board2->[5] = 9;
$board2->[19] = -1;
$match2->do (roll => BLACK, 1, 1);
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = '6/5 5/4 4/3 3/2';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = '6/5 5/4 4/3 3/2';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = '6/5 5/4 4/3 3/2';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = '6/5 5/4 4/3 3/2';
ok $got, $wanted;

# Test that bar is handled correctly.  One player splits on the opening
# roll, the other rolls 41 and hits two checkers.
$match1 = BaldLies::Backgammon::Match->new (player1 =>  'player_a',
                                            player2 =>  'player_b',
                                            length => 25);
$match1->do (roll => 0, 2, 1);
$match1->do (move => WHITE, 13, 11, 24, 23);
$match1->do (roll => BLACK, 4, 1);
$match1->do (move => BLACK, 19, 23, 23, 24);
$match1->do (roll => WHITE, 6, 1);
$match2 = BaldLies::Backgammon::Match->new (player1 =>  'player_a',
                                            player2 =>  'player_b',
                                            length => 25);
$match2->do (roll => 0, 1, 2);
$match2->do (move => BLACK, 12, 14, 1, 2);
$match2->do (roll => WHITE, 4, 1);
$match2->do (move => WHITE, 6, 2, 2, 1);
$match2->do (roll => BLACK, 6, 1);
# At this point, there is only one possible move; we have to bring in one
# checker from the bar to the ace point.
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = '25/24* ';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = '25/24* ';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = '25/24* ';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = '25/24* ';
ok $got, $wanted;

# Make the forced move, and then do a (premature) double.  The answer must be
# a take.
$match1->do (move => WHITE, 25, 24);
$match1->do (double => BLACK);
$match2->do (move => BLACK, 0, 1);
$match2->do (double => WHITE);
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;

# Test that cube decisions depending on the score are handled correctly.
# In a post-Crawford match, we put the leader in a desperate but not
# hopeless position.  When the leader in the match doubles, it is a
# mandatory take.  When the trailer doubles, it is a free drop.
$match1 = BaldLies::Backgammon::Match->new (length => 5, crawford => 1);
$match2 = BaldLies::Backgammon::Match->new (length => 5, crawford => 1);
$match1->setTurn (WHITE);
$match2->setTurn (BLACK);
$board1->clear;
$board2->clear;
$match1->setBoard ($board1);
$match2->setBoard ($board2);
$board1->[2] = 15;
$board1->[20] = -15;
$board2->[23] = -15;
$board2->[5] = 15;
$match1->do (double => WHITE);
$match2->do (double => BLACK);

# Make it a free drop.
$match1->setScore (3, 4);
$match2->setScore (4, 3);
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'drop';
ok $got, $wanted;

# Swap the score, so that it becomes a mandatory take.
$match1->setScore (4, 3);
$match2->setScore (3, 4);
$socket->print ($match1->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;
$socket->print ($match1->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;
$socket->print ($match2->board (3, 0));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;
$socket->print ($match2->board (3, 1));
$got = $socket->getline; chomp $got;
$wanted = 'take';
ok $got, $wanted;

#print $match1->board (1, 0);
#print $match1->board (1, 1);
#print $match1->board (3, 0);
#print $match1->board (3, 1);
