Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Tk-GNU-Go

by mawe (Hermit)
on Mar 11, 2004 at 10:02 UTC ( #335756=sourcecode: print w/replies, xml ) Need Help??
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();
}

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://335756]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (3)
As of 2020-09-23 22:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (132 votes). Check out past polls.

    Notices?