[sgk-go] / interface / gtp_examples / twogtp-a

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

package TWOGTP_A;

use IPC::Open2;
use Getopt::Long;
use FileHandle;
use strict;
use warnings;
use Carp;

STDOUT->autoflush(1);

#following added globally to allow "use strict" :
my $vertex;
my $first;
my $sgfmove;
my $sgffilename;
my $pidw;
my $pidb;
my $sgffile;
my $handicap_stones;
my $resultw;
my $resultb;
my @vertices;
my $second;
my %game_list;
#end of "use strict" repairs


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

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>
  --help                                  (show this)

";

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,
           "help"                   => \$wanthelp,
);

if ($wanthelp) {
  print $helpstring;
  exit;
}


if (!$white) {
  $white = '../gnugo.exe --mode gtp --quiet';
  warn "Defaulting white to: $white";
}
if (!$black) {
  $black = '../gnugo.exe --mode gtp --quiet';
  warn "Defaulting black to: $black";
}

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
my $b_gtp_ver;				# gtp version of black player
my $w_gtp_ver;				# gtp version 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);
    }
    
    if (!defined $komi) {
        if ($handicap eq 0) {
	    $komi = 5.5;
	}
	else {
	    $komi = 0.5;
	}
    }

    print $black_in  "protocol_version\n";
    $b_gtp_ver = eat_gtp_ver($black_out);
    print $black_in  "boardsize $size\n";
    eat_no_response($black_out);
    print $black_in  "clear_board\n";
    eat_no_response($black_out);
    print $black_in  "komi $komi\n";
    eat_no_response($black_out);

    print $white_in  "protocol_version\n";
    $w_gtp_ver = eat_gtp_ver($white_out);
    print $white_in  "boardsize $size\n";
    eat_no_response($white_out);
    print $white_in  "clear_board\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') {
	    if ($b_gtp_ver eq 1) {
		print $black_in "genmove_black\n";
	    } else {
		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;
	    }
	    if ($w_gtp_ver eq 1) {
		print $white_in "black $move\n";
	    } else {
		print $white_in "play black $move\n";
	    }
	    eat_no_response($white_out);
	    if ($verbose > 1) {
		print $white_in "showboard\n";
		if ($w_gtp_ver eq 2) {
		    eat_showboard($white_out);
		} else {
		    eat_no_response($white_out);
		}
	    }
	    $toplay = 'W';
	} else {
	    if ($w_gtp_ver eq 1) {
		print $white_in "genmove_white\n";
	    } 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;
	    }
	    if ($b_gtp_ver eq 1) {
		print $black_in "white $move\n";
	    } else {
		print $black_in "play white $move\n";
	    }
	    eat_no_response($black_out);
	    if ($verbose > 1) {
		print $black_in "showboard\n";
		if ($b_gtp_ver eq 2) {
		    eat_showboard($black_out);
		} else {
		    eat_no_response($black_out);
		}
	    }
	    $toplay = 'B';
	}
    }
    print $white_in "final_score\n";
    $resultw = eat_score($white_out);
    print "Result according to W: $resultw\n";
    print $black_in "final_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";
	print SGFFILEHANDLE ")";
	close SGFFILEHANDLE;
	$game_list{$sgffile} = $resultw . "|" . $resultb
    }
    $games-- if $games > 0;
    close $black_in;
    close $black_out;
    close $white_in;
    close $white_out;
    waitpid $pidb, 0;
    waitpid $pidw, 0;
    print "games remaining: $games\n";
}

if (defined $sgffilename) {
  my $index_out  = new FileHandle;
  open ($index_out, "> " . index_name($sgffilename));
  print $index_out
"<HTML><HEAD><TITLE>game results</TITLE></HEAD>
<BODY><H3>Game Results</H3>
<H4>White: ".html_encode($white)."</H4>
<H4>Black: ".html_encode($black)."</H4>
<TABLE border=1>
 <TR>
  <TD>SGF file</TD>
  <TD>Result</TD>
 </TR>
";
 foreach (sort by_result keys(%game_list)) {
    print $index_out "<TR><TD><A href=\"$_\">$_</A></TD>" .
    		"<TD>".html_encode(game_result($_))."</TD></TR>\n";
  }
  print $index_out "</TABLE></BODY></HTML>\n";
}

sub game_result {
  $_ = shift;
  $_ = $game_list{$_};
  #i.e.:  B+13.5 (upper bound: -13.5, lower: -13.5)|B+13.5 (upper bound: -13.5, lower: -13.5)
  #Make sure that all 4 values are the same.  I've not seen them different yet.
  #If they are ever different, need to improve the HTML output (now just -999) -
  # an explanation of the score mismatch problem would be appropriate.	
  $_ =~ /^.*upper bound..([0-9+.\-]*)..lower..\1.\|.*upper bound..\1..lower..\1./;
  if (defined($1)) {
    return $1;
  } else {
    return -999;
  }
}

sub by_result {
  game_result($a) <=> game_result($b) || $a cmp $b;
}

sub html_encode {
  #print shift;
  my $r = shift;
  $r =~ s/&/&amp;/g;
  $r =~ s/</&lt;/g;
  $r =~ s/>/&gt;/g;
  return $r;
}


sub eat_no_response {
    my $h = shift;

# ignore empty lines
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
        $line =~ s/(\s|\n)*$//smg;
    }
}

sub eat_move {
    my $h = shift;
# ignore empty lines
    my $line = "";
    while ($line eq "") {
	if (!defined($line = <$h>)) {
	    print SGFFILEHANDLE ")";
	    close SGFFILEHANDLE;
	    die "Engine crashed!\n";
	}
        $line =~ s/(\s|\n)*$//smg;
    }
    my ($equals, $move) = split(' ', $line, 2);
    $line = <$h>;
    defined($move) or confess "no move found: line was: '$line'";
    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*//msg;
	$line =~ s/\s*$//msg;
    }
    $line =~ s/\s*$//;
    my ($equals, $result) = split(' ', $line, 2);
    $line = <$h>;
    return $result;
}

sub eat_gtp_ver {
    my $h = shift;
    my $line = "";

    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
	$line =~ s/^\s*//msg;
	$line =~ s/\s*$//msg;
    }
    $line =~ s/\s*$//;
    my ($equals, $result) = split(' ', $line, 2);
    $line = <$h>;
    return $result;
}

sub eat_showboard {
    my $h = shift;
    my $line = "";

    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
	$line =~ s/^\s*//msg;
	$line =~ s/\s*$//msg;
    }
    $line =~ s/\s*$//;
    my ($equals, $result) = split(' ', $line, 2);

    while (!($line =~ /^\s*$/)) {
	$result .= $line;
	$line = <$h>;
    }
    print STDERR $result;
}

sub standard_to_sgf {
    for (@_) { confess "Yikes!" if !defined($_); }
    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 "$first$second";
}

sub rename_sgffile {
    my $nogames = int shift(@_);
    $_ = shift(@_);
    s/\.sgf$//;
    # Annoying to loose _001 on game #1 in multi-game set.
    # Could record as an additional parameter.
    # return "$_.sgf" if ($nogames == 1);
    return sprintf("$_" . "_%03d.sgf", $nogames);
}

sub index_name {
  $_ = shift;
  s/\.sgf$//;
  return $_ . "_index.html";
}
Commit	Line	Data
7eeb782e AT	1	#! /usr/bin/perl -w
	2
	3	# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
	4	# This program is distributed with GNU Go, a Go program. #
	5	# #
	6	# Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ #
	7	# for more information. #
	8	# #
	9	# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 #
	10	# 2008 and 2009 by the Free Software Foundation. #
	11	# #
	12	# This program is free software; you can redistribute it and/or #
	13	# modify it under the terms of the GNU General Public License #
	14	# as published by the Free Software Foundation - version 3, #
	15	# or (at your option) any later version. #
	16	# #
	17	# This program is distributed in the hope that it will be #
	18	# useful, but WITHOUT ANY WARRANTY; without even the implied #
	19	# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR #
	20	# PURPOSE. See the GNU General Public License in file COPYING #
	21	# for more details. #
	22	# #
	23	# You should have received a copy of the GNU General Public #
	24	# License along with this program; if not, write to the Free #
	25	# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, #
	26	# Boston, MA 02111, USA. #
	27	# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
	28	#
	29	# Here is a small perlscript twogtp. Its purpose is to run
	30	# two programs against each other. Both must support the Go
	31	# Text Protocol. For example GNU Go 2.7.241 or higher works.
	32	#
	33	# It is easier to implement this program in gtp than gmp.
	34	# The script is almost trivial. It also works with cygwin on
	35	# windows.
	36	#
	37	# Run with:
	38	#
	39	# twogtp --white '<path to program 1> --mode gtp <options>' \
	40	# --black '<path to program 2> --mode gtp <options>' \
	41	# [twogtp options]
	42	#
	43	# Possible twogtp options:
	44	#
	45	# --verbose 1 (to list moves) or --verbose 2 (to draw board)
	46	# --komi <amount>
	47	# --handicap <amount>
	48	# --size <board size> (default 19)
	49	# --games <number of games to play> (-1 to play forever)
	50	# --sgffile <filename>
	51	#
	52	#
	53
	54	package TWOGTP_A;
	55
	56	use IPC::Open2;
	57	use Getopt::Long;
	58	use FileHandle;
	59	use strict;
	60	use warnings;
	61	use Carp;
	62
	63	STDOUT->autoflush(1);
	64
65	#following added globally to allow "use strict" :
66	my $vertex;
67	my $first;
68	my $sgfmove;
69	my $sgffilename;
70	my $pidw;
71	my $pidb;
72	my $sgffile;
73	my $handicap_stones;
74	my $resultw;
75	my $resultb;
76	my @vertices;
77	my $second;
78	my %game_list;
79	#end of "use strict" repairs
80
81
82	my $white;
83	my $black;
84	my $size = 19;
85	my $verbose = 0;
86	my $komi;
87	my $handicap = 0;
88	my $games = 1;
89	my $wanthelp;
90
91	my $helpstring = "
92
93	Run with:
94
95	twogtp --white \'<path to program 1> --mode gtp [program options]\' \\
96	--black \'<path to program 2> --mode gtp [program options]\' \\
97	[twogtp options]
98
99	Possible twogtp options:
100
101	--verbose 1 (to list moves) or --verbose 2 (to draw board)
102	--komi <amount>
103	--handicap <amount>
104	--size <board size> (default 19)
105	--games <number of games to play> (-1 to play forever)
106	--sgffile <filename>
107	--help (show this)
108
109	";
110
111	GetOptions(
112	"white\|w=s" => \$white,
113	"black\|b=s" => \$black,
114	"verbose\|v=i" => \$verbose,
115	"komi\|k=f" => \$komi,
116	"handicap\|h=i" => \$handicap,
117	"size\|boardsize\|s=i" => \$size,
118	"sgffile\|o=s" => \$sgffilename,
119	"games=i" => \$games,
120	"help" => \$wanthelp,
121	);
122
123	if ($wanthelp) {
124	print $helpstring;
125	exit;
126	}
127
128
129	if (!$white) {
130	$white = '../gnugo.exe --mode gtp --quiet';
131	warn "Defaulting white to: $white";
132	}
133	if (!$black) {
134	$black = '../gnugo.exe --mode gtp --quiet';
135	warn "Defaulting black to: $black";
136	}
137
138	die $helpstring unless defined $white and defined $black;
139
140	# create FileHandles
141	#my $black_in;
142	my $black_in = new FileHandle; # stdin of black player
143	my $black_out = new FileHandle; # stdout of black player
144	my $white_in = new FileHandle; # stdin of white player
145	my $white_out = new FileHandle; # stdout of white player
146	my $b_gtp_ver; # gtp version of black player
147	my $w_gtp_ver; # gtp version of white player
148
149	while ($games > 0) {
150	$pidb = open2($black_out, $black_in, $black);
151	print "black pid: $pidb\n" if $verbose;
152	$pidw = open2($white_out, $white_in, $white);
153	print "white pid: $pidw\n" if $verbose;
154
155	$sgffile = rename_sgffile($games, $sgffilename) if defined $sgffilename;
156
157	if ((defined $sgffilename) && !open(SGFFILEHANDLE, ">$sgffile")) {
158	printf("can't open $sgffile\n");
159	undef($sgffilename);
160	}
161
162	if (!defined $komi) {
163	if ($handicap eq 0) {
164	$komi = 5.5;
165	}
166	else {
167	$komi = 0.5;
168	}
169	}
170
171	print $black_in "protocol_version\n";
172	$b_gtp_ver = eat_gtp_ver($black_out);
173	print $black_in "boardsize $size\n";
174	eat_no_response($black_out);
175	print $black_in "clear_board\n";
176	eat_no_response($black_out);
177	print $black_in "komi $komi\n";
178	eat_no_response($black_out);
179
180	print $white_in "protocol_version\n";
181	$w_gtp_ver = eat_gtp_ver($white_out);
182	print $white_in "boardsize $size\n";
183	eat_no_response($white_out);
184	print $white_in "clear_board\n";
185	eat_no_response($white_out);
186	print $white_in "komi $komi\n";
187	eat_no_response($white_out);
188
189	print SGFFILEHANDLE "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]"
190	if defined $sgffilename;
191
192	my $pass = 0;
193	my ($move, $toplay);
194
195	if ($handicap < 2) {
196	$toplay = 'B';
197	}
198	else {
199	$toplay = 'W';
200	print $black_in "fixed_handicap $handicap\n";
201	$handicap_stones = eat_handicap($black_out);
202	if (defined $sgffilename) {
203	print SGFFILEHANDLE $handicap_stones;
204	}
205	print $white_in "fixed_handicap $handicap\n";
206	$handicap_stones = eat_handicap($white_out);
207	}
208	while ($pass < 2) {
209	if ($toplay eq 'B') {
210	if ($b_gtp_ver eq 1) {
211	print $black_in "genmove_black\n";
212	} else {
213	print $black_in "genmove black\n";
214	}
215	$move = eat_move($black_out);
216	$sgfmove = standard_to_sgf($move);
217	print SGFFILEHANDLE ";B[$sgfmove]\n" if defined $sgffilename;
218	print "Black plays $move\n" if $verbose;
219	if ($move =~ /PASS/i) {
220	$pass++;
221	} else {
222	$pass = 0;
223	}
224	if ($w_gtp_ver eq 1) {
225	print $white_in "black $move\n";
226	} else {
227	print $white_in "play black $move\n";
228	}
229	eat_no_response($white_out);
230	if ($verbose > 1) {
231	print $white_in "showboard\n";
232	if ($w_gtp_ver eq 2) {
233	eat_showboard($white_out);
234	} else {
235	eat_no_response($white_out);
236	}
237	}
238	$toplay = 'W';
239	} else {
240	if ($w_gtp_ver eq 1) {
241	print $white_in "genmove_white\n";
242	} else {
243	print $white_in "genmove white\n";
244	}
245	$move = eat_move($white_out);
246	$sgfmove = standard_to_sgf($move);
247	print SGFFILEHANDLE ";W[$sgfmove]\n" if defined $sgffilename;
248	print "White plays $move\n" if $verbose;
249	if ($move =~ /PASS/i) {
250	$pass++;
251	} else {
252	$pass = 0;
253	}
254	if ($b_gtp_ver eq 1) {
255	print $black_in "white $move\n";
256	} else {
257	print $black_in "play white $move\n";
258	}
259	eat_no_response($black_out);
260	if ($verbose > 1) {
261	print $black_in "showboard\n";
262	if ($b_gtp_ver eq 2) {
263	eat_showboard($black_out);
264	} else {
265	eat_no_response($black_out);
266	}
267	}
268	$toplay = 'B';
269	}
270	}
271	print $white_in "final_score\n";
272	$resultw = eat_score($white_out);
273	print "Result according to W: $resultw\n";
274	print $black_in "final_score\n";
275	$resultb = eat_score($black_out);
276	print "Result according to B: $resultb\n";
277	print $white_in "quit\n";
278	print $black_in "quit\n";
279	if (defined $sgffilename) {
280	print "sgf file: $sgffile\n";
281	print SGFFILEHANDLE ")";
282	close SGFFILEHANDLE;
283	$game_list{$sgffile} = $resultw . "\|" . $resultb
284	}
285	$games-- if $games > 0;
286	close $black_in;
287	close $black_out;
288	close $white_in;
289	close $white_out;
290	waitpid $pidb, 0;
291	waitpid $pidw, 0;
292	print "games remaining: $games\n";
293	}
294
295	if (defined $sgffilename) {
296	my $index_out = new FileHandle;
297	open ($index_out, "> " . index_name($sgffilename));
298	print $index_out
299	"<HTML><HEAD><TITLE>game results</TITLE></HEAD>
300	<BODY><H3>Game Results</H3>
301	<H4>White: ".html_encode($white)."</H4>
302	<H4>Black: ".html_encode($black)."</H4>
303	<TABLE border=1>
304	<TR>
305	<TD>SGF file</TD>
306	<TD>Result</TD>
307	</TR>
308	";
309	foreach (sort by_result keys(%game_list)) {
310	print $index_out "<TR><TD><A href=\"$_\">$_</A></TD>" .
311	"<TD>".html_encode(game_result($_))."</TD></TR>\n";
312	}
313	print $index_out "</TABLE></BODY></HTML>\n";
314	}
315
316	sub game_result {
317	$_ = shift;
318	$_ = $game_list{$_};
319	#i.e.: B+13.5 (upper bound: -13.5, lower: -13.5)\|B+13.5 (upper bound: -13.5, lower: -13.5)
320	#Make sure that all 4 values are the same. I've not seen them different yet.
321	#If they are ever different, need to improve the HTML output (now just -999) -
322	# an explanation of the score mismatch problem would be appropriate.
323	$_ =~ /^.upper bound..([0-9+.\-])..lower..\1.\\|.*upper bound..\1..lower..\1./;
324	if (defined($1)) {
325	return $1;
326	} else {
327	return -999;
328	}
329	}
330
331	sub by_result {
332	game_result($a) <=> game_result($b) \|\| $a cmp $b;
333	}
334
335	sub html_encode {
336	#print shift;
337	my $r = shift;
338	$r =~ s/&/&/g;
339	$r =~ s/</</g;
340	$r =~ s/>/>/g;
341	return $r;
342	}
343
344
345
346	sub eat_no_response {
347	my $h = shift;
348
349	# ignore empty lines
350	my $line = "";
351	while ($line eq "") {
352	chop($line = <$h>) or die "No response!";
353	$line =~ s/(\s\|\n)*$//smg;
354	}
355	}
356
357	sub eat_move {
358	my $h = shift;
359	# ignore empty lines
360	my $line = "";
361	while ($line eq "") {
362	if (!defined($line = <$h>)) {
363	print SGFFILEHANDLE ")";
364	close SGFFILEHANDLE;
365	die "Engine crashed!\n";
366	}
367	$line =~ s/(\s\|\n)*$//smg;
368	}
369	my ($equals, $move) = split(' ', $line, 2);
370	$line = <$h>;
371	defined($move) or confess "no move found: line was: '$line'";
372	return $move;
373	}
374
375	sub eat_handicap {
376	my $h = shift;
377	my $sgf_handicap = "AB";
378	# ignore empty lines, die if process is gone
379	my $line = "";
380	while ($line eq "") {
381	chop($line = <$h>) or die "No response!";
382	}
383	@vertices = split(" ", $line);
384	foreach $vertex (@vertices) {
385	if (!($vertex eq "=")) {
386	$vertex = standard_to_sgf($vertex);
387	$sgf_handicap = "$sgf_handicap\[$vertex\]";
388	}
389	}
390	return "$sgf_handicap;";
391	}
392
393	sub eat_score {
394	my $h = shift;
395	# ignore empty lines, die if process is gone
396	my $line = "";
397	while ($line eq "") {
398	chop($line = <$h>) or die "No response!";
399	$line =~ s/^\s*//msg;
400	$line =~ s/\s*$//msg;
401	}
402	$line =~ s/\s*$//;
403	my ($equals, $result) = split(' ', $line, 2);
404	$line = <$h>;
405	return $result;
406	}
407
408	sub eat_gtp_ver {
409	my $h = shift;
410	my $line = "";
411
412	while ($line eq "") {
413	chop($line = <$h>) or die "No response!";
414	$line =~ s/^\s*//msg;
415	$line =~ s/\s*$//msg;
416	}
417	$line =~ s/\s*$//;
418	my ($equals, $result) = split(' ', $line, 2);
419	$line = <$h>;
420	return $result;
421	}
422
423	sub eat_showboard {
424	my $h = shift;
425	my $line = "";
426
427	while ($line eq "") {
428	chop($line = <$h>) or die "No response!";
429	$line =~ s/^\s*//msg;
430	$line =~ s/\s*$//msg;
431	}
432	$line =~ s/\s*$//;
433	my ($equals, $result) = split(' ', $line, 2);
434
435	while (!($line =~ /^\s*$/)) {
436	$result .= $line;
437	$line = <$h>;
438	}
439	print STDERR $result;
440	}
441
442	sub standard_to_sgf {
443	for (@_) { confess "Yikes!" if !defined($_); }
444	for (@_) { tr/A-Z/a-z/ };
445	$_ = shift(@_);
446	/([a-z])([0-9]+)/;
447	return "tt" if $_ eq "pass";
448
449	$first = ord $1;
450	if ($first > 104) {
451	$first = $first - 1;
452	}
453	$first = chr($first);
454	$second = chr($size+1-$2+96);
455	return "$first$second";
456	}
457
458	sub rename_sgffile {
459	my $nogames = int shift(@_);
460	$_ = shift(@_);
461	s/\.sgf$//;
462	# Annoying to loose _001 on game #1 in multi-game set.
463	# Could record as an additional parameter.
464	# return "$_.sgf" if ($nogames == 1);
465	return sprintf("$_" . "_%03d.sgf", $nogames);
466	}
467
468	sub index_name {
469	$_ = shift;
470	s/\.sgf$//;
471	return $_ . "_index.html";
472	}