Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

GUI for GNU Go

by gri6507 (Deacon)
on Dec 11, 2003 at 21:02 UTC ( #314161=perlquestion: print w/replies, xml ) Need Help??

gri6507 has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks,

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.

Thanks in advance.

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(); }

Replies are listed 'Best First'.
Re: GUI for GNU Go
by flyingmoose (Priest) on Dec 11, 2003 at 21:23 UTC

    Not to diminish your work (I'll have to try it), but there does appear to be a GUI. In fact, I was looking for one just the other day, came across one, and haven't even downloaded it yet. I'm just starting to learn Go myself.


    Might be of interest.

Re: GUI for GNU Go
by Taulmarill (Deacon) on Dec 12, 2003 at 09:24 UTC
    there is a whole bunch of GnuGo GUIīs avalable, the most are listet here. but one of the most interesting is not, itīs GlGo, as the name asumes it is OpenGl powerded.
    but there is no perl gui yet, so keep going if this is what you whant. when iīm at home where i donīt have to sit in front of a lame Win32 workstation i will test you code and give some further comments.
    btw. i whould like to have a non java gui for the kgs. if someone has tomething else than CGoban2 or is developing something, let me know.
      I am sorry. I guess I should have clarified. I was looking for a Perl GNU Go front-end. I did find several others. But Perl/Tk is as good of a language as any (if not better) for doing GUIs and I was surprised to see that GNU Go did not exist in Perl.
        Yes, I see now that the link I posted was Java. I'm really not into that either, myself! I find Java to be slow and the GUI development painful in comparison with Tk. I love Tk. Continue your project, and upsurp the Sun-users :) I downloaded cygoban 1 just for kicks, and that appears to be a C (or something) Tk program, however I think the Cygoban 1 GUI interface is rather awkward and could definitely be improved. Well, that, and it's not being maintained anymore.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://314161]
Approved by hmerrill
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (5)
As of 2020-10-01 23:56 GMT
Find Nodes?
    Voting Booth?
    My favourite web site is:

    Results (25 votes). Check out past polls.