--------------------
README file begins:
--------------------
The main program is go-arena.pl, and a sample client is in go-client.pl.

The interface is explain somewhat in the go-proto.txt, but I recommend you
just telnet'ing into the server, as that works well.  I'll setup the server
over here for you all to play if you do not have perl available to you.

The idea behind all this is to have AI play each other to see who can write
a better AI.  Or to put it better, to allow programmers a good arena to test
their ideas on how well an AI can perform, in order to make programmers better
at AI programming :) (which is a good thing).

Anyway enjoy, send clients to me if you would like me to run tournaments
(until we have the server better setup to do so itself) my email address is
gryn.garkin@mail.auburn.edu

-Gryn
--------------------
go-arena.pl file begins:
--------------------
#!/usr/bin/perl -w
use strict;

use IO::Socket;
use Getopt::Long;

my $ver = "0.1.1a";

sub printhelp {
  print "This is the go-arena.pl program, it will accept connections to play\n";
  print "a game of GO from clients which follow a simple text-line protocol\n";
  print "described in go-proto.txt\n";
  print "Tt will only play one game, defaults to size 19, and spits the scoring\n";
  print "information back to the terminal.  (you can change the size by\n";
  print "passing it as a parameter, and clients are also told if they\n";
  print "won or not)\n";
  print "	--help,-h		Help\n";
  print "	--size,-s		Board size\n";
  print "	--port,-p		Port to listen on (only if no --socket option)\n";
  print "	--socket,-s		Local domain socket (only local connection)\n";
  print "	--komi,-k		Set komi amount (2nd turn compensation\n";
  print "	--debug			Print debug info\n";
  print "	--verbose,-v		Print more stuff\n";
  exit;
}

my (	$help,	$socket,$debug);
my (	$size,	$port,	$komi,	$verbose)
 = (	19,	7179,	4.5,	0);

GetOptions(	"help|?" => \$help,
		"size|s=i" => \$size,
		"port|p=i" => \$port,
		"socket|d=s" => \$socket,
		"komi|k=f" => \$komi,
		"debug" => \$debug,
		"verbose|v+" => \$verbose
	);

if ($help or @ARGV) {
  printhelp;
}

srand;

my $up    = [  0, -1 ];
my $down  = [  0,  1 ];
my $left  = [ -1,  0 ];
my $right = [  1,  0 ];

# global settings:
# needs to be at least 3
my $histsize = 3;

######################################################################
# BOARD Type (functions etc)
# (MOVE/POS type too)

# $board is a ref to a hash, each hash value hold some aspect of a board state.
# b = a 2d array that shows the positions of the stones with the following mapping:
#     0 - nothing
#    99 - nothing (but already counted, when doing final scoring)*
#     1 - white stone
#     2 - white stone*
#    -1 - black stone
#    -2 - black stone*
#   -99 - not on board
#    (note that * values are only present during intermediate board processing)
# m = number of valid moves made total
# t = number of turns taken
# f = free spaces left on the board
# black = black's score
# white = white's score
# lm = the last move made (which created the current state)
# lb = the previous board (if you apply the last move you would arrive
#                          at the current state)

#      NOTE: the 'lb' hash element forms a linked list!  A history of the
#            game!  Therefore, $histsize limits the maximum size of this
#            buffer, setting it to -1 will allow infinite boards -- however
#            for KO detection to work, we always store the last 2 boards.
#            (after finding a valid move, check that board against two boards
#             ago (i.e. $board->{'lb'}->{'lb'} ) )
#      NOTE NOTE: Perl doesn't seem to throw away the memory, oh well.

# A move or position type is simply a reference to a two element array
# specifying the x and y location.  A [-1,-1] indicates a pass, and [ -2, -2]
# means the client quit or disconnected.

# Reset and clear a board

sub newB {
  my $board;
  $board->{'m'} = 0;
  $board->{'t'} = 0;
  $board->{'f'} =  $size * $size;
  $board->{'lm'} = undef;
  $board->{'lb'} = undef;
  $board->{'black'} = 0;
  $board->{'white'} = 0;
  @{$board->{'b'}} = ();
  for (my $y=0;$y<$size;$y++) {
    for (my $x=0;$x<$size;$x++) {
      set_board_val($board,[$y,$x],0);
    }
  }
  return $board;
}

sub board_copy {
  my $b1 = shift;
  my $recurse = shift || 0;
  my $b2;
  if (not $b1) { # undef, null
    return undef;
  }
  $b2->{'m'} = $b1->{'m'};
  $b2->{'t'} = $b1->{'t'};
  $b2->{'f'} = $b1->{'f'};
  $b2->{'m'} = $b1->{'m'};
  
  $b2->{'black'} = $b1->{'black'};
  $b2->{'white'} = $b1->{'white'};

# these two should be the same.
  $b2->{'b'} = [ map { [ @{$_} ] } @{$b1->{'b'}} ];
#  for (my $y = 0; $y < $size; $y++) {
#    $b2->{'b'}[$y] = [ @{$b1->{'b'}[$y]} ];
#  }

  $b2->{'lm'} = $b2->{'lm'};
  if ($recurse < $histsize) {
    $b2->{'lb'} = board_copy($b1->{'lb'},$recurse+1);
  } else {
    $b2->{'lb'} = undef;
  }
  return $b2;
}

# Returns true if two positions's are the same
sub pos_equal {
  my ($p1, $p2) = @_;
  if ($p1->[0] == $p2->[0] and $p1->[1] == $p2->[1]) {
    return 1;
  } else {
    return 0;
  }
}

# Is move a pass? (i.e. (-1, -1) )
sub is_pass {
  my $move = shift;
  if (pos_equal($move, [ -1, -1 ])) {
    return 1;
  } else {
    return 0;
  }
}

# Add two positions together (e.g. add_dir($this,$up) )
sub add_dir {
  my ($pos, $dir) = @_;
  my $newpos = [ $pos->[0] + $dir->[0], $pos->[1] + $dir->[1] ];
  return $newpos;
}

# Returns true if the position is within the board
sub in_board {
  my $pos = shift;
  if ($pos->[0] >= 0     and $pos->[1] >= 0    and
      $pos->[0] <  $size and $pos->[1] <  $size)
  {
    return 1;
  } else {
    return 0;
  }
}

# Returns the value of the board at a position
# (uses the key at the top of this section)
sub board_val {
  my ($board, $pos) = @_;
  if (in_board($pos) == 1) {
    return $board->{'b'}[$pos->[1]][$pos->[0]];
  } else {
    return -99;
  }
}

# Sets the board's value at a position
sub set_board_val {
  my ($board, $pos, $val) = @_;
  if (in_board($pos) == 1) {
    $board->{'b'}[$pos->[1]][$pos->[0]] = $val;
  }
}

# pretty prints a board
sub printB {
  my $board = shift;
  print "/-","--" x $size,"\\\n";
  for (my $y=0;$y<$size;$y++) {
    print "| ";
    for (my $x=0;$x<$size;$x++) {
      print ". " if board_val($board,[$x,$y]) ==  0;
      print "# " if board_val($board,[$x,$y]) == 99;
      print "% " if board_val($board,[$x,$y]) == 98;
      print "O " if board_val($board,[$x,$y]) ==  1;
      print "X " if board_val($board,[$x,$y]) == -1;
      print "O)" if board_val($board,[$x,$y]) ==  2;
      print "X<" if board_val($board,[$x,$y]) == -2;
      print "* " if board_val($board,[$x,$y]) ==-99;
    }
    print "|\n";
  }
  print "\\-","--" x $size,"/\n";
}

# prints a board (faster/smaller)
sub printBsimp {
  my $board = shift;
  for (my $y=0;$y<$size;$y++) {
    print map {if    ($_ == 0) {"."}
               elsif ($_ ==-1) {"X"}
               elsif ($_ == 1) {"O"}
               else            {"?"}} @{$board->{'b'}[$y]};
    print "\n";
  }
  print ".\n";
}

# pretty prints a position
sub printP {
  my $pos = shift;
  print $pos->[0]," x ",$pos->[1],"\n";
}

# checks to see if stone positions are the same
sub board_equal {
  my ($b1, $b2) = @_;
  if (@{$b1->{'b'}} == @{$b2->{'b'}}) {
    return 1;
  } else {
    return 0;
  }
}

# End of BOARD, MOVE/POS section
######################################################################

# This processes a move on $board, returning if the move was valid,
# and also the new board state.

sub do_move {
  my ($orig_board, $move, $who) = @_;
  my $captured = 0;
  $orig_board->{'t'} += 1;
  my $board = board_copy($orig_board);
  $board->{'lb'} = $orig_board;
  $board->{'lm'} = $move;
  # we need to dec $orig_board->{'t'} if we find a valid move

  # A pass is always a valid move. also let quit messages be valid too
  if (is_pass($move) == 1 or pos_equal($move,[-2,-2]) == 1) {
    return (1,$board);
  }

  # The position must be free...
  if (board_val($board,$move) == 0) {
    # Now, process captures
    # (place stone, then see if up,down,left,right stones are captured)
    set_board_val($board,$move,$who);
    for my $dir ($up,$down,$left,$right) {
      # if direction is an opponent's peice..
      if (board_val($board,add_dir($move,$dir)) == $who*-1) {
        # if there is no life here, kill it, else refill it to orig value.
        if (fill_life($board,add_dir($move,$dir),$who*-1,$who*-2) == 0) {
          $captured+=fill_count($board,add_dir($move,$dir),$who*-2,0);
        } else {
          fill_life($board,add_dir($move,$dir),$who*-2,$who*-1);
        }
      }
    }
    # if, after captures, the piece itself has no life, then it is still
    # an invalid move.
    if (fill_life($board,$move,$who,$who*2) == 0) {
      return (0,$orig_board);
    } else {
      fill_life($board,$move,$who*2,$who);
    }

    # KO checking, if last board state for this player is the same
    # as this board state, then KO prevents this move.
    # (also check to see if moves were the same, since this must
    #  happen before KO -could- happen).
    if ($board->{'lb'} and $board->{'lb'}->{'lb'} and $board->{'lb'}->{'lb'}->{'lm'}) {
      print "KO detection enabled\n" if $debug;
      if (pos_equal($move,$board->{'lb'}->{'lb'}->{'lm'})) {
        print "Possible KO checking board states\n" if $debug;
        if (board_equal($board,$board->{'lb'}->{'lb'})) {
          print "KO!\n" if $debug;
          return (0,$orig_board);
        }
      }
    }
    $orig_board->{'t'} -= 1;
    $board->{'f'} -= 1;
    $board->{'f'} += $captured;
    $board->{'m'} += 1;
    $board->{'black'} += $captured if $who == -1;
    $board->{'white'} += $captured if $who ==  1;
    return (1,$board);
  } else {
    return (0,$orig_board);
  }
}

sub tally_final_score {
  my $orig_board = shift;
  my ($black, $white) = (0,0);
  my (@s,@n,@b,@w) = ((),(),(),());
  my $board = board_copy($orig_board);
  for (my $y = 0;$y < $size; $y++) {
    for (my $x = 0;$x < $size; $x++) {
      if (board_val($board,[$x,$y])==0) {
        my $owner = fill_owner($board, [$x,$y], 0, 99);
        push @s, [$x,$y] if $owner ==  0;
        push @n, [$x,$y] if $owner == 99;
        push @b, [$x,$y] if $owner == -1;
        push @w, [$x,$y] if $owner ==  1;
      }
    }
  }

  map { fill_count($board,$_,99,0) } @s;
  map { fill_count($board,$_,99,0) } @n;
  map { $black += fill_count($board,$_,99,0) } @b;
  map { $white += fill_count($board,$_,99,0) } @w;
  $board->{'black'} += $black;
  $board->{'white'} += $white;
  return $board;
}

# Returns 1 if position filled had life or not
sub fill_life {
  my ($board, $pos, $from, $to) = @_;
  if (in_board($pos)) {
    if (board_val($board, $pos) == $from) {
      set_board_val($board, $pos, $to);
      # we put results of fill in temp array, so that the ||'s short
      # circuit logic does not stop the fill operation. probably could use map
      my @f = (
        fill_life($board, add_dir($pos,    $up), $from, $to),
        fill_life($board, add_dir($pos,  $down), $from, $to),
        fill_life($board, add_dir($pos,  $left), $from, $to),
        fill_life($board, add_dir($pos, $right), $from, $to) );
      return $f[0] || $f[1] || $f[2] || $f[3];
    } else {
      if (board_val($board, $pos) == 0) {
        return 1;
      } else {
        return 0;
      }
    }
  } else {
    return 0;
  }
}

# Returns number of spaces filled
sub fill_count {
  my ($board, $pos, $from, $to) = @_;
  if (in_board($pos)) {
    if (board_val($board, $pos) == $from) {
      set_board_val($board, $pos, $to);
      return 1 + 
        fill_count($board, add_dir($pos,    $up), $from, $to) +
        fill_count($board, add_dir($pos,  $down), $from, $to) +
        fill_count($board, add_dir($pos,  $left), $from, $to) +
        fill_count($board, add_dir($pos, $right), $from, $to);
    } else {
      return 0;
    }
  } else {
    return 0;
  }
}


# this function returns who owns an open space

# Value	| On Board	| Passed as	| Returned Owner
# -1	| Black		|		| Black
#  1	| White		|		| White
#  0	| Blank		| $from		| SEKI
# 99	| Blank (Tmp)	| $to		| None
#-99    | Off Board     |               | --

sub fill_owner {
  my ($board, $pos, $from, $to) = @_;
  my $oval = board_val($board,$pos);
  if ($oval == -99) {
    return $to;
  } elsif ($oval == -1 or $oval == 1) {
    return $oval;
  } elsif ($oval == 99) {
    return 99;
  } else {# if ($oval == 0) {
    set_board_val($board,$pos,$to);
    my $owner = $to;
    my @neighbors = (
      fill_owner($board, add_dir($pos,   $up), $from, $to),
      fill_owner($board, add_dir($pos, $down), $from, $to),
      fill_owner($board, add_dir($pos, $left), $from, $to),
      fill_owner($board, add_dir($pos,$right), $from, $to));
    for my $n (@neighbors) {
      if ($n == $from) { #SEKI (old)
        return $from;
      } elsif ($n == $to) { #NONE
        # Nothing to do
      } else { #Black or White
        if ($owner != $n and $owner != $to) { #SEKI (Initial detection)
#          print "At: ";printP($pos);
#          print "   Owner: $owner Neighbor: $n  T/F: $to / $from\n";
          return $from
        } else { # first or the same owner (black or white)
          $owner = $n;
        }
      }
    }
    return $owner;
  }
}

sub handshake {
  my ($client,$color) = @_;
  print $client "Welcome to the GO arena $ver\n";
  print $client "The board is size $size\n";
  while ($color == 0) {
    print $client "Please choose which color you would like to play as:\n";
    my $color_str = <$client>;
    return ("",0) if not defined $color_str;
    chomp $color_str;
    $color_str = lc $color_str;
    $color = -1 if $color_str =~ /black/;
    $color =  1 if $color_str =~ /white/;
    if ($color == 0) {
      print $client "Invalid color selection, please choose white or black\n";
    }
  }
  print $client "You are black\n" if $color == -1;
  print $client "You are white\n" if $color == 1;
  print $client "Please type OK to accept:\n";
  my $line = <$client>;
  if (defined $line and $line =~ /^OK\b/) {
    print $client "Please enter a short identifier for yourself:\n";
    my $id = <$client>;
    chomp $id;
    return ($id,$color);
  } else {
    return ("",0);
  }
}

sub get_move {
  my $client = shift;
  print $client "MOVE:\n";
  my $line = <$client>;
  return [ -2, -2 ] if not defined($line);
  return [ -2, -2 ] if $line =~ /QUIT/;
  return [ -1, -1 ] if $line =~ /PASS/;
  $line =~ /(\d*) x (\d*)/;
  return [ $1, $2 ] if defined($1) and defined($2);
  return [ -1, -1 ];
}

sub send_result {
  my ($client,$valid) = @_;
  select ($client);
  print "Valid move\n" if $valid;
  print "Invalid move\n" if not $valid;
  select STDOUT;
}

sub send_board {
  my ($client,$board) = @_;
  select ($client);
  print "Current board\n";
  printBsimp($board);
  select STDOUT;
}

$|=1;

my $sock;

if (defined $socket) {

  print "Using domain $socket\n";
  # yep, I know, very not secure.
  unlink $socket if defined $socket and -e $socket and $socket =~/\.sock$/;

  $sock = IO::Socket::UNIX->new(Type => SOCK_STREAM,
				 Local => $socket,
				 Listen => 5)
	or die "Can't create socket!";
} else {
  print "Using port $port\n";
  $sock = IO::Socket::INET->new(LocalPort => $port,
				 Listen => 5,
				 Proto => 'tcp',
				 Reuse => 1)
	or die "Can't create socket!";
}

my $p;
my $color = 0;

for my $cnt (0..1) {
  $p->[$cnt]{'id'} = "";
  while ($p->[$cnt]{'id'} eq "") {
    print "Waiting for First player...";
    $p->[$cnt]{'sock'} = $sock->accept;
    print "Connected...Handshaking...";
    ($p->[$cnt]{'id'},$p->[$cnt]{'color'}) = handshake($p->[$cnt]{'sock'},$color);
    print "Failed Handshake\n" if $p->[$cnt]{'id'} eq "";
  }
  print "Got it!\n";

  print "Player ",$cnt+1," (";
  print "black" if $p->[$cnt]{'color'} == -1;
  print "white" if $p->[$cnt]{'color'} ==  1;
  print ") connected as: ",$p->[$cnt]{'id'},"\n";
  $color = $p->[$cnt]{'color'} * -1;
}

$|=0;

# close off everything.
undef $sock;
unlink $socket if defined $socket and -e $socket and $socket =~/\.sock$/;

my $board = newB;

print "Game started at $size x $size.\n";

$board->{'white'} += $komi;

my $valid = 0;
my $who = -1;
my $lastmove = [ -2, -2 ];
my $move = [ -2, -2 ];

# -99 draw
# 0 none
# 1 White
# -1 Black
my $winner = 0;

# -99 player quit
# 0 none
# 1 normal
my $wintype = 0;

my @socks;
if ($p->[0]{'color'} == -1) {
  $socks[0] = $p->[0]{'sock'};
  $socks[2] = $p->[1]{'sock'};
} else {
  $socks[0] = $p->[1]{'sock'};
  $socks[2] = $p->[0]{'sock'};
}

$|=1;

my $test = $p->[0]{'sock'};
print $test "Starting game\n";
$test = $p->[1]{'sock'};
print $test "Starting game\n";

send_board($socks[$who+1],$board);

while ($board->{'f'} > 0 and $winner == 0 and not (is_pass($lastmove) and is_pass($move))) {
  if ($valid == 1) {
    $who *= -1;
    $lastmove = $move;
    send_board($socks[$who+1],$board);
  }
  $move = get_move($socks[$who+1]);
  if (pos_equal($move, [-2,-2])) {
    print "\nWhite player quit! -- Black wins!\n" if $who == 1;
    print "\nBlack player quit! -- White wins!\n" if $who ==-1;
    $winner = $who * -1;
    $wintype = -99;
  };
  (print "$who : ",printP($move)) if $verbose == 2;
  ($valid,$board) = do_move($board,$move,$who);
  send_result($socks[$who+1],$valid);
  print "." if $valid and $verbose == 1;
  print "#" if not $valid and $verbose == 1;
}

$|=0;
print "\n";

$board = tally_final_score($board);
print "Score Black: ",$board->{'black'},"\n";
print "Score White: ",$board->{'white'},"\n";

print "Final board:\n";
printB($board) if $verbose;

# if there wasn't already a winner determined (e.g. someone quit the game)
if ($winner == 0) {
  $winner = -99, $wintype = 1 if $board->{'black'} == $board->{'white'};
  $winner =  -1, $wintype = 1 if $board->{'black'}  > $board->{'white'};
  $winner =   1, $wintype = 1 if $board->{'black'}  < $board->{'white'};
}

select $p->[0]{'sock'};
print "Draw, no winner\n" if $winner == -99;
print "Black wins!\n" if $winner == -1;
print "White wins!\n" if $winner ==  1;
select $p->[1]{'sock'};
print "Draw, no winner\n" if $winner == -99;
print "Black wins!\n" if $winner == -1;
print "White wins!\n" if $winner ==  1;
--------------------
go-client.pl file begins:
--------------------
#!/usr/bin/perl -w
use strict;
use IO::Socket;

my $address = shift;

if (not $address) {
  print "This program connects to a GO server and plays, but only\n";
  print "sends random moves in.\n";
  print "Just needs one parameter, either a location or domain socket name\n";
  print "Example:  ./go-client.pl localhost:7179  or ./go-client.pl go-server.sock\n";
  exit;
}

# multiplier on how many moves to make before giving up
my $timeout = 2;

my $server;

if ($address =~ /\.sock$/ and -e $address) {
  $server = IO::Socket::UNIX->new(Type => SOCK_STREAM,
                                  Peer => $address);
} else {
  if ($address =~/:/) {
    $server = IO::Socket::INET->new($address);
  } else {
    $server = IO::Socket::INET->new("$address:7179");
  }
}

die "Can't connect to server!" unless $server;

my $done = 0;
my $line;
my $size = 1;
while ($done < $size*$size * ($timeout+0.1)) {
  while (defined ($line = <$server>) and not $line =~/:/) { 
    if ($done == 0) {
      $line =~ /size (\d*)/;
      $size = $1 if defined $1;
    };
    print $line if $done <= 1;
  };
  last if not defined $line;
  print $line if $done <= 1;
  print $server "OK\n" if $done == 0;
  print $server "Random v1.0\n" if $done == 1;
  my $move = [ int (rand $size), int (rand $size) ];
  if ($done < $size*$size * $timeout) {
    print $server $move->[0]," x ",$move->[1],"\n" if $done >1;
    print $move->[0]," x ",$move->[1],"\n" if $done >1;
  } else {
    print $server "PASS\n" if $done >1;
    print "PASS\n" if $done >1;
  }
  $done++;
}

print $server "QUIT\n";

--------------------
go-proto.txt file begins:
--------------------
This text file describes the protocol used for a go-client to connect and play
a game on the go-server.

Please forgive me if it's a horrid description.

There are two phases to the protocol, the handshake, and the actual game play.
Additionally, any line ending with a colon is an indicator that the server is
requesting a response from the client.


Handshake:

The initial broadcast from the server appears like this:

Welcome to the GO server 0.1
You are black
The board is size 19
Please type OK to accept:

The client is expected to reply with the string "OK" (followed by a newline),
the response is case sensitive.

The client will then be asked to identify himself, this is for game logging,
and is not given to the opponent (at least not until the end of the game).
(e.g. 'Killer-GO-AI v0.2a (Adam Luter)'):

Please enter a short identifier for yourself:

After replying to this request, the server will start the game (there may be a
long delay while you wait for the other player to connect).

Also of note, is that the server may ask you what color you want to be,
and appropriate response is black or white.


Actual Game:

The actual game playing starts with a board state declaration, and then a
request for a move:

Current board
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
...................
.
MOVE:

Please note that the line with a single '.' is to indicate the end of the
board display.  Black peices are represented as an 'X' and white as 'O'.  If
there is some sort of processing error a '?' may appear on the board state.
The server does not check for these, and the client isn't really expected to
either, they are present only for debugging the server code.

The move response should be in the form of: "number x number" such as "2 x 3".
Note that moves are zero based, so that "0 x 0" is the upper left corner.
(if you send an improperly formated response, the server defaults to a pass)

Also, there are two special moves.  The first is "PASS" which indicates the
wish to pass your turn.  If both players pass their turn, the game will end.
The game does not check for the number of valid moves left, so this is the
only terminating condition.  It is recommended that your client time out a
game after some large number of moves, or realize an end game state.

The other move "QUIT" indicates the client has quit for some reason.  This
is merely done for politeness, and the server will handle a broken connection
the same way as a "QUIT" response.

When a move is sent, the server will reply with either invalid or valid move.
If the move was invalid the client is allowed to try again indefinately.  This
feature may be turned off in later versions, once clients have become smart
enough.

When the game ends, the server will print to -its- display the score, and if
anyone quit, also who wins (which can be different from the score, if someone
quit).  It will also communicate who won to the client.

Note that the server runs on port 7179 by default, unless you change it.

If you want to figure this out, the easiest way is to simply play by hand with
the command:  telnet serversaddress 7179   this will allow you to play against
your own computer opponent, and also let you see how the text flow works.

Enjoy.