#! /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;