#!/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=>"20"],
			[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, $fields]);
}

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