--------------------
README file begins:
--------------------
The main program is go-arena.pl, and a sample client is in go-client.p
+l.
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 s
+erver
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 t
+o test
their ideas on how well an AI can perform, in order to make programmer
+s better
at AI programming :) (which is a good thing).
Anyway enjoy, send clients to me if you would like me to run tournamen
+ts
(until we have the server better setup to do so itself) my email addre
+ss 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 t
+o play\n";
print "a game of GO from clients which follow a simple text-line pro
+tocol\n";
print "described in go-proto.txt\n";
print "Tt will only play one game, defaults to size 19, and spits th
+e scoring\n";
print "information back to the terminal. (you can change the size b
+y\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 o
+ption)\n";
print " --socket,-s Local domain socket (only local connec
+tion)\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 boa
+rd state.
# b = a 2d array that shows the positions of the stones with the follo
+wing 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 pr
+ocessing)
# 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 th
+is
# buffer, setting it to -1 will allow infinite boards -- ho
+wever
# for KO detection to work, we always store the last 2 boar
+ds.
# (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 va
+lue.
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 sti
+ll
# 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 b
+lack\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 =~/\.so
+ck$/;
$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]{'soc
+k'},$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 g
+ame)
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 ga
+me play.
Additionally, any line ending with a colon is an indicator that the se
+rver 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 ne
+wline),
the response is case sensitive.
The client will then be asked to identify himself, this is for game lo
+gging,
and is not given to the opponent (at least not until the end of the ga
+me).
(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 the
+n 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 s
+tate.
The server does not check for these, and the client isn't really expec
+ted 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 corn
+er.
(if you send an improperly formated response, the server defaults to a
+ pass)
Also, there are two special moves. The first is "PASS" which indicate
+s the
wish to pass your turn. If both players pass their turn, the game wil
+l 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 o
+ut 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 con
+nection
the same way as a "QUIT" response.
When a move is sent, the server will reply with either invalid or vali
+d move.
If the move was invalid the client is allowed to try again indefinatel
+y. 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 i
+t.
If you want to figure this out, the easiest way is to simply play by h
+and 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 wor
+ks.
Enjoy.
|