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 | package GTP; | |
30 | ||
31 | use strict; | |
32 | ||
33 | my $debug = 0; | |
34 | ||
35 | sub exec_cmd { | |
36 | my $hin = shift; | |
37 | my $hout = shift; | |
38 | my $cmd = shift; | |
39 | ||
40 | # send the command to the GTP program | |
41 | ||
42 | print $hin "$cmd\n"; | |
43 | ||
44 | # parse the response of the GTP program | |
45 | ||
46 | my $line; | |
47 | my $repchar; | |
48 | my $result = "ERROR"; | |
49 | $line = <$hout>; | |
50 | print STDERR "$hin 1:$line" if ($debug); | |
51 | return "ERROR" unless (defined $line); | |
52 | $line =~ s/\s*$//; | |
53 | ($repchar, $result) = split(/\s*/, $line, 2); | |
54 | print STDERR "$hin 2:repchar $repchar\n" if ($debug); | |
55 | print STDERR "$hin 3:result $result\n" if ($debug); | |
56 | ||
57 | $line = <$hout>; | |
58 | while (!($line =~ /^\s*$/)) { | |
59 | $result .= $line; | |
60 | $line = <$hout>; | |
61 | } | |
62 | print STDERR "$hin 4:$line" if ($debug); | |
63 | if ($repchar eq '?') { | |
64 | return "ERROR"; | |
65 | } | |
66 | return $result; | |
67 | } | |
68 | ||
69 | sub standard_to_sgf { | |
70 | ||
71 | my $size = shift; | |
72 | my $board_coords = shift; | |
73 | $board_coords =~ tr/A-Z/a-z/; | |
74 | return "" if ($board_coords eq "pass"); | |
75 | my $first = substr($board_coords, 0, 1); | |
76 | my $number = substr($board_coords, 1); | |
77 | my $sgffirst; | |
78 | if ($first gt 'i') { | |
79 | $sgffirst = chr(ord($first) - 1); | |
80 | } else { | |
81 | $sgffirst = $first; | |
82 | } | |
83 | my $sgfsecond = chr(ord('a') + $size - $number); | |
84 | # print "$board_coords, $sgffirst, $number, $sgfsecond\n"; | |
85 | return $sgffirst . $sgfsecond; | |
86 | } | |
87 | ||
88 | package GTP::Player; | |
89 | ||
90 | use strict; | |
91 | use Class::Struct; | |
92 | use FileHandle; | |
93 | use IPC::Open2; | |
94 | ||
95 | struct('GTP::Player' => { | |
96 | 'in' => 'FileHandle', | |
97 | 'out' => 'FileHandle', | |
98 | 'gtp_version' => '$', | |
99 | } | |
100 | ); | |
101 | ||
102 | sub init { | |
103 | my $self = shift; | |
104 | return $self; | |
105 | } | |
106 | ||
107 | sub initialize { | |
108 | my $self = shift; | |
109 | my $cmd = shift; | |
110 | ||
111 | my $pid = open2($self->{out}, $self->{in}, $cmd); | |
112 | $self->{gtp_version} = GTP::exec_cmd($self->{in}, | |
113 | $self->{out}, "protocol_version"); | |
114 | $self->{gtp_version} eq 1 or $self->{gtp_version} eq 2 or | |
115 | die "Unsupported gtp version $self->{gtp_version}\n"; | |
116 | return $pid; | |
117 | } | |
118 | ||
119 | sub genmove { | |
120 | my $self = shift; | |
121 | my $color = shift; | |
122 | ||
123 | my $cmd; | |
124 | if ($self->{gtp_version} eq 1) { | |
125 | $cmd = "genmove_"; | |
126 | } else { | |
127 | $cmd = "genmove "; | |
128 | } | |
129 | if ($color =~ /^b/i) { | |
130 | $cmd .= "black"; | |
131 | } elsif ($color =~ /^w/i) { | |
132 | $cmd .= "white"; | |
133 | } else { | |
134 | die "Illegal color $color\n"; | |
135 | } | |
136 | my $move = GTP::exec_cmd($self->{in}, $self->{out}, $cmd); | |
137 | } | |
138 | ||
139 | sub black { | |
140 | my $self = shift; | |
141 | my $move = shift; | |
142 | my $cmd; | |
143 | if ($self->{gtp_version} eq 1) { | |
144 | $cmd = "black "; | |
145 | } else { | |
146 | $cmd = "play black "; | |
147 | } | |
148 | ||
149 | GTP::exec_cmd($self->{in}, $self->{out}, $cmd . $move); | |
150 | } | |
151 | ||
152 | sub white { | |
153 | my $self = shift; | |
154 | my $move = shift; | |
155 | my $cmd; | |
156 | if ($self->{gtp_version} eq 1) { | |
157 | $cmd = "white "; | |
158 | } else { | |
159 | $cmd = "play white "; | |
160 | } | |
161 | ||
162 | GTP::exec_cmd($self->{in}, $self->{out}, $cmd . $move); | |
163 | } | |
164 | ||
165 | sub komi { | |
166 | my $self = shift; | |
167 | my $komi = shift; | |
168 | ||
169 | GTP::exec_cmd($self->{in}, $self->{out}, "komi $komi"); | |
170 | } | |
171 | ||
172 | sub boardsize { | |
173 | my $self = shift; | |
174 | my $size = shift; | |
175 | ||
176 | GTP::exec_cmd($self->{in}, $self->{out}, "boardsize $size"); | |
177 | } | |
178 | ||
179 | sub clear_board { | |
180 | my $self = shift; | |
181 | ||
182 | GTP::exec_cmd($self->{in}, $self->{out}, "clear_board"); | |
183 | } | |
184 | ||
185 | sub handicap { | |
186 | my $self = shift; | |
187 | my $handicap = shift; | |
188 | ||
189 | my $stones; | |
190 | $stones = GTP::exec_cmd($self->{in}, $self->{out}, "handicap $handicap"); | |
191 | return split(' ', $stones); | |
192 | } | |
193 | ||
194 | sub fixed_handicap { | |
195 | my $self = shift; | |
196 | my $handicap = shift; | |
197 | ||
198 | my $stones; | |
199 | $stones = GTP::exec_cmd($self->{in}, $self->{out}, "fixed_handicap $handicap"); | |
200 | return split(' ', $stones); | |
201 | } | |
202 | ||
203 | sub quit { | |
204 | my $self = shift; | |
205 | ||
206 | $self->{in}->print("quit\n"); | |
207 | } | |
208 | ||
209 | sub showboard { | |
210 | my $self = shift; | |
211 | my $board; | |
212 | ||
213 | $board = GTP::exec_cmd($self->{in}, $self->{out}, "showboard"); | |
214 | ||
215 | if ($self->{gtp_version} eq 2) { | |
216 | print $board; | |
217 | } | |
218 | } | |
219 | ||
220 | sub get_random_seed { | |
221 | my $self = shift; | |
222 | ||
223 | my $ret = GTP::exec_cmd($self->{in}, $self->{out}, "get_random_seed"); | |
224 | if ($ret eq "ERROR") { | |
225 | return "unknown"; | |
226 | } | |
227 | my ($result, $rest) = split(' ', $ret, 2); | |
228 | return $result; | |
229 | } | |
230 | ||
231 | sub get_program_name { | |
232 | my $self = shift; | |
233 | ||
234 | my $name = GTP::exec_cmd($self->{in}, $self->{out}, "name"); | |
235 | my $version = GTP::exec_cmd($self->{in}, $self->{out}, "version"); | |
236 | return "$name $version"; | |
237 | } | |
238 | ||
239 | sub score { | |
240 | my $self = shift; | |
241 | ||
242 | return GTP::exec_cmd($self->{in}, $self->{out}, "score"); | |
243 | } | |
244 | ||
245 | sub final_score { | |
246 | my $self = shift; | |
247 | ||
248 | my $ret = GTP::exec_cmd($self->{in}, $self->{out}, "final_score"); | |
249 | my ($result, $rest) = split(' ', $ret, 2); | |
250 | return $result; | |
251 | } | |
252 | ||
253 | package GTP::Game::Result; | |
254 | ||
255 | use strict; | |
256 | use Class::Struct; | |
257 | use FileHandle; | |
258 | ||
259 | struct('GTP::Game::Result' => { | |
260 | 'resultw' => '$', | |
261 | 'resultb' => '$' | |
262 | } | |
263 | ); | |
264 | ||
265 | package GTP::Game; | |
266 | ||
267 | use strict; | |
268 | use Class::Struct; | |
269 | use FileHandle; | |
270 | ||
271 | struct('GTP::Game' => { | |
272 | 'black' => 'GTP::Player', | |
273 | 'white' => 'GTP::Player', | |
274 | 'size' => '$', | |
275 | 'komi' => '$', | |
276 | 'handicap' => '$', | |
277 | 'handicap_stones' => '@', | |
278 | 'moves' => '@', | |
279 | 'result' => 'GTP::Game::Result' | |
280 | } | |
281 | ); | |
282 | ||
283 | my $verbose = 0; | |
284 | ||
285 | sub verbose { | |
286 | my $self = shift; | |
287 | my $verbose_arg = shift; | |
288 | ||
289 | $verbose = $verbose_arg; | |
290 | } | |
291 | ||
292 | sub writesgf { | |
293 | my $self = shift; | |
294 | my $sgffile = shift; | |
295 | ||
296 | my $size = $self->size; | |
297 | ||
298 | my $handle = new FileHandle; | |
299 | $handle->open(">$sgffile") or | |
300 | die "Can't write to $sgffile\n"; | |
301 | my $black_name = $self->black->get_program_name; | |
302 | my $white_name = $self->white->get_program_name; | |
303 | my $black_seed = $self->black->get_random_seed; | |
304 | my $white_seed = $self->white->get_random_seed; | |
305 | my $handicap = $self->handicap; | |
306 | my $komi = $self->komi; | |
307 | my $result = $self->{result}->resultw; | |
308 | ||
309 | print $handle "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]RE[$result]\n"; | |
310 | print $handle "PW[$white_name (random seed $white_seed)]PB[$black_name (random seed $black_seed)]\n"; | |
311 | if ($handicap > 1) { | |
312 | for my $stone (@{$self->handicap_stones}) { | |
313 | printf $handle "AB[%s]", GTP::standard_to_sgf($self->size, $stone); | |
314 | } | |
315 | print $handle "\n"; | |
316 | } | |
317 | my $toplay = $self->handicap < 2 ? 'B' : 'W'; | |
318 | for my $move (@{$self->moves}) { | |
319 | my $sgfmove = GTP::standard_to_sgf($size, $move); | |
320 | print $handle ";$toplay" . "[$sgfmove]\n"; | |
321 | $toplay = $toplay eq 'B' ? 'W' : 'B'; | |
322 | } | |
323 | print $handle ")\n"; | |
324 | $handle->close; | |
325 | } | |
326 | ||
327 | ||
328 | ||
329 | ||
330 | sub play { | |
331 | ||
332 | my $self = shift; | |
333 | my $sgffile = shift; | |
334 | ||
335 | my $size = $self->size; | |
336 | my $handicap = $self->handicap; | |
337 | my $komi = $self->komi; | |
338 | ||
339 | print "Setting boardsize and komi for black\n" if $verbose; | |
340 | $self->black->boardsize($size); | |
341 | $self->black->clear_board(); | |
342 | $self->black->komi($komi); | |
343 | ||
344 | print "Setting boardsize and komi for white\n" if $verbose; | |
345 | $self->white->boardsize($size); | |
346 | $self->white->clear_board(); | |
347 | $self->white->komi($komi); | |
348 | ||
349 | my $pass = 0; | |
350 | my $resign = 0; | |
351 | my ($move, $toplay, $sgfmove); | |
352 | ||
353 | $pass = 0; | |
354 | $#{$self->handicap_stones} = -1; | |
355 | if ($handicap < 2) { | |
356 | ||
357 | $toplay = 'B'; | |
358 | ||
359 | } else { | |
360 | ||
361 | @{$self->handicap_stones} = $self->white->fixed_handicap($handicap); | |
362 | for my $stone (@{$self->handicap_stones}) { | |
363 | $self->black->black($stone); | |
364 | } | |
365 | $toplay = 'W'; | |
366 | ||
367 | } | |
368 | ||
369 | $#{$self->moves} = -1; | |
370 | while ($pass < 2 and $resign eq 0) { | |
371 | ||
372 | if ($toplay eq 'B') { | |
373 | ||
374 | $move = $self->black->genmove("black"); | |
375 | if ($move eq "ERROR") { | |
376 | $self->writesgf($sgffile) if defined $sgffile; | |
377 | die "No response!"; | |
378 | } | |
379 | $resign = ($move =~ /resign/i) ? 1 : 0; | |
380 | if ($resign) { | |
381 | print "Black resigns\n" if $verbose; | |
382 | } else { | |
383 | push @{$self->moves}, $move; | |
384 | print "Black plays $move\n" if $verbose; | |
385 | $pass = ($move =~ /PASS/i) ? $pass + 1 : 0; | |
386 | $self->white->black($move); | |
387 | } | |
388 | if ($verbose == 3) { | |
389 | my $black_seed = $self->black->get_random_seed; | |
390 | printf "Black seed $black_seed\n"; | |
391 | } | |
392 | if ($verbose == 2) { | |
393 | $self->white->showboard; | |
394 | } | |
395 | ||
396 | $toplay = 'W'; | |
397 | ||
398 | } else { | |
399 | ||
400 | $move = $self->white->genmove("white"); | |
401 | if ($move eq "ERROR") { | |
402 | $self->writesgf($sgffile) if defined $sgffile; | |
403 | die "No response!"; | |
404 | } | |
405 | $resign = ($move =~ /resign/i) ? 1 : 0; | |
406 | if ($resign) { | |
407 | print "White resigns\n" if $verbose; | |
408 | } else { | |
409 | push @{$self->moves}, $move; | |
410 | print "White plays $move\n" if $verbose; | |
411 | $pass = ($move =~ /PASS/i) ? $pass + 1 : 0; | |
412 | $self->black->white($move); | |
413 | } | |
414 | if ($verbose == 3) { | |
415 | my $white_seed = $self->white->get_random_seed; | |
416 | printf "White seed $white_seed\n"; | |
417 | } | |
418 | if ($verbose == 2) { | |
419 | $self->black->showboard; | |
420 | } | |
421 | $toplay = 'B'; | |
422 | ||
423 | } | |
424 | } | |
425 | ||
426 | my $resultb; | |
427 | my $resultw; | |
428 | if ($resign) { | |
429 | $resultb = $toplay eq 'B' ? 'B+R' : 'W+R'; | |
430 | $resultw = $resultb; | |
431 | } else { | |
432 | $resultw = $self->white->final_score; | |
433 | $resultb = $self->black->final_score; | |
434 | } | |
435 | if ($resultb eq $resultw) { | |
436 | print "Result: $resultw\n"; | |
437 | } else { | |
438 | print "Result according to W: $resultw\n"; | |
439 | print "****** according to B: $resultb\n"; | |
440 | } | |
441 | $self->{result} = new GTP::Game::Result; | |
442 | $self->{result}->resultw($resultw); | |
443 | $self->{result}->resultb($resultb); | |
444 | $self->writesgf($sgffile) if defined $sgffile; | |
445 | } | |
446 | ||
447 | package GTP::Match; | |
448 | ||
449 | use strict; | |
450 | use Class::Struct; | |
451 | use FileHandle; | |
452 | ||
453 | struct('GTP::Match' => { | |
454 | 'black' => 'GTP::Player', | |
455 | 'white' => 'GTP::Player', | |
456 | 'size' => '$', | |
457 | 'komi' => '$', | |
458 | 'handicap' => '$' | |
459 | } | |
460 | ); | |
461 | ||
462 | sub play { | |
463 | my $self = shift; | |
464 | my $games = shift; | |
465 | my $sgffile = shift; | |
466 | ||
467 | my $game = new GTP::Game; | |
468 | $game->size($self->size); | |
469 | $game->komi($self->komi); | |
470 | $game->handicap($self->handicap); | |
471 | $game->black($self->black); | |
472 | $game->white($self->white); | |
473 | $game->komi($self->komi); | |
474 | my @results; | |
475 | (my $sgffile_base = $sgffile) =~ s/\.sgf$//; | |
476 | for my $i (1..$games) { | |
477 | my $sgffile_game = sprintf "%s%03d.sgf", $sgffile_base, $i; | |
478 | $game->play($sgffile_game); | |
479 | my $result = new GTP::Game::Result; | |
480 | $result->resultb($game->{result}->resultb); | |
481 | $result->resultw($game->{result}->resultw); | |
482 | push @results, $result; | |
483 | } | |
484 | return @results; | |
485 | } | |
486 | ||
487 | package main; | |
488 | ||
489 | use strict; | |
490 | use Getopt::Long; | |
491 | use FileHandle; | |
492 | ||
493 | my $white; | |
494 | my $black; | |
495 | my $size = 19; | |
496 | my $games = 1; | |
497 | my $komi; | |
498 | my $handicap = 0; | |
499 | my $sgffile = "twogtp.sgf"; | |
500 | ||
501 | GetOptions( | |
502 | "white|w=s" => \$white, | |
503 | "black|b=s" => \$black, | |
504 | "verbose|v=i" => \$verbose, | |
505 | "komi|km=f" => \$komi, | |
506 | "handicap|ha=i" => \$handicap, | |
507 | "games|g=i" => \$games, | |
508 | "sgffile|f=s" => \$sgffile, | |
509 | "boardsize|size|s=i" => \$size | |
510 | ); | |
511 | ||
512 | GTP::Game->verbose($verbose); | |
513 | ||
514 | my $helpstring = " | |
515 | ||
516 | Run with: | |
517 | ||
518 | twogtp --white \'<path to program 1> --mode gtp [program options]\' \\ | |
519 | --black \'<path to program 2> --mode gtp [program options]\' \\ | |
520 | [twogtp options] | |
521 | ||
522 | Possible twogtp options: | |
523 | ||
524 | --verbose 1 (to list moves) or --verbose 2 (to draw board) | |
525 | --komi <amount> | |
526 | --handicap <amount> | |
527 | --size <board size> (default 19) | |
528 | --games <number of games to play> (-1 to play forever) | |
529 | --sgffile <filename> | |
530 | "; | |
531 | ||
532 | die $helpstring unless defined $white and defined $black; | |
533 | ||
534 | if (!defined $komi) { | |
535 | if ($handicap > 0) { | |
536 | $komi = 0.5; | |
537 | } else { | |
538 | $komi = 5.5; | |
539 | } | |
540 | } | |
541 | ||
542 | # create GTP players | |
543 | ||
544 | my $black_pl = new GTP::Player; | |
545 | $black_pl->initialize($black); | |
546 | print "Created black GTP player\n" if $verbose; | |
547 | ||
548 | my $white_pl = new GTP::Player; | |
549 | $white_pl->initialize($white); | |
550 | print "Created white GTP player\n" if $verbose; | |
551 | ||
552 | my $match = new GTP::Match; | |
553 | $match->white($white_pl); | |
554 | $match->black($black_pl); | |
555 | $match->size($size); | |
556 | $match->komi($komi); | |
557 | $match->handicap($handicap); | |
558 | my @results = $match->play($games, $sgffile); | |
559 | ||
560 | my $i=0; | |
561 | for my $r (@results) { | |
562 | $i++; | |
563 | if ($r->resultb eq $r->resultw) { | |
564 | printf "Game $i: %s\n", $r->resultw; | |
565 | } | |
566 | else { | |
567 | printf "Game $i: %s %s\n", $r->resultb, $r->resultw; | |
568 | } | |
569 | } | |
570 | ||
571 | $white_pl->quit; | |
572 | $black_pl->quit; | |
573 | ||
574 |