575 lines
13 KiB
Perl
575 lines
13 KiB
Perl
#! /usr/bin/perl -w
|
|
|
|
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
|
|
# This program is distributed with GNU Go, a Go program. #
|
|
# #
|
|
# Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ #
|
|
# for more information. #
|
|
# #
|
|
# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 #
|
|
# 2008 and 2009 by the Free Software Foundation. #
|
|
# #
|
|
# This program is free software; you can redistribute it and/or #
|
|
# modify it under the terms of the GNU General Public License #
|
|
# as published by the Free Software Foundation - version 3, #
|
|
# or (at your option) any later version. #
|
|
# #
|
|
# This program is distributed in the hope that it will be #
|
|
# useful, but WITHOUT ANY WARRANTY; without even the implied #
|
|
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR #
|
|
# PURPOSE. See the GNU General Public License in file COPYING #
|
|
# for more details. #
|
|
# #
|
|
# You should have received a copy of the GNU General Public #
|
|
# License along with this program; if not, write to the Free #
|
|
# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, #
|
|
# Boston, MA 02111, USA. #
|
|
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
|
|
|
|
package GTP;
|
|
|
|
use strict;
|
|
|
|
my $debug = 0;
|
|
|
|
sub exec_cmd {
|
|
my $hin = shift;
|
|
my $hout = shift;
|
|
my $cmd = shift;
|
|
|
|
# send the command to the GTP program
|
|
|
|
print $hin "$cmd\n";
|
|
|
|
# parse the response of the GTP program
|
|
|
|
my $line;
|
|
my $repchar;
|
|
my $result = "ERROR";
|
|
$line = <$hout>;
|
|
print STDERR "$hin 1:$line" if ($debug);
|
|
return "ERROR" unless (defined $line);
|
|
$line =~ s/\s*$//;
|
|
($repchar, $result) = split(/\s*/, $line, 2);
|
|
print STDERR "$hin 2:repchar $repchar\n" if ($debug);
|
|
print STDERR "$hin 3:result $result\n" if ($debug);
|
|
|
|
$line = <$hout>;
|
|
while (!($line =~ /^\s*$/)) {
|
|
$result .= $line;
|
|
$line = <$hout>;
|
|
}
|
|
print STDERR "$hin 4:$line" if ($debug);
|
|
if ($repchar eq '?') {
|
|
return "ERROR";
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub standard_to_sgf {
|
|
|
|
my $size = shift;
|
|
my $board_coords = shift;
|
|
$board_coords =~ tr/A-Z/a-z/;
|
|
return "" if ($board_coords eq "pass");
|
|
my $first = substr($board_coords, 0, 1);
|
|
my $number = substr($board_coords, 1);
|
|
my $sgffirst;
|
|
if ($first gt 'i') {
|
|
$sgffirst = chr(ord($first) - 1);
|
|
} else {
|
|
$sgffirst = $first;
|
|
}
|
|
my $sgfsecond = chr(ord('a') + $size - $number);
|
|
# print "$board_coords, $sgffirst, $number, $sgfsecond\n";
|
|
return $sgffirst . $sgfsecond;
|
|
}
|
|
|
|
package GTP::Player;
|
|
|
|
use strict;
|
|
use Class::Struct;
|
|
use FileHandle;
|
|
use IPC::Open2;
|
|
|
|
struct('GTP::Player' => {
|
|
'in' => 'FileHandle',
|
|
'out' => 'FileHandle',
|
|
'gtp_version' => '$',
|
|
}
|
|
);
|
|
|
|
sub init {
|
|
my $self = shift;
|
|
return $self;
|
|
}
|
|
|
|
sub initialize {
|
|
my $self = shift;
|
|
my $cmd = shift;
|
|
|
|
my $pid = open2($self->{out}, $self->{in}, $cmd);
|
|
$self->{gtp_version} = GTP::exec_cmd($self->{in},
|
|
$self->{out}, "protocol_version");
|
|
$self->{gtp_version} eq 1 or $self->{gtp_version} eq 2 or
|
|
die "Unsupported gtp version $self->{gtp_version}\n";
|
|
return $pid;
|
|
}
|
|
|
|
sub genmove {
|
|
my $self = shift;
|
|
my $color = shift;
|
|
|
|
my $cmd;
|
|
if ($self->{gtp_version} eq 1) {
|
|
$cmd = "genmove_";
|
|
} else {
|
|
$cmd = "genmove ";
|
|
}
|
|
if ($color =~ /^b/i) {
|
|
$cmd .= "black";
|
|
} elsif ($color =~ /^w/i) {
|
|
$cmd .= "white";
|
|
} else {
|
|
die "Illegal color $color\n";
|
|
}
|
|
my $move = GTP::exec_cmd($self->{in}, $self->{out}, $cmd);
|
|
}
|
|
|
|
sub black {
|
|
my $self = shift;
|
|
my $move = shift;
|
|
my $cmd;
|
|
if ($self->{gtp_version} eq 1) {
|
|
$cmd = "black ";
|
|
} else {
|
|
$cmd = "play black ";
|
|
}
|
|
|
|
GTP::exec_cmd($self->{in}, $self->{out}, $cmd . $move);
|
|
}
|
|
|
|
sub white {
|
|
my $self = shift;
|
|
my $move = shift;
|
|
my $cmd;
|
|
if ($self->{gtp_version} eq 1) {
|
|
$cmd = "white ";
|
|
} else {
|
|
$cmd = "play white ";
|
|
}
|
|
|
|
GTP::exec_cmd($self->{in}, $self->{out}, $cmd . $move);
|
|
}
|
|
|
|
sub komi {
|
|
my $self = shift;
|
|
my $komi = shift;
|
|
|
|
GTP::exec_cmd($self->{in}, $self->{out}, "komi $komi");
|
|
}
|
|
|
|
sub boardsize {
|
|
my $self = shift;
|
|
my $size = shift;
|
|
|
|
GTP::exec_cmd($self->{in}, $self->{out}, "boardsize $size");
|
|
}
|
|
|
|
sub clear_board {
|
|
my $self = shift;
|
|
|
|
GTP::exec_cmd($self->{in}, $self->{out}, "clear_board");
|
|
}
|
|
|
|
sub handicap {
|
|
my $self = shift;
|
|
my $handicap = shift;
|
|
|
|
my $stones;
|
|
$stones = GTP::exec_cmd($self->{in}, $self->{out}, "handicap $handicap");
|
|
return split(' ', $stones);
|
|
}
|
|
|
|
sub fixed_handicap {
|
|
my $self = shift;
|
|
my $handicap = shift;
|
|
|
|
my $stones;
|
|
$stones = GTP::exec_cmd($self->{in}, $self->{out}, "fixed_handicap $handicap");
|
|
return split(' ', $stones);
|
|
}
|
|
|
|
sub quit {
|
|
my $self = shift;
|
|
|
|
$self->{in}->print("quit\n");
|
|
}
|
|
|
|
sub showboard {
|
|
my $self = shift;
|
|
my $board;
|
|
|
|
$board = GTP::exec_cmd($self->{in}, $self->{out}, "showboard");
|
|
|
|
if ($self->{gtp_version} eq 2) {
|
|
print $board;
|
|
}
|
|
}
|
|
|
|
sub get_random_seed {
|
|
my $self = shift;
|
|
|
|
my $ret = GTP::exec_cmd($self->{in}, $self->{out}, "get_random_seed");
|
|
if ($ret eq "ERROR") {
|
|
return "unknown";
|
|
}
|
|
my ($result, $rest) = split(' ', $ret, 2);
|
|
return $result;
|
|
}
|
|
|
|
sub get_program_name {
|
|
my $self = shift;
|
|
|
|
my $name = GTP::exec_cmd($self->{in}, $self->{out}, "name");
|
|
my $version = GTP::exec_cmd($self->{in}, $self->{out}, "version");
|
|
return "$name $version";
|
|
}
|
|
|
|
sub score {
|
|
my $self = shift;
|
|
|
|
return GTP::exec_cmd($self->{in}, $self->{out}, "score");
|
|
}
|
|
|
|
sub final_score {
|
|
my $self = shift;
|
|
|
|
my $ret = GTP::exec_cmd($self->{in}, $self->{out}, "final_score");
|
|
my ($result, $rest) = split(' ', $ret, 2);
|
|
return $result;
|
|
}
|
|
|
|
package GTP::Game::Result;
|
|
|
|
use strict;
|
|
use Class::Struct;
|
|
use FileHandle;
|
|
|
|
struct('GTP::Game::Result' => {
|
|
'resultw' => '$',
|
|
'resultb' => '$'
|
|
}
|
|
);
|
|
|
|
package GTP::Game;
|
|
|
|
use strict;
|
|
use Class::Struct;
|
|
use FileHandle;
|
|
|
|
struct('GTP::Game' => {
|
|
'black' => 'GTP::Player',
|
|
'white' => 'GTP::Player',
|
|
'size' => '$',
|
|
'komi' => '$',
|
|
'handicap' => '$',
|
|
'handicap_stones' => '@',
|
|
'moves' => '@',
|
|
'result' => 'GTP::Game::Result'
|
|
}
|
|
);
|
|
|
|
my $verbose = 0;
|
|
|
|
sub verbose {
|
|
my $self = shift;
|
|
my $verbose_arg = shift;
|
|
|
|
$verbose = $verbose_arg;
|
|
}
|
|
|
|
sub writesgf {
|
|
my $self = shift;
|
|
my $sgffile = shift;
|
|
|
|
my $size = $self->size;
|
|
|
|
my $handle = new FileHandle;
|
|
$handle->open(">$sgffile") or
|
|
die "Can't write to $sgffile\n";
|
|
my $black_name = $self->black->get_program_name;
|
|
my $white_name = $self->white->get_program_name;
|
|
my $black_seed = $self->black->get_random_seed;
|
|
my $white_seed = $self->white->get_random_seed;
|
|
my $handicap = $self->handicap;
|
|
my $komi = $self->komi;
|
|
my $result = $self->{result}->resultw;
|
|
|
|
print $handle "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]RE[$result]\n";
|
|
print $handle "PW[$white_name (random seed $white_seed)]PB[$black_name (random seed $black_seed)]\n";
|
|
if ($handicap > 1) {
|
|
for my $stone (@{$self->handicap_stones}) {
|
|
printf $handle "AB[%s]", GTP::standard_to_sgf($self->size, $stone);
|
|
}
|
|
print $handle "\n";
|
|
}
|
|
my $toplay = $self->handicap < 2 ? 'B' : 'W';
|
|
for my $move (@{$self->moves}) {
|
|
my $sgfmove = GTP::standard_to_sgf($size, $move);
|
|
print $handle ";$toplay" . "[$sgfmove]\n";
|
|
$toplay = $toplay eq 'B' ? 'W' : 'B';
|
|
}
|
|
print $handle ")\n";
|
|
$handle->close;
|
|
}
|
|
|
|
|
|
|
|
|
|
sub play {
|
|
|
|
my $self = shift;
|
|
my $sgffile = shift;
|
|
|
|
my $size = $self->size;
|
|
my $handicap = $self->handicap;
|
|
my $komi = $self->komi;
|
|
|
|
print "Setting boardsize and komi for black\n" if $verbose;
|
|
$self->black->boardsize($size);
|
|
$self->black->clear_board();
|
|
$self->black->komi($komi);
|
|
|
|
print "Setting boardsize and komi for white\n" if $verbose;
|
|
$self->white->boardsize($size);
|
|
$self->white->clear_board();
|
|
$self->white->komi($komi);
|
|
|
|
my $pass = 0;
|
|
my $resign = 0;
|
|
my ($move, $toplay, $sgfmove);
|
|
|
|
$pass = 0;
|
|
$#{$self->handicap_stones} = -1;
|
|
if ($handicap < 2) {
|
|
|
|
$toplay = 'B';
|
|
|
|
} else {
|
|
|
|
@{$self->handicap_stones} = $self->white->fixed_handicap($handicap);
|
|
for my $stone (@{$self->handicap_stones}) {
|
|
$self->black->black($stone);
|
|
}
|
|
$toplay = 'W';
|
|
|
|
}
|
|
|
|
$#{$self->moves} = -1;
|
|
while ($pass < 2 and $resign eq 0) {
|
|
|
|
if ($toplay eq 'B') {
|
|
|
|
$move = $self->black->genmove("black");
|
|
if ($move eq "ERROR") {
|
|
$self->writesgf($sgffile) if defined $sgffile;
|
|
die "No response!";
|
|
}
|
|
$resign = ($move =~ /resign/i) ? 1 : 0;
|
|
if ($resign) {
|
|
print "Black resigns\n" if $verbose;
|
|
} else {
|
|
push @{$self->moves}, $move;
|
|
print "Black plays $move\n" if $verbose;
|
|
$pass = ($move =~ /PASS/i) ? $pass + 1 : 0;
|
|
$self->white->black($move);
|
|
}
|
|
if ($verbose == 3) {
|
|
my $black_seed = $self->black->get_random_seed;
|
|
printf "Black seed $black_seed\n";
|
|
}
|
|
if ($verbose == 2) {
|
|
$self->white->showboard;
|
|
}
|
|
|
|
$toplay = 'W';
|
|
|
|
} else {
|
|
|
|
$move = $self->white->genmove("white");
|
|
if ($move eq "ERROR") {
|
|
$self->writesgf($sgffile) if defined $sgffile;
|
|
die "No response!";
|
|
}
|
|
$resign = ($move =~ /resign/i) ? 1 : 0;
|
|
if ($resign) {
|
|
print "White resigns\n" if $verbose;
|
|
} else {
|
|
push @{$self->moves}, $move;
|
|
print "White plays $move\n" if $verbose;
|
|
$pass = ($move =~ /PASS/i) ? $pass + 1 : 0;
|
|
$self->black->white($move);
|
|
}
|
|
if ($verbose == 3) {
|
|
my $white_seed = $self->white->get_random_seed;
|
|
printf "White seed $white_seed\n";
|
|
}
|
|
if ($verbose == 2) {
|
|
$self->black->showboard;
|
|
}
|
|
$toplay = 'B';
|
|
|
|
}
|
|
}
|
|
|
|
my $resultb;
|
|
my $resultw;
|
|
if ($resign) {
|
|
$resultb = $toplay eq 'B' ? 'B+R' : 'W+R';
|
|
$resultw = $resultb;
|
|
} else {
|
|
$resultw = $self->white->final_score;
|
|
$resultb = $self->black->final_score;
|
|
}
|
|
if ($resultb eq $resultw) {
|
|
print "Result: $resultw\n";
|
|
} else {
|
|
print "Result according to W: $resultw\n";
|
|
print "****** according to B: $resultb\n";
|
|
}
|
|
$self->{result} = new GTP::Game::Result;
|
|
$self->{result}->resultw($resultw);
|
|
$self->{result}->resultb($resultb);
|
|
$self->writesgf($sgffile) if defined $sgffile;
|
|
}
|
|
|
|
package GTP::Match;
|
|
|
|
use strict;
|
|
use Class::Struct;
|
|
use FileHandle;
|
|
|
|
struct('GTP::Match' => {
|
|
'black' => 'GTP::Player',
|
|
'white' => 'GTP::Player',
|
|
'size' => '$',
|
|
'komi' => '$',
|
|
'handicap' => '$'
|
|
}
|
|
);
|
|
|
|
sub play {
|
|
my $self = shift;
|
|
my $games = shift;
|
|
my $sgffile = shift;
|
|
|
|
my $game = new GTP::Game;
|
|
$game->size($self->size);
|
|
$game->komi($self->komi);
|
|
$game->handicap($self->handicap);
|
|
$game->black($self->black);
|
|
$game->white($self->white);
|
|
$game->komi($self->komi);
|
|
my @results;
|
|
(my $sgffile_base = $sgffile) =~ s/\.sgf$//;
|
|
for my $i (1..$games) {
|
|
my $sgffile_game = sprintf "%s%03d.sgf", $sgffile_base, $i;
|
|
$game->play($sgffile_game);
|
|
my $result = new GTP::Game::Result;
|
|
$result->resultb($game->{result}->resultb);
|
|
$result->resultw($game->{result}->resultw);
|
|
push @results, $result;
|
|
}
|
|
return @results;
|
|
}
|
|
|
|
package main;
|
|
|
|
use strict;
|
|
use Getopt::Long;
|
|
use FileHandle;
|
|
|
|
my $white;
|
|
my $black;
|
|
my $size = 19;
|
|
my $games = 1;
|
|
my $komi;
|
|
my $handicap = 0;
|
|
my $sgffile = "twogtp.sgf";
|
|
|
|
GetOptions(
|
|
"white|w=s" => \$white,
|
|
"black|b=s" => \$black,
|
|
"verbose|v=i" => \$verbose,
|
|
"komi|km=f" => \$komi,
|
|
"handicap|ha=i" => \$handicap,
|
|
"games|g=i" => \$games,
|
|
"sgffile|f=s" => \$sgffile,
|
|
"boardsize|size|s=i" => \$size
|
|
);
|
|
|
|
GTP::Game->verbose($verbose);
|
|
|
|
my $helpstring = "
|
|
|
|
Run with:
|
|
|
|
twogtp --white \'<path to program 1> --mode gtp [program options]\' \\
|
|
--black \'<path to program 2> --mode gtp [program options]\' \\
|
|
[twogtp options]
|
|
|
|
Possible twogtp options:
|
|
|
|
--verbose 1 (to list moves) or --verbose 2 (to draw board)
|
|
--komi <amount>
|
|
--handicap <amount>
|
|
--size <board size> (default 19)
|
|
--games <number of games to play> (-1 to play forever)
|
|
--sgffile <filename>
|
|
";
|
|
|
|
die $helpstring unless defined $white and defined $black;
|
|
|
|
if (!defined $komi) {
|
|
if ($handicap > 0) {
|
|
$komi = 0.5;
|
|
} else {
|
|
$komi = 5.5;
|
|
}
|
|
}
|
|
|
|
# create GTP players
|
|
|
|
my $black_pl = new GTP::Player;
|
|
$black_pl->initialize($black);
|
|
print "Created black GTP player\n" if $verbose;
|
|
|
|
my $white_pl = new GTP::Player;
|
|
$white_pl->initialize($white);
|
|
print "Created white GTP player\n" if $verbose;
|
|
|
|
my $match = new GTP::Match;
|
|
$match->white($white_pl);
|
|
$match->black($black_pl);
|
|
$match->size($size);
|
|
$match->komi($komi);
|
|
$match->handicap($handicap);
|
|
my @results = $match->play($games, $sgffile);
|
|
|
|
my $i=0;
|
|
for my $r (@results) {
|
|
$i++;
|
|
if ($r->resultb eq $r->resultw) {
|
|
printf "Game $i: %s\n", $r->resultw;
|
|
}
|
|
else {
|
|
printf "Game $i: %s %s\n", $r->resultb, $r->resultw;
|
|
}
|
|
}
|
|
|
|
$white_pl->quit;
|
|
$black_pl->quit;
|
|
|
|
|