#!/usr/bin/perl -w
#!/usr/local/bin/perl -w

use strict;
use diagnostics;
use Tk;
use Tk::Dialog;
use Tk::After;
use Tk::ProgressBar;
#use Tk::Photo;

my $colorAvail = 0;

if (eval "require Tk::ColourChooser") {
  $colorAvail = 1;
}

# Constants
# maximum number of highscore entries
use constant MAXHIGH       => 100;
# maximum of allowed chars for a name in the high score
use constant NAMECHARSMAX  => 20;
# path and name of the highscore file
use constant HIGHSCOREFILE => "~/.cascadixHigh";

# Global variables
my $rows                  = 8;  # ! 8  means 0 .. 8  = 9  rows   !
my $cols                  = 24; # ! 24 means 0 .. 24 = 25 columns!
my $offset                = 4;
my $colors                = 3;
my $searchMax             = 40;
my @cpreset1              = ( "tomato2", "LightGoldenrod2", "DeepSkyBlue1");
my @cpreset2              = ( "gray10", "gray50", "gray90");
my @cpreset3              = ( "blue", "green", "red");
my @color                 = @cpreset1;
my $sizeOfItems           = 15;
my $distanceBetweenItems  = 5;
my $form                  = 'rectangle';			#'oval';
my $highscorefile         = tilde(HIGHSCOREFILE);
my $points                = 0;
my $undopoints            = 0;
my $i                     = 1;
my $name;
if ($^O =~ m/Win/) {
  $name = "HansWurst";
}
else {
  $name = getpwuid($<);
}
my $delta;
my $gameSizex;
my $gameSizey;
my $markcolor;

# widgets
my $top;
my $highW;
my $canvas;
my $cProgBar0;
my $cProgBar1;
my $cProgBar2;
my $undoB;

my $marked;
my $x;
my $y;
my $n;
my $j;

# list of list: this is the two dimensional array containing th items
my @lol;
# this is a copy of @lol for one undo move
my @lolcopy;

my @colorlist;
my $nrcolor0;
my $nrcolor1;
my $nrcolor2;
my $cmax;
my $cmin;

# list of hashes
my @highscore;

# main

fillLol();

mainWin();

readHigh();

paintItems();

$top->MainLoop;

# Subs

my $rep = 0;
sub fillLol {

  $rep = 0;
  while (1) {
	@lol = ();
	my $color;

	@colorlist = ();
	for (0 .. 2) { $colorlist[$_] = 0; }

	for $x (0 .. $cols) {
	  for $y (0 .. $rows) {
		# choose a random color
		$color = int(rand 3) + 1;
		# fill the two dimensional array with the color
		$lol[$x][$y] = $color;
		# increase the counter for this color
		$colorlist[$color - 1]++;
	  }
	}

	$cmin = 20;
	$cmax = 60;

	# number of blocks
	my $blocks = ($cols + 1)*($rows + 1);

	# round and calculate the percentage of the colors
	$nrcolor0 = sprintf "%.0f", $colorlist[0]/$blocks*100;
	$nrcolor1 = sprintf "%.0f", $colorlist[1]/$blocks*100;
	$nrcolor2 = sprintf "%.0f", $colorlist[2]/$blocks*100;

	# exit loop when a criteria is met
	last if ($nrcolor0 >= $searchMax or
			 $nrcolor1 >= $searchMax or
			 $nrcolor2 >= $searchMax or
			 $rep >= 1000);

	$rep++;
  }
  #print "searched $rep times\n";
}

# sub printlol {
#   my $text = shift;
#   my $listRef = shift;
#   print "$rows $cols $text ------------------------\n";
#   for ($x = $rows; $x >= 0; $x--) {
# 	for $y ( 0 .. $cols) {
# 	  if ( $$listRef[$y][$x] ) {
# 		if ( $$listRef[$y][$x] == $markcolor) {
# 		  print "* ";
# 		} else {
# 		  print $$listRef[$y][$x]," ";
# 		}
# 	  } else {
# 		print "- ";
# 	  }
# 	}
# 	print "\n";
#   }
#   print "------------------------\n";
# }

# sub printcolor {

#   print "------------------------\n";
#   for ($x = 0; $x <= 2; $x++) {
# 	print "$x $color[$x] $colorlist[$x]\n";
#   }
#   print "------------------------\n";
# }

sub markIt {
  my $x     = shift;
  my $y     = shift;
  my $color = shift;

  # mark this item with the markcolor
  $lol[$x][$y] = $markcolor;
  # count the marked items
  $marked++;

  plopItem($x, $y);

  # look top
  if ($y < $rows) {
	if ($lol[$x][$y+1]) {
	  if ($lol[$x][$y+1] == $color) {
		markIt($x, $y+1, $color);
	  }
	}
  }
  # look right
  if ($x < $cols) {
	if ($lol[$x+1][$y]) {
	  if ($lol[$x+1][$y] == $color) {
		markIt($x+1, $y, $color);
	  }
	}
  }
  # look down
  if ($y > 0) {
	if ($lol[$x][$y-1]) {
	  if ($lol[$x][$y-1] == $color) {
		markIt($x, $y-1, $color);
	  }
	}
  }
  # look left
  if ($x > 0) {
	if ($lol[$x-1][$y]) {
	  if ($lol[$x-1][$y] == $color) {
		markIt($x-1, $y, $color);
	  }
	}
  }

}

sub removeMarked {

  my $i;
  my $j;
  my $aref;

  # from left to right
  for $i ( 0 .. $cols) {
	# and top down
	for ($j = $rows; $j >= 0; $j-- ) {
	  if ($lol[$i][$j]) {		# if element exists
		if ($lol[$i][$j] == $markcolor) { # and its marked
		  splice @{ $lol[$i] }, $j, 1; # cut it out
		}
	  }
	}
  }

  # from right to left
  for ($i = $cols; $i >= 0; $i--) {
	my @array = @{ $lol[$i] };	# @array is a colunm of @lol
	my $sum = 0;
	foreach (@array) {
	  $sum += $_ if (defined($_));
	}							# buid the sum of all elements in col $i
	if ($sum <= 0) {			# if this col is empty
	  splice @lol, $i, 1;		# cut it out of @lol
	}
  }
}

sub paintItems {

  my ($x, $y, $col, $id);
  removeMarked();
  $canvas->delete('all');
  for $x (0 .. $cols) {
	for $y (0 .. $rows) {
	  if ($lol[$x][$y]) {
		if ($lol[$x][$y] > 0) {
		  my $col = $color[$lol[$x][$y]-1];
		  #my $tag = "item-$x-$y";
		  my $id = $canvas->create($form,
								   ($x*$delta + $offset),
								   ($gameSizey - ($y*$delta)),
								   ($x*$delta + $sizeOfItems + $offset),
								   ($gameSizey - ($y*$delta + $sizeOfItems)),
								   -fill => $col,
								  );

		  $canvas->bind($id,'<Button-1>',
						sub {
						  my $i;
						  my @coor = $canvas->coords($id);
						  my $indexx = int($coor[0]/$delta);
						  my $indexy = $rows - int($coor[1]/$delta);
						  $marked = 0;

						  # remember the color
						  my $color = $lol[$indexx][$indexy];

						  # remember the array for undo action
						  copyArray(\@lol, \@lolcopy);
						  $undoB->configure(-state => "normal");
						  markIt($indexx, $indexy, $color);
						  # if just found one, give him the color back and redraw all items
						  if ($marked <= 1) {
							$lol[$indexx][$indexy] = $color;
							paintItems();
							return;
						  }
						  my $newPoints = 0;
						  for ($i = 1; $i <= $marked; $i++) {
							$newPoints = $newPoints + $i;
						  }
						  $points = $points + $newPoints;
						  # remember the additional point for a undo move
						  $undopoints = $newPoints;
						  #removeMarked();
						  paintItems();
						  if (reachedEnd()) {
							eog();
						  }
						});
		}
	  }
	}
  }

}

sub reachedEnd {

  my ($x, $y, $found);

  if (!$lol[0][0]) {
	# cleaned everything up!
	my $dialog =
	  $top->Dialog(-title => "Bonus",
				   -text => "Great!\nYou cleaned everything!\nBonus 500 Points!",
				   -buttons => ["OK"]);
	$dialog->Show();
	$points = $points + 500;
	return 1;
  }

  $found = 0;
  for $x (0 .. $cols) {
	for $y (0 .. $rows) {
	  if ($lol[$x][$y]) {
		if ($lol[$x][$y] > 0 && $lol[$x][$y] < $markcolor) {
		  if (countIt($x, $y, $lol[$x][$y])) {
			$found++;
			last;
		  }
		}
	  } else {
		# we are searching bottom-up,
		# if there is nothing here there can`t be anything
		# in the higher positions
		#print "... is empty\n";
		last;
	  }
	  last if ($found > 0);
	}
	last if ($found > 0);
  }

  if ($found == 0) {
	return 1;
  } else {
	return 0;
  }
}

sub countIt {
  my $x     = shift;
  my $y     = shift;
  my $color = shift;

  # look top
  if ($y < $rows) {
	if ($lol[$x][$y+1]) {
	  if ($lol[$x][$y+1] == $color) {
		return 1;
	  }
	}
  }
  # look right
  if ($x < $cols) {
	if ($lol[$x+1][$y]) {
	  if ($lol[$x+1][$y] == $color) {
		return 1;
	  }
	}
  }
  # look down
  if ($y > 0) {
	if ($lol[$x][$y-1]) {
	  if ($lol[$x][$y-1] == $color) {
		return 1;
	  }
	}
  }
  # look left
  if ($x > 0) {
	if ($lol[$x-1][$y]) {
	  if ($lol[$x-1][$y] == $color) {
		return 1;
	  }
	}
  }
  return 0;
}

sub resetHigh {

  my $i;

  # reset highscore
  @highscore = ();

  # fill with default values
  for ($i = 0; $i < MAXHIGH; $i++) {
	my$rec = {};
	my $name = "John Doe";
	my $points = 0;
	$rec->{"name"} = $name;
	$rec->{"points"} = $points;
	push @highscore, $rec;
  }

  showHigh();
}

# sub printHigh {

#   my $i;
#   foreach (@highscore) {
# 	$i++;
# 	if ($_->{'name'}) {
# 	  print "$i ".$_->{'name'}." ".$_->{'points'}."\n";
# 	}
#   }

# }

sub showHigh {

  my $select = shift;
  $select = $select + 3 if $select;
  my $i;

  if (Exists($highW)) {
	$highW->withdraw();
  }

  # open window
  $highW = $top->Toplevel();

  $highW->title("Cascadix Highscore");

  my $highlist =
	$highW->Scrolled("Listbox",
					 -scrollbars => 'osoe',
					 -selectmode => 'single',
					 -width => 36,
					 -height => 30)->pack(-expand => 1,
										  -fill =>'both',
										  -padx => 3,
										  -pady => 3);

  my $OKB =
	$highW->Button(-text => "OK",
				   -command => sub {
					 $highW->withdraw();
					 return;
				   })->pack(-side => 'top',
							-fill => 'x',
							-padx => 3,
							-pady => 3);

  $OKB->bind('<Return>',
			 sub {
			   $OKB->invoke;
			 }
			);

  $highlist->insert('end', "");
  $highlist->insert('end', "Place Name                    Points");
  $highlist->insert('end', "");

  foreach (@highscore) {
	$i++;
	if ($_->{'name'}) {
	  # the * is the placeholder for NAMECHARSMAX
	  my $line = sprintf " %3d. %-*s %6d", $i, NAMECHARSMAX, $_->{'name'}, $_->{'points'};
	  $highlist->insert('end', $line);
	}
  }

  if ($select) {
	$highlist->selectionSet($select);
	$highlist->see(0);
	$highlist->see($select);
  }

  $highW->waitWindow;

}

sub eog {

  # cut list to maxHigh
  splice @highscore, (MAXHIGH - 1);

  my $i = 0;
  my $inHigh = 0;

  foreach (@highscore) {
	if ($points > $_->{'points'}) {
	  $inHigh = 1;
	  last;
	}
	$i++;
  }

  if ($inHigh or ($i < MAXHIGH)) {
	insertPlayer($i);
  } else {
	my $dialog =
	  $top->Dialog(-title => "EOG: End Of Game",
				   -text => "Game Over\n$points Points.\nThis is too bad for the Highscore.",
				   -buttons => ["I try again!"]);
	$dialog->Show();
  }

  saveHigh();
  showHigh($i-1);
}


sub	insertPlayer {

  my $i =shift;

  my $rc = getName($i+1);
  if ($rc eq "OK") {
	checkName(\$name);
	# cut off the second part and store it in highscoreTmp
	my @highscoreTmp = splice @highscore, $i;

	# insert a new DS
	my $rec = {};				# record zuruecksetzten
	$rec->{'name'} = $name;
	$rec->{'points'} = $points;
	push @highscore, $rec;

	# add the highscoreTmp to highscore
	push @highscore, @highscoreTmp;
  }
}

sub readHigh {

  my ($field, $key, $value);

  if (! -f $highscorefile) {
	warn "readHigh: $highscorefile not found";
	resetHigh();
	#saveHigh();
	return;
  }

  if (!open(DATEI, "<$highscorefile")) {
	warn "readHigh: Can't open $highscorefile: $!\n";
	resetHigh();
	return;
  }

  # reset highscore list
  @highscore = ();

 LINE: while (<DATEI>) {
	next LINE if /^$/;			# Leerzeilen ueberspringen
	next LINE if /^#/;           # Kommentarzeilen ueberspringen
	my $rec;					# record zuruecksetzten
	chomp;						# removes the newlines from $_
  FIELD: for $field ( split /,/) {
	  ($key, $value) = split /=/, $field; # key und value trennen (=-Zeichen)

	  if ($rec->{$key}) {
		warn "$highscorefile Zeile: $.: Der key ($key) ist mehrfach vorhanden!";
	  }
	  $rec->{$key} = $value;
	}

	push @highscore, $rec;
  }

  close(DATEI);

}

sub saveHigh {

  if (!open(SAVEFILE, ">$highscorefile")) {
	warn "Can't open $highscorefile for write: $!\n";
	return 0;
  }

  #my $i;
  foreach ( @highscore ) {
	for my $key ( sort keys %{ $_ } ) {
	  print SAVEFILE "$key=$_->{$key},";
	}
	# Zeilenumbruch am Ende eines Datensatzes
	print SAVEFILE "\n";
  }

  if (!close(SAVEFILE)) {
	warn "error closing $highscorefile: $!\n";
	return 0;
  }
  return 1;
}

sub getName {

  my $p = shift;
  my $rc;

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title("Game over");

  $myDiag->Label(-text => "You reached $points points.\nCongratulation!\nThis is place $p in the highscore!\nPlease enter your name:",
				)->pack(-side => 'top',
						-fill => 'x',
						-padx => 3,
						-pady => 3);

  my $entry =
	$myDiag->Entry(-textvariable => \$name,
				   -width => 80,
				  )->pack(-side => 'top',
						  -fill => 'x',
						  -padx => 3,
						  -pady => 3);


  my $ButF =
	$myDiag->Frame()->pack(-fill =>'x',
						   -padx => 3,
						   -pady => 3);

  my $OKB =
	$ButF->Button(-text => "OK",
				  -command => sub {
					$rc = "OK";
					$myDiag->destroy();
					return "OK";
				  })->pack(-side => 'left',
						   -expand => 1,
						   -fill => 'x',
						   -padx => 3,
						   -pady => 3);

  $entry->bind('<Return>',
			   sub {
				 $OKB->invoke;
			   }
			  );

  $ButF->Button(-text => "Cancel",
				-command => sub {
				  $rc = "Cancel";
				  $myDiag->destroy();
				  return "Cancel";
				}
			   )->pack(-side => 'left',
					   -expand => 1,
					   -fill => 'x',
					   -padx => 3,
					   -pady => 3);

  $myDiag->waitWindow;
  return $rc;

}

##############################################################
#
# tilde
#
##############################################################

sub tilde {

  my $name = shift;

  return $name if ($^O =~ m/Win/);
  $name =~ s{ ^ ~ ( [^/]* ) }
	{ $1
		? (getpwnam($1))[7]
		  : ( $ENV{HOME} || $ENV{LOGDIR}
			  || (getpwuid($<))[7]
			)
		}ex;

  return $name;
}

sub display {

  my $distcopy   = $distanceBetweenItems;
  my $distcancel = $distanceBetweenItems;
  my $sizecopy   = $sizeOfItems;
  my $sizecancel = $sizeOfItems;
  my $formcopy   = $form;
  my $formcancel = $form;

  # open window
  my $displayW = $top->Toplevel();
  $displayW->title("Display Options");

  $displayW->Label(-text => "Size of items",
				  )->pack(-fill => 'x');

  $displayW->Scale(-variable => \$sizecopy,
				   -orient => 'horizontal',
				   -from => 5,
				   -to => 40,
				   -relief => 'raised'
				  )->pack(-fill   =>'x',
						  -expand => 1);

  $displayW->Label(-text => "Distance between items",
				  )->pack(-fill => 'x');

  $displayW->Scale(-variable => \$distcopy,
				   -orient => 'horizontal',
				   -from => 1,
				   -to => 10,
				   -relief => 'raised'
				  )->pack(-fill   =>'x',
						  -expand => 1);

  $displayW->Label(-text => "Shape of items",
				  )->pack(-fill => 'x');

  $displayW->Radiobutton(-text => "Circle",
						 -variable => \$formcopy,
						 -value => "oval")->pack(-fill =>'x');
  $displayW->Radiobutton(-text => "Rectangle",
						 -variable => \$formcopy,
						 -value => "rectangle")->pack(-fill =>'x');


  my $butF =
	$displayW->Frame(-relief => 'raised',
					 -borderwidth => 2)->pack(-side => 'left',
											  -fill => 'x');

  $butF->Button(-text => "OK",
				-command => sub {
				  $distanceBetweenItems = $distcopy;
				  $form = $formcopy;
				  $sizeOfItems = $sizecopy;
				  mainWin();
				  paintItems();
				  $displayW->withdraw();
				}
			   )->pack(-side=>'left',
					   -fill =>'both');

  $butF->Button(-text => "Apply",
				-command => sub {
				  $distanceBetweenItems = $distcopy;
				  $sizeOfItems = $sizecopy;
				  $form = $formcopy;
				  mainWin();
				  paintItems();
				}
			   )->pack(-side=>'left',
					   -fill =>'both');

  $butF->Button(-text => "Cancel",
				-command => sub {
				  $distanceBetweenItems = $distcancel;
				  $sizeOfItems = $sizecancel;
				  $form = $formcancel;
				  mainWin();
				  paintItems();
				  $displayW->withdraw();
				}
			   )->pack(-side=>'right',
					   -fill =>'both');
}

sub gameSize {

  my $rowscopy   = $rows + 1;
  my $colscopy   = $cols + 1;
  my $rowscancel = $rows;
  my $colscancel = $cols;

  # open window
  my $gameSizeW = $top->Toplevel();
  $gameSizeW->title("Game Size");

  $gameSizeW->Label(-text => "Rows:",
				   )->pack(-fill => 'x');

  $gameSizeW->Scale(-variable => \$rowscopy,
					-orient => 'horizontal',
					-from => 3,
					-to => 9,
					-relief => 'raised'
				   )->pack(-fill   =>'x',
						   -expand => 1);

  $gameSizeW->Label(-text => "Columns:",
				   )->pack(-fill => 'x');

  $gameSizeW->Scale(-variable => \$colscopy,
					-orient => 'horizontal',
					-from => 3,
					-to => 25,
					-relief => 'raised'
				   )->pack(-fill   =>'x',
						   -expand => 1);

  my $butF =
	$gameSizeW->Frame(-relief => 'raised',
					  -borderwidth => 2)->pack(-side => 'left',
											   -fill => 'x');

  $butF->Button(-text => "OK",
				-command => sub {
				  if ($rows != ($rowscopy - 1) or $cols != ($colscopy - 1)) {
					$rows = $rowscopy - 1;
					$cols = $colscopy - 1;
					fillLol();
					$points = 0;
					mainWin();
					paintItems();
				  }
				  $gameSizeW->withdraw();
				}
			   )->pack(-side=>'left',
					   -fill =>'both');

  $butF->Button(-text => "Apply",
				-command => sub {
				  if ($rows != ($rowscopy - 1) or $cols != ($colscopy - 1)) {
					$rows = $rowscopy - 1;
					$cols = $colscopy - 1;
					fillLol();
					$points = 0;
					mainWin();
					paintItems();
				  }
				}
			   )->pack(-side=>'left',
					   -fill =>'both');

  $butF->Button(-text => "Cancel",
				-command => sub {
				  if ($rows != $rowscancel or $cols != $colscancel) {
					$rows = $rowscancel;
					$cols = $colscancel;
					fillLol();
					$points = 0;
					mainWin();
					paintItems();
				  }
				  $gameSizeW->withdraw();
				}
			   )->pack(-side=>'right',
					   -fill =>'both');
}


sub mainWin {

  $delta = $sizeOfItems + $distanceBetweenItems;
  $gameSizex = ($cols + 1) * ($delta);
  $gameSizey = ($rows +1) * ($delta);
  $markcolor = $colors + 1;

  if (Exists($top)) {
	$top->withdraw();
  }

  my @cascadixRCSVersion = split / /, '$Revision: 1.4 $';
  my $cascadixVersion = "0.".$cascadixRCSVersion[1];

  $top = MainWindow->new;
  $top->title("Cascadix $cascadixVersion");

  # create the menu
  my $menu = $top->Frame(-relief => 'raised',
						 -borderwidth => 2)->pack(-fill => 'x');

  $menu->Menubutton(-text => "Options",
					-menuitems => [
								   [ 'command' => "Display",
									 -command => \&display ],
								   [ 'command' => "Game Size",
									 -command => \&gameSize ],
								   [ 'command' => "Color",
									 -command => \&color ],
								  ]
				   )->pack(-side => 'left');

  my $gameF = $top->Frame(-relief => 'raised',
						  -borderwidth => 2)->pack(-side => 'left',
												   -fill => 'x');
  my $butF = $top->Frame(-relief => 'raised',
						 -borderwidth => 2)->pack(-side => 'right',
												  -fill => 'both');

  # point
  $butF->Label(-textvariable => \$points,
			  )->pack(-side => 'top',
					  -fill => 'both');

  $canvas = $gameF->Canvas(-width => $gameSizex,
						   -height => $gameSizey,
						   -relief => 'sunken',
						   -bd =>2)->pack(-side=>'top',
										  -fill =>'both');;

  my $newGame =
	$butF->Button(-text => "New Game",
				  -command => sub {
					if (Exists($highW)) {
					  $highW->withdraw();
					}
					$canvas->delete('all');
					fillLol();
					$points = 0;
					paintItems();
					$undoB->configure(-state => "disabled");
				  }
				 )->pack(-side=>'top',
						 -fill =>'both');

  $newGame->bind('<Return>',
				 sub {
				   $newGame->invoke;
				 }
				);

  $undoB =
	$butF->Button(-text => "Undo",
				  -state => "disabled",
				  -command => sub {
					copyArray(\@lolcopy, \@lol);
					paintItems();
					$points -= $undopoints;
					$undoB->configure(-state => "disabled");
				  }
				 )->pack(-side=>'top',
						 -fill =>'both');


  $butF->Button(-text => "Highscore",
				-command => sub {
				  showHigh();
				}
			   )->pack(-side=>'top',
					   -fill =>'both');

  # quit button
  $butF->Button(-text => "Quit",
				-command => sub {
				  exit;
				}
			   )->pack(-side=>'top',
					   -fill =>'both');

  my $cF0 = $butF->Frame(-relief => 'raised',
						 -borderwidth => 2)->pack(-side => 'top',
												  -fill => 'x');
  $cProgBar0 =
	$cF0->ProgressBar(
					  -borderwidth => 1,
					  -relief => 'sunken',
					  -width => 9,
					  -length => 70,
					  -padx => 1,
					  -pady => 1,
					  -variable => \$nrcolor0,
					  -colors => [0 => $color[0]],
					  -troughcolor => 'grey80',
					  -resolution => 1,
					  -blocks => 1,
					  -anchor => 'n',
					  -from => $cmin,
					  -to => $cmax
					 )->pack(-side => 'left',
							 -fill => 'x',
							 -padx => 3,
							 -pady => 0);

  $cF0->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
  $cF0->Label(-textvariable => \$nrcolor0,
			 )->pack(-side => 'right',
					 -fill => 'both');

  my $cF1 = $butF->Frame(-relief => 'raised',
						 -borderwidth => 2)->pack(-side => 'top',
												  -fill => 'x');
  $cProgBar1 =
	$cF1->ProgressBar(
					  -borderwidth => 1,
					  -relief => 'sunken',
					  -width => 9,
					  -length => 70,
					  -padx => 1,
					  -pady => 1,
					  -variable => \$nrcolor1,
					  -colors => [0 => $color[1]],
					  -troughcolor => 'grey80',
					  -resolution => 1,
					  -blocks => 1,
					  -anchor => 'n',
					  -from => $cmin,
					  -to => $cmax
					 )->pack(-side => 'left',
							 -fill => 'x',
							 -padx => 3,
							 -pady => 0);

  $cF1->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
  $cF1->Label(-textvariable => \$nrcolor1,
			 )->pack(-side => 'right',
					 -fill => 'both');

  my $cF2 = $butF->Frame(-relief => 'raised',
						 -borderwidth => 2)->pack(-side => 'top',
												  -fill => 'x');
  $cProgBar2 =
	$cF2->ProgressBar(
					  -borderwidth => 1,
					  -relief => 'sunken',
					  -width => 9,
					  -length => 70,
					  -padx => 1,
					  -pady => 1,
					  -variable => \$nrcolor2,
					  -colors => [0 => $color[2]],
					  -troughcolor => 'grey80',
					  -resolution => 1,
					  -blocks => 1,
					  -anchor => 'n',
					  -from => $cmin,
					  -to => $cmax
					 )->pack(-side => 'left',
							 -fill => 'x',
							 -padx => 3,
							 -pady => 0);

  $cF2->Label(-text => "%")->pack(-side => 'right', -fill => 'both');
  $cF2->Label(-textvariable => \$nrcolor2,
			 )->pack(-side => 'right',
					 -fill => 'both');


}

sub color {

  my @colorcopy = @color;
  my @colorcancel = @color;

  my @cbut;

  # open window
  my $colorW = $top->Toplevel();
  $colorW->title("Game Size");

  if ($colorAvail) {
	$colorW->Label(-text => "Colors",
				  )->pack(-fill => 'x');

	my $cbutF =
	  $colorW->Frame(-relief => 'raised',
					 -borderwidth => 2)->pack(-fill => 'x');

	my $activec;
	my $i = 0;

	foreach $activec (@colorcopy) {

	  $cbut[$i] =
		$cbutF->Button(-text => $activec,
					   -background => $activec,
					   -command => sub {
						 my $colorD =
						   $top->ColourChooser(-colour => $activec);
						 my $col = $colorD->Show;
						 $activec = $col if ($col);
						 for (my $j = 0; $j <= $#colorcopy; $j++) {
						   $cbut[$j]->configure(-text => $colorcopy[$j]);
						   $cbut[$j]->configure(-background => $colorcopy[$j]);
						 }
					   }
					  )->pack(-side => 'left');
	  $i++;
	}
  } else {
	$colorW->Label(-text => "Sorry, the module Tk::ColourChooser is not available!",
				  )->pack(-fill => 'x');
  }

  $colorW->Label(-text => "Color presets",
				)->pack(-fill => 'x');

  my $csbutF =
	$colorW->Frame(-relief => 'raised',
				   -borderwidth => 2)->pack(-fill => 'x');

  $csbutF->Button(-text => "Preset1",
				  -background => $cpreset1[0],
				  -command => sub {
					@colorcopy = @cpreset1;
					my $i = 0;
					foreach (@cbut) {
					  $_->configure(-background => $colorcopy[$i]);
					  $_->configure(-text => $colorcopy[$i]);
					  $i++;
					}
				  }
				 )->pack(-side=>'left',
						 -expand => 1,
						 -fill =>'both');

  $csbutF->Button(-text => "Preset2",
				  -background => $cpreset2[0],
				  -command => sub {
					@colorcopy = @cpreset2;
					my $i = 0;
					foreach (@cbut) {
					  $_->configure(-background => $colorcopy[$i]);
					  $_->configure(-text => $colorcopy[$i]);
					  $i++;
					}
				  }
				 )->pack(-side=>'left',
						 -expand => 1,
						 -fill =>'both');

  $csbutF->Button(-text => "Preset3",
				  -background => $cpreset3[0],
				  -command => sub {
					@colorcopy = @cpreset3;
					my $i = 0;
					foreach (@cbut) {
					  $_->configure(-background => $colorcopy[$i]);
					  $_->configure(-text => $colorcopy[$i]);
					  $i++;
					}
				  }
				 )->pack(-side=>'left',
						 -expand => 1,
						 -fill =>'both');

  my $butF =
	$colorW->Frame(-relief => 'raised',
				   -borderwidth => 2)->pack(-fill => 'x');

  $butF->Button(-text => "OK",
				-command => sub {
				  @color = @colorcopy;
				  paintItems();
				  $colorW->withdraw();
				}
			   )->pack(-side=>'left',
					   -expand => 1,
					   -fill =>'both');

  $butF->Button(-text => "Apply",
				-command => sub {
				  @color = @colorcopy;
				  paintItems();
				}
			   )->pack(-side=>'left',
					   -fill =>'both');

  $butF->Button(-text => "Cancel",
				-command => sub {
				  @color = @colorcancel;
				  paintItems();
				  $colorW->withdraw();
				}
			   )->pack(-side=>'right',
					   -fill =>'both');

}

sub plopItem {

	my $x = shift;
	my $y = shift;

	if ($lol[$x][$y] != $markcolor) {
	  warn "plopItem: $x $y is not $markcolor!";
	  return;
	}

	my $bgc = $canvas->cget(-background);

	my $item = $canvas->find('closest', ($x*$delta + $offset), ($gameSizey - ($y*$delta)));
	$canvas->delete($item);

	createDelete($x, $y, ($sizeOfItems+8), ($offset-4), "red");
	createDelete($x, $y, ($sizeOfItems-4), ($offset+2), "blue");
	return;

  }

sub createDelete {

  my $x = shift;
  my $y = shift;
  my $sizeOfItems = shift;
  my $offset = shift;
  my $color = shift;

  my $id = $canvas->create($form,
						   ($x*$delta + $offset),
						   ($gameSizey - ($y*$delta)),
						   ($x*$delta + $sizeOfItems + $offset),
						   ($gameSizey - ($y*$delta + $sizeOfItems)),
						   -fill => $color,
						  );
  $top->update();
  $top->after(3);
  $canvas->delete($id);
  $top->update();
  $top->after(3);

}


sub copyArray {

  my $arrayARef = shift;
  my $arrayBRef = shift;
  my $x;
  my $y;
  for $x (0 .. $cols) {
	for $y (0 .. $rows) {
	  $$arrayBRef[$x][$y] = $$arrayARef[$x][$y];
	}
  }
}

sub checkName {
  my $nameR = shift;

  if (!$$nameR or $$nameR eq "") {
	$$nameR = "A. Nonym";
  }
  # cut to max length if necessary
  if (length($$nameR) > NAMECHARSMAX) {
	$$nameR = substr($$nameR,0,NAMECHARSMAX);
  }

  # replace , by ;
  $$nameR =~ s/,/;/;
}