I was playing GNU Go the other day. Aafter several screw-ups due to the "parallex" effect, I realized that the ASCII mode is to blame for my poor game skills :-). So, I looked around for a Perl front-end to GNU Go, but came up short. Thus, I tried doing it myself.
The actual code can be seen in the readmore tags below. I guess I would first of all, like your opinion on this GUI (but please keep in mind that this is still a work in progress). Secondly, I need your help with a bug. After every turn, GNU Go displays how many pieces are captured by each player. For the life of me, I cannot grap that from the output. I am sure it's something simple, but I just don't see it.
use strict;
use English;
use Tk;
require Tk::LabEntry;
use Expect;
$|++;
my $gnugo = "/bin/gnugo";
my (
$mw,
$white,
$black,
$canvas,
@taken,
);
my $boardSize = $ARGV[0];
my $squareSize = 15;
my $borderSize = 17;
die "How big is the board?\n" unless (($boardSize > 4) && ($boardSize
+< 16));
my $exp = Expect->spawn("$gnugo --boardsize $boardSize")
or die "Cannot spawn $gnugo: $!\n";
my $patidx = $exp->expect(1,'-re', qr'black(1):');
$mw = MainWindow->new(-title=>"GNU Go");
$mw->optionAdd('*font'=>"Fixed 10");
$canvas =$mw->Canvas(-relief=>"raised",
-width=>($boardSize-1)*$squareSize+$borderSize*2,
-height=>($boardSize-1)*$squareSize+$borderSize*2
+,
)->pack();
$mw->LabEntry(-label=>"White", -labelAnchor=>'w', -labelWidth=>4,
-labelPack=>[-side=>"left"], -textvariable=>\$white)->pa
+ck();
$mw->LabEntry(-label=>"Black", -labelAnchor=>'w', -labelWidth=>4,
-labelPack=>[-side=>"left"], -textvariable=>\$black)->pa
+ck();
$mw->Button(-text=>"Pass", -command=>sub{
send_and_receive("pass\n");
}
)->pack();
for(0 .. $boardSize-1){
$canvas->createLine($borderSize,
$borderSize+$_*$squareSize,
($boardSize-1)*$squareSize+$borderSize,
$borderSize+$_*$squareSize,
);
$canvas->createLine($borderSize+$_*$squareSize,
$borderSize,
$borderSize+$_*$squareSize,
($boardSize-1)*$squareSize+$borderSize,
);
$canvas->createText($borderSize+$_*$squareSize, $borderSize-10, -tex
+t=>chr(ord('A')+$_));
$canvas->createText($borderSize-10,$borderSize+$_*$squareSize,-text=
+>$boardSize-$_);
for my $y(0 .. $boardSize-1){
$taken[$_][$y]{state} = 0;
}
}
$canvas->bind("all",'<Button-1>', [\&click, Tk::Ev('x'), Tk::Ev('y')])
+;
MainLoop;
sub click {
my $x = $ARG[1];
my $y = $ARG[2];
$canvas->bind("all",'<Button-1>');
my $gridx = sprintf("%.0f",($x-$borderSize)/$squareSize);
my $gridy = sprintf("%.0f",($y-$borderSize)/$squareSize);
return if $taken[$gridx][$gridy]{state};
draw_piece($gridx, $gridy, "#000000");
$gridy = $boardSize-$gridy;
send_and_receive(chr(ord('A')+$gridx) . $gridy . "\n");
}
sub send_and_receive {
$exp->send(shift);
$exp->clear_accum();
$exp->expect(undef,'-re', qr'\d+[.+XO() ]{11,33}\d+',
sub {
my $self = shift;
my $match = $self->match;
$match =~ /(\d+)(.*?)\d+/;
my $x = 0;
my $y = $boardSize-$1;
$match = $2;
foreach(split(//,$match)){
next if (/ / || /\(/ || /\)/);
if ((/\./ || /\+/) && $taken[$x][$y]{state}){
$canvas->delete($taken[$x][$y]{piece});
$taken[$x][$y]{state} = 0;
}
if (/X/ && !$taken[$x][$y]{state}){
draw_piece($x,$y,"#000000");
}
if (/O/ && !$taken[$x][$y]{state}){
draw_piece($x,$y,"#FFFFFF");
}
$x++;
}
$self->set_accum($self->after());
exp_continue;
},
'-re', qr'pieces',
sub {
print "Found Pieces entry\n";
my $self = shift;
my $match = $self->match;
if ($match =~ /White.*?(\d+)/){
$white->configure(-text=>$1);
print "found $1\n";
}
if ($match =~ /Black.*?(\d+)/){
$black->configure(-text=>$1);
print "found $1\n";
}
$self->set_accum($self->after());
exp_continue;
},
'-re', qr'black\(\d+\)',
sub {
$canvas->bind("all",'<Button-1>', [\&click, Tk::Ev('x
+'), Tk::Ev('y')]);
},
'-re', qr'Result.*',
sub {
my $self = shift;
$mw->Label(-text=>$self->match)->pack();
}
);
}
sub draw_piece{
my $x = shift;
my $y = shift;
my $color = shift;
$taken[$x][$y]{state}++;
$taken[$x][$y]{piece} =
$canvas->createOval($borderSize+$x*$squareSize-$squareSize/2+2,
$borderSize+$y*$squareSize-$squareSize/2+2,
$borderSize+$x*$squareSize+$squareSize/2-2,
$borderSize+$y*$squareSize+$squareSize/2-2,
-fill=>$color,
);
$mw->update();
}
