#! /usr/local/bin/perl

use strict;
use Tk;
use Pod::Text;
use Tk::Pod;

my $VERSION = '0.1';
my $MAN_PATH = "/users/dovl/local/man";
my $MAN_PAGE = "/mandovl/diamondMine.dovl";
my $MAN_VIEWER = "/usr/dt/bin/dthelpview";
my $LIB_PATH = "/users/dovl/local/perl/lib";

my $defaultColor = 'grey80';
my @fieldOfWidgets = ();
my $score = 0;
my $rUSure = 'Cancel';
my $debug = 0;

$debug = 1 if ($ARGV[0] eq 'debug');

sub MainFunction;				# calls CheckPerformMoves and FillField while there are automatic moves left
sub CreateField;				# creates a field of 8x8 grey buttons
sub FillField;					# fills the field from top to bottom, left to right (0,0) -> (7,7)
sub CheckPerformMoves;			# checks if there are any cells to erase and replace and does so (if neccesary)
sub MoveGrey;					# move grey cell up
sub CheckAnyMoreMoves;			# checks if there are any more possible moves left
sub CheckMoveProposed;			# checks the legality of the move proposed by the user and performs it if legal
sub NewGame;					# starts new game
sub OkCanc;						# displays an "are you sure" message
sub help;						# displays the man page
sub GetColor;					# sets the activebackground to the current color - SERIOUS DEMAND ON COMPUTATION!!!

my $MW = MainWindow -> new();
$MW -> title("Diamond Mine $VERSION (dovl)");
$MW -> resizable(0, 0);
if (-e "$LIB_PATH/diamond3b.gif"){
	my $icon=$MW->Photo(-file=>"$LIB_PATH/diamond3b.gif",-palette =>'red');#agembaras
	$MW->Icon(-image=>$icon,);
}

my $menuFrame = $MW -> Frame(-background => 'grey85',
	-background => 'grey85',);
	$menuFrame -> pack(-fill => 'x',);
my $playField = $MW-> Frame -> pack(-side => 'top',);
my $mainMenu = $menuFrame -> Menubutton (-text => 'Menu',
	-background => 'grey85',
	-underline => '0');
	$mainMenu -> pack (-side => 'left',
	);
	
	
my $helpMenu = $menuFrame -> Menubutton (-text => 'Help',
	-background => 'grey85',
	-underline => '0',
	);
	$helpMenu -> pack (-side => 'right',);


my $scoreFrame = $MW -> Label (-anchor => 'center',
	-relief => 'ridge',
	-background => 'grey85',
	-font => '-adobe-courier-bold-r-normal-*-*-240-*-*-m-*-koi8-1',
	-textvariable => \$score,
	);
	$scoreFrame	-> pack(-fill => 'both',
			-side => 'top',
			-before => $playField,
			);

	$mainMenu -> command(
		-label => 'New Game',
		-background => 'grey85',
		-underline => '0',
		-command => [sub {\&NewGame(\@fieldOfWidgets, \$playField, \$score);
							$score = 0;}],
	);
	$mainMenu -> separator;
	$mainMenu -> command(
		-label => 'Exit Game',
		-background => 'grey85',
		-underline => '0',
		-command => [sub {\&OkCanc($MW, "Are You Sure?", \$rUSure);
			$MW -> Tk::destroy() if ($rUSure eq 'Ok');}],
	);

	$helpMenu -> command(
		-label => 'Help',
		-background => 'grey85',
		-underline => '0',
		-command => [sub {&help (\$MAN_PATH, \$MAN_PAGE, \$MAN_VIEWER)}],
	);
		
\&NewGame(\@fieldOfWidgets, \$playField, \$score);

MainLoop;

sub NewGame {
	my $localFieldOfWidgets = shift;
	my $localPlayField = shift;
	my $localScore = shift;

	my $counter;

	print "NewGame\n" if $debug;
	
	@$localFieldOfWidgets = ();
	my @localPlayFieldKids = $$localPlayField -> children();
	foreach (@localPlayFieldKids) {$_ -> Tk::destroy();}
	
	\&CreateField($localFieldOfWidgets, $localPlayField, $localScore);
	\&FillField($localFieldOfWidgets);
	\&MainFunction($localFieldOfWidgets, \$counter, $localScore);
	$$localScore = 0;
}	
	
sub MainFunction{
	my $localFieldOfWidgets = shift;
	my $counter = shift;
	my $localScore = shift;

	my $numOfReplacements;
	my $perform = 1; 
	$$counter = -1;

	my $anyMoreMoves;

	print "MainFunction\n" if $debug;
	
	do{
		++$$counter;
		\&CheckPerformMoves($localFieldOfWidgets, \$numOfReplacements, \$perform);
		if ($numOfReplacements>0){
			\&MoveGrey($localFieldOfWidgets) if ($numOfReplacements>0);
			\&FillField($localFieldOfWidgets);
			$$localScore += (10 * ($numOfReplacements-1));		# numOfReplacements=2 for 3 cells => for 3 cells: 10 points, 4 cells: 20 points...
		}
	}
	while($numOfReplacements>0);
	\&CheckAnyMoreMoves($localFieldOfWidgets, \$anyMoreMoves);
}	

sub CreateField{
	my $localFieldOfWidgets = shift;
	my $localPlayField = shift;
	my $localScore = shift;

	my $numOfPressedButtons = 0;	# follows the ammount of pressed buttons. if only one, wait for the second one
	my @firstButton;
	my @secondButton;

	print "CreateField\n" if $debug;
	
	foreach my $line (0..7){
		$$localFieldOfWidgets[$line][0] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',) -> grid(
			$$localFieldOfWidgets[$line][1] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',),
			$$localFieldOfWidgets[$line][2] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',),
			$$localFieldOfWidgets[$line][3] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',),
			$$localFieldOfWidgets[$line][4] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',),
			$$localFieldOfWidgets[$line][5] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',),
			$$localFieldOfWidgets[$line][6] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',),
			$$localFieldOfWidgets[$line][7] = $$localPlayField -> Button(-relief => 'flat', -borderwidth => '2', -background => 'grey85',)
		);
	}

	foreach my $line (0..7){
		foreach my $col (0..7){
			$$localFieldOfWidgets[$line][$col] -> bind ("<Enter>", [sub {\&GetColor(\$line, \$col, $localFieldOfWidgets)}]);
			$$localFieldOfWidgets[$line][$col] -> configure(-command => [sub {
				if ($numOfPressedButtons == 0){
					++$numOfPressedButtons;
					$$localFieldOfWidgets[$line][$col] -> configure(-relief => 'sunken');
					@firstButton = ($line, $col);
				}
				else{
					$numOfPressedButtons = 0;
					@secondButton = ($line, $col);
					$$localFieldOfWidgets[$line][$col] -> configure(-relief => 'sunken');
					for my $i (0..50000){};
					\&CheckMoveProposed($localFieldOfWidgets, \@firstButton, \@secondButton, $localScore);
				}
			}]);
		}
	}	
}

sub FillField{
	my $localFieldOfWidgets = shift;

	my @colors = ('blue', 'orchid1', 'yellow', 'red', 'LawnGreen', 'dark blue', 'orange');

	print "FillField\n" if $debug;
	
	for my $line(0..7){
		foreach my $column (0..7){
			my $currentColor = $$localFieldOfWidgets[$line][$column] -> cget(-background);
			$$localFieldOfWidgets[$line][$column] -> configure(-background => "$colors[rand 7]") unless (grep m/$currentColor/, @colors);
		}
	}
}	

sub CheckPerformMoves{
	my $localFieldOfWidgets = shift;
	my $localNumOfReplacements = shift;
	my $localPerform = shift;

	print "CheckPerformMoves\n" if $debug;
	
	$$localNumOfReplacements = 0;

	# test for rows containing 3 or more nieghbouring cells of the same color
	for (my $localRow = 0; $localRow <= 7 ; ++$localRow){
		for (my $localCol = 0; $localCol <= 5 ; ++$localCol){
			my $color1 = $$localFieldOfWidgets[$localRow][$localCol+0] -> cget(-background);
			my $color2 = $$localFieldOfWidgets[$localRow][$localCol+1] -> cget(-background);
			my $color3 = $$localFieldOfWidgets[$localRow][$localCol+2] -> cget(-background);

			# if there are 3 occurances
			if (($color1 eq $color2) & ($color2 eq $color3) & ($color1 ne 'grey85')){
				$$localNumOfReplacements = 2;

				# if only checking return from function
				return unless $$localPerform;

				$$localFieldOfWidgets[$localRow][$localCol+0] -> configure (-text => 'x');
				$$localFieldOfWidgets[$localRow][$localCol+1] -> configure (-text => 'x');
				$$localFieldOfWidgets[$localRow][$localCol+2] -> configure (-text => 'x');
				# test for more occurances
COL_SEARCH:		for my $subcolumn (($localCol+3)..7){
					my $color4 = $$localFieldOfWidgets[$localRow][$subcolumn] -> cget(-background);
					last COL_SEARCH unless ($color4 eq $color3);
					$$localFieldOfWidgets[$localRow][$subcolumn] -> configure (-text => 'x') if $$localPerform;
					++$$localNumOfReplacements;
				}	
				print "line match - on line $localRow starting on column $localCol ($$localNumOfReplacements+1 occurances)\n" if $debug;

				# if only checking
				return unless $$localPerform;
			}	
		}
	}



	# test for columns containing 3 or more nieghbouring cells of the same color
	for (my $localRow =7 ; $localRow >=2 ; --$localRow){
		for (my $localCol = 0; $localCol <= 7 ; ++$localCol){
			my $color1 = $$localFieldOfWidgets[$localRow-0][$localCol] -> cget(-background);
			my $color2 = $$localFieldOfWidgets[$localRow-1][$localCol] -> cget(-background);
			my $color3 = $$localFieldOfWidgets[$localRow-2][$localCol] -> cget(-background);

			# if there are 3 occurances
			if (($color1 eq $color2) & ($color2 eq $color3) & ($color1 ne 'grey85')){
				$$localNumOfReplacements = $$localNumOfReplacements + 2;

				# if only checking return from function
				return unless $$localPerform;

				$$localFieldOfWidgets[$localRow-0][$localCol] -> configure(-text => 'x');
				$$localFieldOfWidgets[$localRow-1][$localCol] -> configure(-text => 'x');
				$$localFieldOfWidgets[$localRow-2][$localCol] -> configure(-text => 'x');
				# test for more occurances
ROW_SEARCH:		for (my $subline=($localRow-3) ; $subline>=0 ; --$subline){
					my $color4 = $$localFieldOfWidgets[$subline][$localCol] -> cget(-background);
					last ROW_SEARCH unless ($color4 eq $color3);
					$$localFieldOfWidgets[$subline][$localCol] -> configure(-text => 'x') if $$localPerform;
					++$$localNumOfReplacements;
				}	
				print "column match - in column $localCol starting on line $localRow ($$localNumOfReplacements+1 occurances)\n" if $debug;
			}	
		}
	}

	for my $row (0..7){
		for my $column (0..7){
			my $text = $$localFieldOfWidgets[$row][$column] -> cget(-text);
			if ($text eq 'x'){
				$$localFieldOfWidgets[$row][$column] -> configure(-text => '');
				$$localFieldOfWidgets[$row][$column] -> configure(-background => 'grey85');
			}
		}
	}

}	


sub MoveGrey{
	my $localFieldOfWidgets = shift;

	print "MoveGrey\n" if $debug;
	
	for my $column (0..7){
		for my $i (0..7){
			for my $row (0..6){
				my $color1 = $$localFieldOfWidgets[$row+1][$column] -> cget(-background);
				if ($color1 eq 'grey85'){
					my $color2 = $$localFieldOfWidgets[$row][$column] -> cget(-background);
					print "i=$i, row=$row, column=$column, color1=$color1, color2=$color2\n" if $debug;
					$$localFieldOfWidgets[$row][$column] -> configure (-background => "$color1");
					$$localFieldOfWidgets[$row+1][$column] -> configure (-background => "$color2");
				}
			}
		}
	}
}	
			

sub CheckMoveProposed{
	my $localFieldOfWidgets = shift;
	my $localFirstButton = shift;		# reference to (row, col) of first button
	my $localSecondButton = shift;		# reference to (row, col) of second button
	my $localScore = shift;

	my $replacementCounter;

	print "CheckMoveProposed\n" if $debug;
	
	$$localFieldOfWidgets[$$localFirstButton[0]][$$localFirstButton[1]] -> configure(-relief => 'flat');
	$$localFieldOfWidgets[$$localSecondButton[0]][$$localSecondButton[1]] -> configure(-relief => 'flat');

	if ((($$localFirstButton[0] == $$localSecondButton[0]) && 
			(($$localFirstButton[1] == ($$localSecondButton[1]+1)) || ($$localFirstButton[1] == ($$localSecondButton[1]-1)))) ||
		(($$localFirstButton[1] == $$localSecondButton[1]) && 
			(($$localFirstButton[0] == ($$localSecondButton[0]+1)) || ($$localFirstButton[0] == ($$localSecondButton[0]-1))))){

		my $color1 = $$localFieldOfWidgets[$$localFirstButton[0]][$$localFirstButton[1]] -> cget(-background);
		my $color2 = $$localFieldOfWidgets[$$localSecondButton[0]][$$localSecondButton[1]] -> cget(-background);
		$$localFieldOfWidgets[$$localFirstButton[0]][$$localFirstButton[1]] -> configure (-background => "$color2");
		$$localFieldOfWidgets[$$localSecondButton[0]][$$localSecondButton[1]] -> configure (-background => "$color1");
		
		\&MainFunction($localFieldOfWidgets, \$replacementCounter, $localScore);
		if ($replacementCounter == 0){
			$$localFieldOfWidgets[$$localFirstButton[0]][$$localFirstButton[1]] -> configure (-background => "$color1");
			$$localFieldOfWidgets[$$localSecondButton[0]][$$localSecondButton[1]] -> configure (-background => "$color2");
		}
	}
}	

sub	CheckAnyMoreMoves{
	my $localFieldOfWidgets = shift;
	my $anyMoreMoves = shift;

	my $numOfReplacements;
	my $perform = 0;

	print "CheckAnyMoreMoves\n" if $debug;
	
	foreach my $line (0..7){
		foreach my $column (0..6){
			my $color1 = $$localFieldOfWidgets[$line][$column] -> cget(-background);
			my $color2 = $$localFieldOfWidgets[$line][$column+1] -> cget(-background);
			$$localFieldOfWidgets[$line][$column] -> configure (-background => "$color2");
			$$localFieldOfWidgets[$line][$column+1] -> configure (-background => "$color1");
			\&CheckPerformMoves($localFieldOfWidgets, \$numOfReplacements, \$perform);
			$$localFieldOfWidgets[$line][$column] -> configure (-background => "$color1");
			$$localFieldOfWidgets[$line][$column+1] -> configure (-background => "$color2");
			return if ($numOfReplacements > 0);
		}
	}
	foreach my $column (0..7){
		foreach my $line (0..6){
			my $color1 = $$localFieldOfWidgets[$line][$column] -> cget(-background);
			my $color2 = $$localFieldOfWidgets[$line+1][$column] -> cget(-background);
			$$localFieldOfWidgets[$line][$column] -> configure (-background => "$color2");
			$$localFieldOfWidgets[$line+1][$column] -> configure (-background => "$color1");
			\&CheckPerformMoves($localFieldOfWidgets, \$numOfReplacements, \$perform);
			$$localFieldOfWidgets[$line][$column] -> configure (-background => "$color1");
			$$localFieldOfWidgets[$line+1][$column] -> configure (-background => "$color2");
			return if ($numOfReplacements > 0);
		}
	}

	# will reach here only if there are no more moves
	my $mw = MainWindow -> new(-background => 'grey85',);
	my $text = $mw -> Label (-text => 'No More Moves', -background => 'grey85',) -> pack(-fill => 'both');
	my $okButton = $mw -> Button (-text => 'OK',  -background => 'grey85', -command => [sub {$mw -> Tk::destroy();}]) -> pack ();
	MainLoop;
}	

sub OkCanc
{
  my $win = shift;
  my $message = shift;
  my $answer_p = shift;
  my $yesno = $win -> Dialog (
                    -text => "$message",
                    -background => 'gray85',
                    -buttons => ["Ok","Cancel"]);
  $$answer_p = $yesno -> Show;
  $yesno -> destroy();
}

sub help{

	my $localManPath = shift;
	my $localManPage = shift;
	my $localManViewer = shift;
	
	$ENV{MANPATH} .= ":$$localManPath";

	if ((-e "$$localManPath"."$$localManPage") && (-e "$$localManViewer")){
		system("$$localManViewer -manPage diamondMine");}
	else{
		my $help_win = MainWindow->new(-background => 'grey85',);
		$help_win -> title("Help");
		$help_win -> resizable(0, 0);
		my $actual_data = $help_win -> Scrolled(
			'Text',
			-background => 'grey85',
		    -scrollbars => 'oe',
	        -width      => '80',
	        -height     => '40',
	        -wrap       => 'word',
			);
		$actual_data -> pack(
			-pady => '20',
			-padx => '10',
			-side =>'top',
			-fill => 'both',
			);
		
		$localManPage = `pod2text $0`;
		$actual_data ->insert("end",$localManPage);
				
		my $ok_btn = $help_win -> Button(
			-text => 'OK',
			-command => [$help_win => 'destroy'],
			-background => 'grey85',
			-font => '-adobe-courier-bold-r-normal-*-*-180-*-*-m-*-koi8-1',
			);
		$ok_btn -> pack(
			-side => 'bottom',
			-anchor => 's',
			);
		$help_win->waitWindow();
	}	
	return;
}


sub GetColor{

	my $localRow = shift;
	my $localCol = shift;
	my $localFieldOfWidgets = shift;

	print "GetColor\n" if $debug;

	my $color = $$localFieldOfWidgets[$$localRow][$$localCol] -> cget (-background);
	$$localFieldOfWidgets[$$localRow][$$localCol] -> configure (-activebackground => "$color");
}	


#####################################################################################
#							POD														#	
#####################################################################################

=head1 NAME

diamondMine.pl - Keep playing untill you drop

=head1 SYNOPSYS

/users/dovl/local/bin/diamondMine.pl

=head1 VERSION

0.1

=head1 DESCRIPTION

The object of the game is to create rows or column of three cells or more of the same color.
Once there is a row or column containing such a sequence, those cells will be erased. The cells
above the erased cells will "fall" down untill they reach a colored cell. The empty cells will
be filled (randomly) from top to bottom, left to right, with new colors.
In order to create such a sequence, you may switch the places of two adjacent cells by pressing
them both prvided that by doig so a sequence is formed.  For each three cells removed, 10 points
will be scored. For each fourth or more cells, an additional 10 points will be scored per cell.
If the "falling" cells create sequences, you will receive points for them as well.
If there are no more moves, you will be notified.

The algorithm in which the game searches for sequences is: 

=item 1. First Iteration-

Top row to bottom row - left to right

=item 2. Second Iteration-

Leftmost column to righmost column - bottom up.

=head1 AUTHOR

Dov Levenglick <Dov.Levenglick@motorola.com>

=cut
#######################################################################################