#!perl
use warnings;
use strict;
use Tk;
require Tk::ROText;

my $MW=MainWindow->new;
$MW->title("Jump!");
$MW->geometry("775x240+10+10");
my $game_frame=$MW->Frame->pack;

$MW->fontCreate('readable', -family => 'arial', -size => 13);

my $instruct=$game_frame->ROText(	-wrap => "word", 
				 	-height => 4, 
					-font => "readable", 
					-relief => "flat",
					-takefocus => 0 )->grid (-row => 0, -columnspan=>13);
$instruct->insert('end', "You've five red and five blue chips. One space is blank. Red chips can only move to the right, blue chips to the left. Any chip can move into the blank space. A red chip can jump over a single blue chip into the blank space. A blue chip can jump over a single red chip into the blank space. Your goal is to get all the reds on the right, and all the blues on the left.");

my @button;
for (1..11) {
  $button[$_]=$game_frame->Button(	-text => "X", 
					-width => 8, 
					-height =>4, 
					-relief => "solid",
					-activeforeground => "black", 
					-borderwidth => 3,
					-command => [ \&move, $_ ] )->
						grid(-row => 1, -column => $_);
}

$game_frame->Button(	-text => "Start Over",
			-command => [ \&setup ],
			-font => "readable" ) -> grid(-row =>2, -columnspan => 13, -pady => 2);
my $msg;
my $message=$game_frame->Label (-textvariable => \$msg, -font => "readable", -foreground => "red") ->
		 grid(-row=>3, -columnspan => 13);
setup();

MainLoop;

sub setup {
  $msg="";
  for (1..5) {
    make_color("red", $_);
  }
  for (7..11) {
    make_color("blue", $_);
  }
  make_blank(6);
}

sub make_color {
  my ($c, $index) = @_;
  $button[$index]->configure (	-activebackground => $c,
				-foreground => $c,
				-background => $c,
				-state => "normal");
}

sub make_blank {
  $_=shift;
  $button[$_]->configure (	-background => "white",
				-foreground => "black",
				-activebackground => "white",
				-state => "disabled",
				-disabledforeground => "black");
}

sub move {
  $msg="";
  $_=shift;
  my $old_color = $button[$_]->cget(-background);
  if ($old_color eq "red") {
    if ($_ == 11) {
      alert(1);
    } elsif ($button[$_+1]->cget(-background) eq "red") {
      alert(2);
    } elsif ($_ <= 9 && $button[$_+1]->cget(-background) eq "blue" && $button[$_+2]->cget(-background) ne "white") {
      alert(3);
    } elsif ($button[$_+1]->cget(-background) eq "white") {
      make_color ("red", $_+1);
      make_blank ($_);
      check_win();
    } else {
      make_color ("red", $_+2);
      make_blank ($_);
      check_win();
    }
  }

  if ($old_color eq "blue") {
    if ($_ == 1) {
      alert(1);
    } elsif ($button[$_-1]->cget(-background) eq "blue") {
      alert(2);
    } elsif ($_ >= 2 && $button[$_-1]->cget(-background) eq "red" && $button[$_-2]->cget(-background) ne "white") {
      alert(3);
    } elsif ($button[$_-1]->cget(-background) eq "white") {
      make_color ("blue", $_-1);
      make_blank ($_);
      check_win();
    } else {
      make_color ("blue", $_-2);
      make_blank ($_);
      check_win();
    }
  }
}

sub alert {
  $_=shift;
  if ($_ == 1) {
    $msg = "You can't move any further than the end!";
  } elsif ($_ == 2) {
    $msg = "You can't jump over the same color chip!";
  } elsif ($_ == 3) {
    $msg = "You can only jump over the opposite colored chip if the next space is blank!";
  } else {
    $msg = "You won!";
    for (1..11) {
      $button[$_]->configure(-state => "disabled");
    }
    for (1..5) {
      $button[$_]->configure(-disabledforeground => "blue");
    }
    $button[6]->configure(-disabledforeground => "white");
    for (7..11) {
      $button[$_]->configure(-disabledforeground => "red");
    }
  }
}

sub check_win {
  for (1..5) {
    if ( $button[$_]->cget(-background) ne "blue" ) {
      return;
    }
  }
  for (7..11) {
    if ( $button[$_]->cget(-background) ne "red" ) {
      return;
    }
  }
  alert(4);
}