| Category: | GUI Programming |
| Author/Contact Info | mawe |
| Description: | This is just an improved (?) version of the great GUI for GNU Go from gri6507. Hope he (and some others) like it. BUGS: white stones aren't displayed on 19x19-board, first white move isn't shown in listbox, ... TODO: clear bugs (please help me :-)) |
#!/usr/bin/perl -w
use strict;
use English;
use Tk;
use Expect;
use Tk::LabFrame;
$|++;
my $gnugo = "/path_to_gnugo/gnugo";
my $color = "goldenrod3";
my $exp;
my ($mw, $white, $black, $canvas, @taken);
my ($black_move, $white_move, $black_capture, $white_capture);
my $boardSize = 9;
my $level = 0;
my $squareSize = 25;
my $borderSize = 20;
########################## GUI ##########################
$mw = MainWindow->new(-title=>"GNU Go");
# the menu
my $menuitems = [
[Cascade=>"~Game", -menuitems=> [
[Button=>"~Play",-command=>\&call_gnugo],
[Button=>"~End Game",-command=>sub{send_and_receive("quit\n")}
+],
[Separator=>""],
[Button=>"~Save",-command=>sub{send_and_receive("save save.sgf
+\nquit\n")}],
[Button=>"~Quit",-command=>sub{exit}],
],
],
[Cascade=>"~Settings",-menuitems=> [
[Cascade=>"~Board-Dimension",-menuitems=> [
[Radiobutton=>"9x9",-variable=>\$boardSize,-value=>"9"],
[Radiobutton=>"13x13",-variable=>\$boardSize,-value=>"13"]
+,
[Radiobutton=>"19x19",-variable=>\$boardSize,-value=>"19"]
+],
],
[Cascade=>"~Level",-menuitems=> [
[Radiobutton=>"0",-variable=>\$level,-value=>"0"],
[Radiobutton=>"1",-variable=>\$level,-value=>"1"],
[Radiobutton=>"2",-variable=>\$level,-value=>"2"],
[Radiobutton=>"3",-variable=>\$level,-value=>"3"],
[Radiobutton=>"4",-variable=>\$level,-value=>"4"],
[Radiobutton=>"5",-variable=>\$level,-value=>"5"],
[Radiobutton=>"6",-variable=>\$level,-value=>"6"],
[Radiobutton=>"7",-variable=>\$level,-value=>"7"],
[Radiobutton=>"8",-variable=>\$level,-value=>"8"],
[Radiobutton=>"9",-variable=>\$level,-value=>"9"],
[Radiobutton=>"10",-variable=>\$level,-value=>"10"],
]],
[Cascade=>"Board-~Size",-menuitems=> [
[Radiobutton=>"~Small",-variable=>\$squareSize,-value=>"15
+"],
[Radiobutton=>"~Medium",-variable=>\$squareSize,-value=>"2
+0"],
[Radiobutton=>"~Large",-variable=>\$squareSize,-value=>"25
+"],
]]]
],
];
my $menubar = $mw->Menu(-menuitems=>$menuitems);
$mw->configure(-menu=>$menubar);
$canvas = $mw->Label(
-text=>"Welcome \nto \nGNUGo",
-font=>"*-helvetica-bold-r-*-*-20-*",
-fg=>"blue",
)->pack(-side=>'left');
my $frame = $mw->Frame(
-borderwidth=>2,
-relief=>"groove",
)->pack(-side=>'right',-fill=>'y');
# Labframe for moves
#--------------------------------------------------
my $lf = $frame->LabFrame(
-label=>"Moves",
-labelside=>"acrosstop",
)->pack;
# 2 Listboxes with 1 Scrollbar
my $blb = $lf->Listbox(
-width=>5,
-height=>2,
-bg=>"black",
-fg=>"white",
)->pack(-side=>'left');
my $scroll = $lf->Scrollbar()->pack(-side=>'left');
my $wlb = $lf->Listbox(
-width=>5,
-height=>2,
-bg=>"white",
-fg=>"black",
)->pack(-side=>'right');
my $fields = [$blb,$wlb];
foreach my $list (@{$fields}) {
$list->configure(-yscrollcommand=>[\&scroll_it, $scroll, $list, $f
+ields]);
}
$scroll->configure(
-command=>sub{
foreach my $list (@{$fields}) {
$list->yview(@_);
}
}
);
sub scroll_it {
my ($sb, $scrolled, $lbs, @args) = @_;
$sb->set(@args);
my ($tops, $bottom) = $scrolled->yview();
foreach my $list (@$lbs) {
$list->yviewMoveto($tops);
}
}
#--------------------------------------------------
# Labframe for captured pieces, 2 Entries
#--------------------------------------------------
my $lf2 = $frame->LabFrame(
-label=>"Captured",
-labelside=>"acrosstop",
)->pack(-fill=>'x');
$lf2->Entry(
-width=>3,
-textvariable=>\$black_capture,
-bg=>"black",
-fg=>"white",
)->pack(-side=>'left');
$lf2->Entry(
-width=>3,
-textvariable=>\$white_capture,
-bg=>"white",
-fg=>"black",
)->pack(-side=>'right');
#--------------------------------------------------
# Button for undo
$frame->Button(
-text=>"Undo",
-command=>sub{send_and_receive("undo\nundo\n"),
$blb->delete('end'),
$wlb->delete('end')}
)->pack(-fill=>'x');
# Button to pass
$frame->Button(
-text=>"Pass",
-command=>sub{ send_and_receive("pass\n") }
)->pack(-fill=>'x');
# Label for result
my $result = $frame->Label(
-text=>"",
)->pack(-fill=>'x');
MainLoop;
######################### GUI END #########################
#--------------------------------------------------
sub call_gnugo {
#--------------------------------------------------
$exp = Expect->spawn("$gnugo --boardsize $boardSize --level $level
+")
or die "Cannot spawn $gnugo: $!\n";
my $patidx = $exp->expect(1,'-re', qr'black(1):');
draw_canvas();
}
#--------------------------------------------------
sub draw_canvas {
#--------------------------------------------------
$canvas->destroy();
$result->configure(-text=>"");
$blb->delete('0.0','end');
$wlb->delete('0.0','end');
($black_capture, $white_capture) = ("","");
# the board
$canvas =$mw->Canvas(
-relief=>"flat",
-bg=>$color,
-width=>($boardSize-1)*$squareSize+$borderSize*2,
-height=>($boardSize-1)*$squareSize+$borderSize*2,
)->pack(-side=>'left',-anchor=>"n");
# the grid of the board
for (0..$boardSize-1) {
my $x;
if ($_<8) {$x=$_} else {$x=$_+1} # there is no "I" on a Go-boa
+rd
$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,
-text=>chr(ord('A')+$x),
);
$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
+')]);
}
#--------------------------------------------------
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;
if ($gridx > 7) {$gridx++}; # there is no "I" on a GO-board!
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'.{27}pieces',
sub {
my $self = shift;
my $match = $self->match;
if ($match =~ /White.*?(\d+?) pieces/){
$white_capture = $1;
}
if ($match =~ /Black.*?(\d+?) pieces/){
$black_capture = $1;
}
$self->set_accum($self->after());
exp_continue;
},
'-re', qr'^[A-Z]\d\d?',
sub{
my $self = shift;
my $match = $self->match;
$match =~ /(.+)/;
$blb->insert('end',$1);
$blb->see('end');
$self->set_accum($self->after());
exp_continue;
},
'-re', qr'white\(\d+\):\s([A-Z]\d\d?)',
sub {
my $self = shift;
my $match = $self->match;
$match =~ /white\(\d+?\):\s([A-Z]\d\d?)/;
$wlb->insert('end',$1);
$wlb->see('end');
$self->set_accum($self->after());
exp_continue;
},
'-re', qr'PASS',
sub {
$result->configure(
-text=>"White passes",
-fg=>'blue');
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;
$result->configure(
-text=>$self->match,
-fg=>'red');
},
);
}
#--------------------------------------------------
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();
}
|
|
|
|---|
Back to
Code Catacombs