#!/usr/bin/perl
# $Id: engine-engine-match.pl 341 2006-08-13 19:55:29Z holger $
#
# TODO
# o time control
# o handle more engine output
#

use warnings;
use strict;

use IO::Handle;
use IO::Select;
use IPC::Open3;
use Time::HiRes;
use Getopt::Long;


###############################################################################
# parse command line 
#

my ($opt_fcp, $opt_fd, $opt_scp, $opt_sd);
my ($opt_tc, $opt_mps, $opt_inc) = (5, 40, -1);
my ($opt_sgf);

my $getopt_res = GetOptions(
	"fcp=s" => \$opt_fcp,
	"fd=s" => \$opt_fd,
	"scp=s" => \$opt_scp,
	"sd=s" => \$opt_sd,

	"tc=i" => \$opt_tc,
	"mps=i" => \$opt_mps,
	"inc=i" => \$opt_inc,
	
	"sgf=s" => \$opt_sgf,
);

if (!$opt_fcp) { 
	die("you must set fcp");
}
if (!$opt_scp) {
	die("you must set scp");
}


###############################################################################

my $first = {
	id => "first ",
	cmd => $opt_fcp,
	dir => $opt_fd,
	name => $opt_fcp,
	pingseq => 1,
	firstmove => 1,
};

my $second = {
	id => "second",
	cmd => $opt_scp,
	dir => $opt_sd,
	name => $opt_scp,
	pingseq => 1,
	firstmove => 1,
};

###############################################################################

my $start_time = Time::HiRes::time();


start_engine($first);
init_engine($first);
start_engine($second);
init_engine($second);

my @moves;
my $result = "*";
my $result_comment = "Unknown reason";

my $engine = $first;
my $move;

my $state = 'START';
my ($ff, $fs) = ('', '');
	
loop_main: while (1) {
#	print("loop_main, state = $state\n");

	if ($state eq 'START') {
		send_to_engine($first, "go\n");
		$state = 'WAITMOVEFIRST';
	} elsif ($state eq 'WAITMOVEFIRST') {
		if ($ff =~ /^move ([\w-]+)$/) {
			my $move = $1;
			push(@moves, $move);
			send_to_engine($second, "$move\n");
			$state = 'WAITMOVESECOND';
		}
		if ($fs =~ /^move ([\w-]+)$/) {
			logmsg("### error: move out of turn by second\n");
			last loop_main;
		}
	} elsif ($state eq 'WAITMOVESECOND') {
		if ($fs =~ /^move ([\w-]+)$/) {
			my $move = $1;
			push(@moves, $move);
			send_to_engine($first, "$move\n");
			$state = 'WAITMOVEFIRST';
		}
		if ($ff =~ /^move ([\w-]+)$/) {
			logmsg("### error: move out of turn by first\n");
			last loop_main;
		}
	} elsif ($state eq 'RESULT') {
		if ($opt_sgf) {
			logmsg("### writing $opt_sgf\n");
			write_pgn($opt_sgf);
			logmsg("### game is over\n");
		}
		last loop_main;
	} else {
		die("illegal state: $state");
	}
	
	($ff, $fs) = rcve_from_both();

	if ($ff =~ /^1-0 {(.*)}/  ||  $fs =~ /^1-0 {(.*)}/) {
		$result = '1-0';
		$result_comment = $1;
		$state = 'RESULT';
	} elsif ($ff =~ /^0-1 {(.*)}/  ||  $fs =~ /^0-1 {(.*)}/) {
		$result = '0-1';
		$result_comment = $1;
		$state = 'RESULT';
	} elsif ($ff =~ /^1\/2-1\/2 {(.*)}/  ||  $fs =~ /^1\/2-1\/2 {(.*)}/) {
		$result = '1/2-1/2';
		$result_comment = $1;
		$state = 'RESULT';
	}
	
}

logmsg("### terminating first\n");
send_to_engine($first, "quit\n");
logmsg("### terminating second\n");
send_to_engine($second, "quit\n");
#logmsg("### waiting for first to terminate\n");
#waitpid($first->{pid}, 0);
#logmsg("### waiting for second to terminate\n");
#waitpid($second->{pid}, 0);


###############################################################################

sub start_engine {
	my ($engine) = @_;

	my $cmd = "";
	if ($engine->{dir}) {
		$cmd .= "cd '$engine->{dir}' && ";
	}
	$cmd .= $engine->{cmd};
	logmsg("### starting $engine->{id}: $cmd\n");
		
	eval {
		my ($fho, $fhi);
		
		$engine->{pid} = open3($fho, $fhi, $fhi, $cmd);
		$engine->{fho} = $fho;
		$engine->{fhi} = $fhi;
	};
	if ($@ =~ /^open2:/) {
		die("open2 failed: $@\n");
	}
}

sub send_to_engine {
	my ($engine, $cmd) = @_;

	logmsg(">$engine->{id}: $cmd");
	my $fho = $engine->{fho};
	$fho->autoflush(1);
	print($fho $cmd);
}

sub rcve_from_engine {
	my ($engine) = @_;

	my $fhi = $engine->{fhi};
	my $line = <$fhi>;
	logmsg("<$engine->{id}: $line");
	return $line;
}

sub init_engine {
	my ($engine) = @_;
		
	#send_to_engine($engine, "xboard\nprotover 2\n");
	send_to_engine($engine, "xboard\n");
	send_to_engine($engine, "protover 2\n");
	while (1) {
		my $l = rcve_from_engine($engine);
		if ($l =~ /done=1/) {
			last;
		}
	}

	#send_to_engine($engine, "new\nrandom\n");
	send_to_engine($engine, "new\n");
	send_to_engine($engine, "random\n");
	
	if ($opt_inc < 0) {
		send_to_engine($engine, "level $opt_mps $opt_tc 0\n");
	} else {
		send_to_engine($engine, "level 0 $opt_tc $opt_inc\n");
	}
	
	send_to_engine($engine, "post\n");
	send_to_engine($engine, "hard\n");
	send_to_engine($engine, "easy\n");
	ping_engine($engine);
	send_to_engine($engine, "force\n");
}

sub ping_engine {
	my ($engine) = @_;
	
	send_to_engine($engine, "ping $engine->{pingseq}\n");
	while (1) {
		my $l = rcve_from_engine($engine);
		if ($l =~ /^pong $engine->{pingseq}/) {
			last;
		}
	}

	$engine->{pingseq}++;
}

sub rcve_from_both {
	my ($ff, $fs) = ('', '');

	my $sel = new IO::Select($first->{fhi}, $second->{fhi});
	my @ready = $sel->can_read();

	foreach my $fh (@ready) {
		if ($fh == $first->{fhi}) {
			$ff = rcve_from_engine($first);
		} elsif ($fh == $second->{fhi}) {
			$fs = rcve_from_engine($second);
		}
	}
	
	return ($ff, $fs);
}

###############################################################################

sub write_pgn {
	my ($pgnfile) = @_;
	
	open(FH, ">$pgnfile") 
		or die("$0: Cannot open $pgnfile for writing: $!");
	
	print(FH "[Event \"unknown\"]\n");
	print(FH "[Site \"unknown\"]\n");
	
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
	printf(FH "[Date \"%4d.%02d.%02d\"]\n", $year+1900, $mon+1, $mday);
	
	print(FH "[Round \"unknown\"]\n");

	my $fn = $first->{name};  $fn =~ s/\\/\\\\/g; $fn =~ s/"/\\"/g;
	my $sn = $second->{name}; $sn =~ s/\\/\\\\/g; $sn =~ s/"/\\"/g;
	print(FH "[White \"$fn\"]\n");
	print(FH "[Black \"$sn\"]\n");
	
	print(FH "[Result \"$result\"]\n");
	
	print(FH "\n");
	
	my $i = 0; my $nc = 0;
	foreach my $m (@moves) {
		my $s;
		if ($i%2 == 0) {
			$s = sprintf("%d. %s ", $i/2 + 1, $m);
		} else {
			$s = sprintf("%s ", $m);
		}	
		print(FH $s);

		$nc += length($s);
		if ($nc > 70) {
			print(FH "\n");
			$nc = 0;
		}
		
		$i++;
	}

	print(FH "\n");
	print(FH "$result {$result_comment}\n");

	close(FH);
}

sub logmsg {
	my ($msg) = @_;
	
	my $now_time = Time::HiRes::time();
	STDOUT->autoflush(1);
	printf("%d %s", ($now_time-$start_time)*1000, $msg);
}
