# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# 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 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 #
# 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. #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
my $Aprg_in = new FileHandle
;
my $Aprg_out = new FileHandle
;
$program[0] = 'gnugo --mode gtp --quiet';
$cur_id[0] = 1; # starting id
my $Bprg_in = new FileHandle
;
my $Bprg_out = new FileHandle
;
$program[1] = 'gnugo --mode gtp --score aftermath --capture-all-dead --chinese-rules --quiet';
$cur_id[1] = 1; # starting id
my $state = 'start'; # first initialization state
open2
($Aprg_out, $Aprg_in, $program[0]);
fcntl( $Aprg_out, F_GETFL
, 0)
or die "Error with fcntl\n";
fcntl( $Aprg_out, F_SETFL
, $flags | O_NOBLOCK
)
or die "Error with fcntl\n";
open2
($Bprg_out, $Bprg_in, $program[1]);
fcntl( $Bprg_out, F_GETFL
, 0)
or die "Error with fcntl\n";
fcntl( $Bprg_out, F_SETFL
, $flags | O_NOBLOCK
)
or die "Error with fcntl\n";
my $consecutive_passes = 0;
my $ctm = 'B'; # who's turn to move?
my $cc = 'W'; # computers color
# This handles up to 25 size boards
# =================================
my @letter = qw
( A B C D E F G H J K L M N O P Q R S T U V W X Y Z
);
my %cstr = ( 'b' => '#604040', 'B' => '#604040',
'w' => '#ffffff', 'W' => '#ffffff'
# get command line arguments start with defaults
# ==============================================
my $sqwh2 = 12; # 1/2 of sqwh
foreach my $ix (0 .. $#letter) {
$toix{ $letter[$ix] } = $ix;
# initialize graphics and such
# ----------------------------
my $top = MainWindow
->new;
my $geox = ($boardsize-1) * $sqwh + 80;
my $geoy = ($boardsize-1) * $sqwh + 140;
$top->geometry( $geox . 'x' . $geoy );
$top->configure( background
=> $bkc );
# build the background go board
my $backing = $top->Canvas(
-width
=> $sqwh * $boardsize + 80,
-height
=> $sqwh * $boardsize + 80,
foreach my $x ( 0 .. $boardsize-1 ) {
$backing->createText( 40 + $x * $sqwh,
-font
=> '-b&h-*-bold-r-*-*-11-*-*-*-*-*-*-*'
$backing->createText( 40 + $x * $sqwh,
($boardsize-1)*$sqwh + 55,
-font
=> '-b&h-*-bold-r-*-*-11-*-*-*-*-*-*-*'
$backing->createLine( $x*$sqwh + 40,
($boardsize-1)*$sqwh + 40,
foreach my $y ( 0 .. $boardsize-1 ) {
$backing->createText( 25,
-text
=> $boardsize - $y,
-font
=> '-b&h-*-bold-r-*-*-11-*-*-*-*-*-*-*'
$backing->createText( ($boardsize-1) * $sqwh + 55,
-text
=> $boardsize - $y,
-font
=> '-b&h-*-bold-r-*-*-11-*-*-*-*-*-*-*'
$backing->createLine( 40,
-highlightcolor
=> 'black',
-highlightthickness
=> 1,
-highlightbackground
=> 'black',
-y
=> ($boardsize + 2) * $sqwh,
-highlightcolor
=> 'black',
-highlightthickness
=> 1,
-highlightbackground
=> 'black',
-y
=> ($boardsize + 2) * $sqwh,
$top->bind( "<Button-1>", [ \
&drop_stone
, Ev
('x'), Ev
('y') ] );
$top->fileevent( $Aprg_out, 'readable', [ \
&getmessage
, 0] );
$top->fileevent( $Bprg_out, 'readable', [ \
&getmessage
, 1] );
$state = 'start'; # first initialization state
if ($tmpstr eq '') { # eat the line, update id
print "Came up with $msgstr\n";
my ($color, $x, $y) = @_;
my $xx = $x * $sqwh + 40;
my $yy = $y * $sqwh + 40;
$backing->createOval( $xx-$sqwh2, $yy-$sqwh2,
-fill
=> $cstr{$color} );
# This routine clears all empty squares, it does
# not actually draw board
foreach my $y (0 .. $boardsize -1) {
foreach my $x (0 .. $boardsize -1) {
$backing->delete( $x . '_' . $y );
$x = -1 + int(($x-3) / 26);
$y = -1 + int(($y-3) / 26);
if ($x < 0) { return 1; }
if ($y < 0) { return 1; }
if ($x >= $boardsize) { return 1; }
if ($y >= $boardsize) { return 1; }
my $gn = $letter[$x] . ($boardsize - $y);
if ( !ttPlaceStone
( $ctm, $gn ) ) {
xputstone
( $ctm, $x, $y );
# This routine is called after each message is recieved
# -----------------------------------------------------
# How the control loop works:
# the '$state' variable determines where to jump in.
# control is called when a program responds to a message
# send boardsize 0 (prgA)
# send boardsize 1 (prgB)
# send genmove_black (prgA);
# send genmove_white (prgB);
print STDERR
"state/msg = $state $msg\n";
} else { print STDERR
"state/msg = $state NULL\n"; }
snd
( 0, "$cur_id[0] boardsize $boardsize" );
if ($state eq 'startb') {
snd
( 1, "$cur_id[1] boardsize $boardsize" );
$state = 'genmove_black';
if ( $state eq 'genmove_black' ) {
snd
( 0, "$cur_id[0] genmove_black" );
if ( $state eq 'black' ) {
$msg =~ /^=\d+\s+(.)(.*)/; # parse out move components
$gn = $letter[$x] . ($boardsize - $y);
# show blacks move to the interface
# ---------------------------------
if ( !ttPlaceStone
( $ctm, $gn ) ) {
xputstone
( $ctm, $x, $y ) if $gn ne 'PASS';
# send the move along to WHITE
# ----------------------------
snd
( 1, "$cur_id[1] black $gn" );
$state = 'genmove_white';
if ($consecutive_passes == 2) {
if ( $state eq 'genmove_white' ) {
snd
( 1, "$cur_id[1] genmove_white" );
if ( $state eq 'white' ) {
$msg =~ /^=\d+\s+(.)(.*)/; # parse out move components
$gn = $letter[$x] . ($boardsize - $y);
# show blacks move to the interface
# ---------------------------------
if ( !ttPlaceStone
( $ctm, $gn ) ) {
xputstone
( $ctm, $x, $y ) if $gn ne 'PASS';
# send the move along to BLACK
# ----------------------------
snd
( 0, "$cur_id[0] white $gn" );
$state = 'genmove_black';
if ($consecutive_passes == 2) {
if ( $state eq 'gameover' ) {
print STDERR
"----> $str\n";