#! /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 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 2.     #
#                                                               #
# 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., 59 Temple Place - Suite 330,       #
# Boston, MA 02111, USA.                                        #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# Here is a small perlscript twogtp. Its purpose is to run
# two programs against each other. Both must support the Go
# Text Protocol. For example GNU Go 2.7.241 or higher works.
#
# It is easier to implement this program in gtp than gmp.
# The script is almost trivial. It also works with cygwin on
# windows.
# 
# Run with:
# 
# twogtp --white '<path to program 1> --mode gtp <options>' \
#        --black '<path to program 2> --mode gtp <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>
#
#

use IPC::Open2;
use Getopt::Long;
use FileHandle;

my $white;
my $black;
my $size = 19;
my $verbose = 0;
my $komi = 5.5;
my $handicap = 0;
my $games = 1;

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>

";

GetOptions(
           "white|w=s"              => \$white,
           "black|b=s"              => \$black,
           "verbose|v=i"            => \$verbose,
           "komi|k=f"               => \$komi,
           "handicap|h=i"           => \$handicap,
           "size|boardsize|s=i"     => \$size,
           "sgffile|o=s"            => \$sgffilename,
           "games=i"                => \$games
);

die $helpstring unless defined $white and defined $black;

# create FileHandles
#my $black_in;
my $black_in  = new FileHandle;		# stdin of black player
my $black_out = new FileHandle;		# stdout of black player
my $white_in  = new FileHandle;		# stdin of white player
my $white_out = new FileHandle;		# stdout of white player

while ($games > 0) {
    $pidb = open2($black_out, $black_in, $black);
    print "black pid: $pidb\n" if $verbose;
    $pidw = open2($white_out, $white_in, $white);
    print "white pid: $pidw\n" if $verbose;
    $sgffile = rename_sgffile($games, $sgffilename) if defined $sgffilename;

    if ((defined $sgffilename) && !open(SGFFILEHANDLE, ">$sgffile")) {
	printf("can't open $sgffile\n");
	undef($sgffilename);
    }
    
    print $black_in  "boardsize $size\n";
    eat_no_response($black_out);
    print $black_in  "komi $komi\n";
    eat_no_response($black_out);

    print $white_in  "boardsize $size\n";
    eat_no_response($white_out);
    print $white_in  "komi $komi\n";
    eat_no_response($white_out);
    
    print SGFFILEHANDLE "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]"
	if defined $sgffilename;
    
    my $pass = 0;
    my ($move, $toplay);

    if ($handicap < 2) {
	$toplay = 'B';
    }
    else {
	$toplay = 'W';
	print $black_in "fixed_handicap $handicap\n";
	$handicap_stones = eat_handicap($black_out);
	if (defined $sgffilename) {
	    print SGFFILEHANDLE $handicap_stones;
	}
	print $white_in "fixed_handicap $handicap\n";
	$handicap_stones = eat_handicap($white_out);
    }
    while ($pass < 2) {
	if ($toplay eq 'B') {
	    print $black_in "genmove_black\n";
	    $move = eat_move($black_out);
	    $sgfmove = standard_to_sgf($move);
	    print SGFFILEHANDLE ";B[$sgfmove]\n" if defined $sgffilename;
	    print "Black plays $move\n" if $verbose;
	    if ($move =~ /PASS/i) {
		$pass++;
	    } else {
		$pass = 0;
	    }
	    print $white_in "black $move\n";
	    eat_no_response($white_out);
	    if ($verbose > 1) {
		print $white_in "showboard\n";
		eat_no_response($white_out);
	    }
	    $toplay = 'W';
	} else {
	    print $white_in "genmove_white\n";
	    $move = eat_move($white_out);
	    $sgfmove = standard_to_sgf($move);
	    print SGFFILEHANDLE ";W[$sgfmove]\n" if defined $sgffilename;
	    print "White plays $move\n" if $verbose;
	    if ($move =~ /PASS/i) {
		$pass++;
	    } else {
		$pass = 0;
	    }
	    print $black_in "white $move\n";
	    eat_no_response($black_out);
	    if ($verbose > 1) {
		print $black_in "showboard\n";
		eat_no_response($black_out);
	    }
	    $toplay = 'B';
	}
    }
    print $white_in "estimate_score\n";
    $resultw = eat_score($white_out);
    print "Result according to W: $resultw\n";
    print $black_in "new_score\n";
    $resultb = eat_score($black_out);
    print "Result according to B: $resultb\n";
    print $white_in "quit\n";
    print $black_in "quit\n";
    if (defined $sgffilename) {
	print "sgf file: $sgffile\n";
	close SGFFILEHANDLE;
    }
    $games-- if $games > 0;
    print "games remaining: $games\n";
}

sub eat_no_response {
    my $h = shift;

# ignore empty lines
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
    }
}

sub eat_move {
    my $h = shift;
# ignore empty lines
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
    }
    $line =~ s/\s*$//;
    my ($equals, $move) = split(' ', $line, 2);
    $line = <$h>;
    return $move;
}

sub eat_handicap {
    my $h = shift;
    my $sgf_handicap = "AB";
# ignore empty lines, die if process is gone
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
    }
    @vertices = split(" ", $line);
    foreach $vertex (@vertices) {
	if (!($vertex eq "=")) {
	    $vertex = standard_to_sgf($vertex);
	    $sgf_handicap = "$sgf_handicap\[$vertex\]";
	}
    }		
    return "$sgf_handicap;";
}

sub eat_score {
    my $h = shift;
# ignore empty lines, die if process is gone
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
    }
    $line =~ s/\s*$//;
    my ($equals, $result) = split(' ', $line, 2);
    $line = <$h>;
    return $result;
}

sub standard_to_sgf {
    for (@_) { tr/A-Z/a-z/ };
    $_ = shift(@_);
    /([a-z])([0-9]+)/;
    return "tt" if $_ eq "pass";
    
    $first = ord $1;
    if ($first > 104) {
	$first = $first - 1;
    }
    $first = chr($first);
    $second = chr($size+1-$2+96);
    return "$second$first";
}

sub rename_sgffile {
    my $nogames = int shift(@_);
    $_ = shift(@_);
    s/\.sgf$//;
    return "$_.sgf" if ($nogames == 1);
    return "$_$nogames.sgf";
}


