#!perl -w
use strict;
use Tk;
use Tk::DialogBox;
use GD;
use Tk::JPEG;
use Image::Size;
use Storable('nstore','retrieve');

my(@box,$gap,$image,@image,$fimg,$timesh,$movessh,$rpt,$moves,$btime,$ptime,$board,$control,$arrows,$mvlabel,$tmlabel,$name,$dif);
my($bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$bestime,$bestmoves,$size,$rows,$cols);
eval{($bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$bestime,$bestmoves,$size,$rows,$cols)=@{retrieve('puzzle.inf')}} or setdefcols();
$_+=0 for $size,$cols,$rows;
END{nstore [$bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$bestime,$bestmoves,$size,$rows,$cols],'puzzle.inf'};

my $mw=new MainWindow(-title=>'Puzzle',-bg=>$bgcolor);
$mw->geometry('+250+200');

my $menu=$mw->Menu(-tearoff=>0,-type=>'menubar');

	my $gamemenu=$menu->Menu(-tearoff=>0);
		$gamemenu->add('command',-label=>'New',-accelerator=>'F2',-command=>\&init,-underline=>0);$mw->bind('<F2>'=>sub{init()});
		$gamemenu->add('command',-label=>'Pause',-accelerator=>'F6',-command=>\&pause,-underline=>0);$mw->bind('<F6>'=>\&pause);
		$gamemenu->add('separator');
		$gamemenu->add('command',-label=>'Hall of Fame',-underline=>0,-command=>sub{
				pause();
				my $hall=$mw->DialogBox(-title=>'Hall of Fame',-bg=>$bgcolor,-buttons=>['Close','Reset']);
				$hall->add('Label',-text=>'Time Records: ',-fg=>$hlcolor,-bg=>$bgcolor,-font=>'-*-*-bold-*-*-*-*-300-*-*-*-*-*-*-')->pack;
				my $l=0;
				for(sort {$a->[0]<=>$b->[0] or $a->[1]<=>$b->[1]} map [split /$;/,$_],keys %$bestime){
					$hall->add('Label',-font=>'-*-*-*-*-*-*-*-200-*-*-*-*-*-*-',-text=>sprintf('%s x %s: '.($$bestime{$$_[0],$$_[1]}[0]>=3600?'%02d:':'').'%02d:%02d'.($$bestime{$$_[0],$$_[1]}[1]?', by %s':''),$$_[0],$$_[1],($$bestime{$$_[0],$$_[1]}[0]>=3600)?
					(int $$bestime{$$_[0],$$_[1]}[0]/3600,int $$bestime{$$_[0],$$_[1]}[0]%3600/60):(int $$bestime{$$_[0],$$_[1]}[0]/60),$$bestime{$$_[0],$$_[1]}[0]%60,$$bestime{$$_[0],$$_[1]}[1]),-fg=>$numcolor,-bg=>$bgcolor)->pack(-anchor=>'w');
					$l||=1
				}
				$hall->add('Label',-text=>'--No Records--',-fg=>$numcolor,-bg=>$bgcolor,-font=>'-*-*-*-*-*-*-*-180-*-*-*-*-*-*-')->pack unless $l;
				
				$hall->add('Label',-text=>'Moves Records: ',-fg=>$hlcolor,-bg=>$bgcolor,-font=>'-*-*-bold-*-*-*-*-300-*-*-*-*-*-*-')->pack;
				$l=0;
				for(sort {$a->[0]<=>$b->[0] or $a->[1]<=>$b->[1]} map [split /$;/,$_],keys %$bestmoves){
					$hall->add('Label',-font=>'-*-*-*-*-*-*-*-200-*-*-*-*-*-*-',-text=>sprintf('%s x %s: %d'.($$bestmoves{$$_[0],$$_[1]}[1]?', by %s':''),$$_[0],$$_[1],$$bestmoves{$$_[0],$$_[1]}[0],$$bestmoves{$$_[0],$$_[1]}[1]),-fg=>$numcolor,-bg=>$bgcolor)->pack(-anchor=>'w');
					$l||=1
				}
				$hall->add('Label',-text=>'--No Records--',-fg=>$numcolor,-bg=>$bgcolor,-font=>'-*-*-*-*-*-*-*-180-*-*-*-*-*-*-')->pack unless $l;
				if($hall->Show eq 'Reset'){%$bestime=();%$bestmoves=()}
				continuen();
			});
		$gamemenu->add('separator');
		$gamemenu->add('command',-label=>'Exit',-command=>sub{exit},-underline=>1);

	my $optmenu=$menu->Menu(-tearoff=>0);

		my $colsmenu=$optmenu->Menu(-tearoff=>0);
			$colsmenu->add('radio',-variable=>\$cols,-value=>$_,-label=>$_,-indicatoron=>1,-command=>sub{setimage() if $image;init()}) for 3..7;
			$colsmenu->add('command',-label=>'Other...',-command=>sub{
				my $other;
				my $dial=$mw->DialogBox(-title=>'Custom Columns Number',-buttons=>['Ok','Cancel']);
				$dial->add('Label',-text=>'Enter number of columns: ')->pack;
				$dial->add('Entry',-textvariable=>\$other,-width=>4)->pack;
				$dial->Show eq 'Ok' or return;
				if($other<=2){$mw->messageBox(-icon=>'error',-message=>'Invalid number.',-title=>'Error')}else{$cols=$other;setimage() if $image;init()}
			});

		my $rowsmenu=$optmenu->Menu(-tearoff=>0);
			$rowsmenu->add('radio',-variable=>\$rows,-value=>$_,-label=>$_,-indicatoron=>1,-command=>sub{setimage() if $image;init()}) for 3..7;
			$rowsmenu->add('command',-label=>'Other...',-command=>sub{
				my $other;
				my $dial=$mw->DialogBox(-title=>'Custom Rows Number',-buttons=>['Ok','Cancel']);
				$dial->add('Label',-text=>'Enter number of rows: ')->pack;
				$dial->add('Entry',-textvariable=>\$other,-width=>4)->pack;
				$dial->Show eq 'Ok' or return;
				if($other<=2){$mw->messageBox(-icon=>'error',-message=>'Invalid number.',-title=>'Error')}else{$rows=$other;setimage() if $image;init()}
			});

		my $sizemenu=$optmenu->Menu(-tearoff=>0);
			$sizemenu->add('radio',-variable=>\$size,-value=>$_->[1],-label=>$_->[0],-indicatoron=>1,-command=>sub{setimage() if $image;init(1)}) for ['Very Small'=>20],['Small'=>30],['Medium'=>40],['Large'=>50],['Extra Large'=>60];

		$optmenu->add('cascade',-label=>'Columns',-menu=>$colsmenu,-underline=>0);
		$optmenu->add('cascade',-label=>'Rows',-menu=>$rowsmenu,-underline=>0);
		$optmenu->add('cascade',-label=>'Size',-menu=>$sizemenu,-underline=>0);
		$optmenu->add('separator');
		$optmenu->add('command',-label=>'Background Color...',-underline=>0,-command=>sub{$bgcolor=$mw->chooseColor(-initialcolor=>$bgcolor,-title=>'Background Color...')||$bgcolor;for($mw,$board,$control,$mvlabel,$tmlabel,$arrows){$_->configure(-bg=>$bgcolor)}});
		$optmenu->add('command',-label=>'Board Color...',-underline=>1,-command=>sub{$boardcolor=$mw->chooseColor($boardcolor?(-initialcolor=>$boardcolor):(),-title=>'Board Color...')||$boardcolor;init(1)});
		$optmenu->add('command',-label=>'Text Color...',-underline=>0,-command=>sub{$numcolor=$mw->chooseColor(-initialcolor=>$numcolor,-title=>'Numbers Color...')||$numcolor;for($mvlabel,$tmlabel){$_->configure(-fg=>$numcolor)}init(1)});
		$optmenu->add('command',-label=>'Highlight Color...',-underline=>0,-command=>sub{$hlcolor=$mw->chooseColor(-initialcolor=>$hlcolor,-title=>'Highlight Color...')||$hlcolor});
		$optmenu->add('command',-label=>'Boxes Color...',-underline=>2,-command=>sub{$boxcolor=$mw->chooseColor(-initialcolor=>$boxcolor,-title=>'Boxes Color...')||$boxcolor;init(1)});
		$optmenu->add('separator');
		$optmenu->add('command',-label=>'Restore Defaults',-underline=>0,-command=>sub{setdefcols();for($mw,$board,$control,$mvlabel,$tmlabel,$arrows){$_->configure(-bg=>$bgcolor)}for($mvlabel,$tmlabel){$_->configure(-fg=>$numcolor)}init()});

	my $imgmenu=$menu->Menu(-tearoff=>0);
		$imgmenu->add('radio',-variable=>\$image,-value=>'',-label=>'None',-indicatoron=>1,-command=>sub{$fimg=undef;@image=();init()});
		$imgmenu->add('radio',-variable=>\$image,-value=>$_,-label=>(/(.+)\./)[0],-indicatoron=>1,-command=>sub{setimage();init()}) for <*.{jpg,jpeg}>;
		$imgmenu->add('separator');
		$imgmenu->add('command',-label=>'Load...',-underline=>0,-command=>sub{my $img=$mw->getOpenFile(-title=>'Load Image...',-filetypes=>[['JPEG Image',['*.jpeg','*.jpg']]]) or return;$image=$img;$imgmenu->insert($imgmenu->index('Load...')-1,'radio',-variable=>\$image,-value=>$img,-label=>($img=~/([^\\\/]+)\.[^\\\/]*$/)[0],-indicatoron=>1,-command=>\&setimage);setimage();init()});
		$imgmenu->add('command',-label=>'View Image',-underline=>0,-command=>sub{return unless $image;$board->createImage($cols*$size/2+2,$rows*$size/2+2,-image=>$fimg,-tags=>['fimg']);$board->update;sleep 2;$btime++;$board->delete('fimg');});

	my $helpmenu=$menu->Menu(-tearoff=>0);
		$helpmenu->add('command',-label=>'About...',-underline=>0,-command=>sub{$mw->messageBox(-title=>'About N-Puzzle...',-message=>'N-Puzzle 2.0 was made by Ido Trivizki.')});

$menu->add('cascade',-label=>'Game',-menu=>$gamemenu,-underline=>0);
$menu->add('cascade',-label=>'Options',-menu=>$optmenu,-underline=>0);
$menu->add('cascade',-label=>'Image',-menu=>$imgmenu,-underline=>0);
$menu->add('cascade',-label=>'Help',-menu=>$helpmenu,-underline=>0);
$mw->configure(-menu=>$menu);

$board=$mw->Canvas(-bg=>$bgcolor,-highlightthickness=>0)->pack(-padx=>10,-pady=>10);

$control=$mw->Frame(-bg=>$bgcolor)->pack;
	$tmlabel=$control->Label(-textvariable=>\$timesh,-bg=>$bgcolor,-fg=>$numcolor)->grid(-col=>0,-row=>0);
	$arrows=$control->Canvas(-width=>63,-height=>43,-bg=>$bgcolor,-highlightthickness=>0)->grid(-col=>1,-row=>0);
	$mvlabel=$control->Label(-textvariable=>\$movessh,-bg=>$bgcolor,-fg=>$numcolor)->grid(-col=>2,-row=>0);
	$control->gridColumnconfigure(0,-minsize=>90);
	$control->gridColumnconfigure(2,-minsize=>90);

$arrows->createRectangle(2+$_,22+$_,21-$_,41-$_,-tags=>['left'],-outline=>undef) for 1..10;
$arrows->createLine(2,41,21,41,-fill=>'black',-tags=>['left','se']);
$arrows->createLine(21,41,21,22,-fill=>'black',-tags=>['left','se']);
$arrows->createLine(21,22,2,22,-fill=>'gray',-tags=>['left','nw']);
$arrows->createLine(2,22,2,41,-fill=>'gray',-tags=>['left','nw']);
$arrows->createLine(5,32,18,32,-fill=>'black',-arrow=>'first',-tags=>['left']);

$arrows->createRectangle(22+$_,22+$_,41-$_,41-$_,-tags=>['down'],-outline=>undef) for 1..10;
$arrows->createLine(22,41,41,41,-fill=>'black',-tags=>['down','se']);
$arrows->createLine(41,41,41,22,-fill=>'black',-tags=>['down','se']);
$arrows->createLine(41,22,22,22,-fill=>'gray',-tags=>['down','nw']);
$arrows->createLine(22,22,22,41,-fill=>'gray',-tags=>['down','nw']);
$arrows->createLine(32,25,32,38,-fill=>'black',-arrow=>'last',-tags=>['down']);

$arrows->createRectangle(42+$_,22+$_,61-$_,41-$_,-tags=>['right'],-outline=>undef) for 1..10;
$arrows->createLine(42,41,61,41,-fill=>'black',-tags=>['right','se']);
$arrows->createLine(61,41,61,22,-fill=>'black',-tags=>['right','se']);
$arrows->createLine(61,22,42,22,-fill=>'gray',-tags=>['right','nw']);
$arrows->createLine(42,22,42,41,-fill=>'gray',-tags=>['right','nw']);
$arrows->createLine(45,32,58,32,-fill=>'black',-arrow=>'last',-tags=>['right']);

$arrows->createRectangle(22+$_,2+$_,41-$_,21-$_,-tags=>['up'],-outline=>undef) for 1..10;
$arrows->createLine(22,21,41,21,-fill=>'black',-tags=>['up','se']);
$arrows->createLine(41,21,41,2,-fill=>'black',-tags=>['up','se']);
$arrows->createLine(41,2,22,2,-fill=>'gray',-tags=>['up','nw']);
$arrows->createLine(22,2,22,21,-fill=>'gray',-tags=>['up','nw']);
$arrows->createLine(32,5,32,18,-fill=>'black',-arrow=>'first',-tags=>['up']);


my $updatetime=sub{$dif=time-$btime;$timesh=sprintf 'Time: '.($dif>=3600?'%02d:':'').'%02d:%02d',($dif>=3600)?(int $dif/3600,int $dif%3600/60):(int $dif/60),$dif%60};
my %move;
$move{up}=sub{$mw->bell,return if int($gap/$cols)==$rows-1;$board->move("$box[$gap+$cols]b",0,-$size);@box[$gap,$gap+$cols]=@box[$gap+$cols,$gap];$gap+=$cols;$movessh='Moves: '.++$moves;check() and gameover();};
$move{down}=sub{$mw->bell,return unless int($gap/$cols);$board->move("$box[$gap-$cols]b",0,$size);@box[$gap,$gap-$cols]=@box[$gap-$cols,$gap];$gap-=$cols;$movessh='Moves: '.++$moves;};
$move{left}=sub{$mw->bell,return if $gap%$cols==$cols-1;$board->move("$box[$gap+1]b",-$size,0);@box[$gap,$gap+1]=@box[$gap+1,$gap];$gap++;$movessh='Moves: '.++$moves;check() and gameover();};
$move{right}=sub{$mw->bell,return unless ($gap%$cols);$board->move("$box[$gap-1]b",$size,0);@box[$gap,$gap-1]=@box[$gap-1,$gap];$gap--;$movessh='Moves: '.++$moves;};
my $mouseclick=sub{my $cur=substr(($board->gettags('current'))[0],0,-1);my $curpos;for(0..$#box){next unless defined $box[$_];$curpos=$_ and last if $box[$_]==$cur}if($curpos+1==$gap){$move{right}->()}elsif($curpos-1==$gap){$move{left}->()}elsif($curpos+$cols==$gap){$move{down}->()}elsif($curpos-$cols==$gap){$move{up}->()}else{$mw->bell}};
my $enter=sub{$board->itemconfigure(($board->gettags('current'))[0].'&&box',-fill=>$hlcolor)};
my $press=sub{my $dir=($arrows->gettags('current'))[0];$move{$dir}->();$arrows->itemconfigure("$dir&&se",-fill=>'grey');$arrows->itemconfigure("$dir&&nw",-fill=>'black')};

sub init{
	unless($_[0]){
		@box=0..$cols*$rows-2;
		{my $i;for ($i = @box; --$i; ) {my $j = int rand ($i+1);next if $i == $j;@box[$i,$j] = @box[$j,$i];}}

		$gap=int rand $cols*$rows;
		splice @box,$gap,0,undef;

		my $c;
		for(0..$#box-1){next if $_==$gap;for my $n(@box[$_+1..$#box]){next unless defined $n;$c++ if $n<$box[$_]}}
		if($cols&1 and $c&1 or ~$cols&1 and (($c+int($gap/$cols)+1)&1)^($rows&1)){my $j;do{$j=rand $#box}until defined $box[$j]&& defined $box[$j+1];@box[$j,$j+1]=@box[$j+1,$j]}

		$moves=0;
		$movessh='Moves: 0';
		$rpt->cancel if $rpt;
		$timesh='Time: 00:00';
		$btime=time;
		$rpt=$mw->repeat(1000,$updatetime);
		continuen() if $gamemenu->entrycget(1,'label') eq 'Continue';
	}
	$board->delete('all');
	$board->configure(-width=>$cols*$size+4,-height=>$rows*$size+4);
	
	if($image){
		$board->createImage($cols*$size/2+2,$rows*$size/2+2,-image=>$fimg,-tags=>['fimg']);
		$board->update;
		sleep 1;
		$board->delete('fimg');
	}

	my($x,$y)=(2,2);
	for(@box){
		next unless defined $_;
		if($image){
			$board->createImage($x+.5*$size,$y+.5*$size,-image=>$image[$_],-tags=>["${_}b",'image']);
		}else{
			for my $m(1..$size*.5){
				$board->createRectangle($x+$m,$y+$m,$x+$size-$m,$y+$size-$m,-outline=>undef,-tags=>["${_}b"]);
			}
		$board->createRectangle($x,$y,$x+$size,$y+$size,-outline=>$boxcolor,-fill=>$boardcolor,-tags=>["${_}b",'box']);
		$board->createText($x+.5*$size,$y+.5*$size,-text=>$_+1,-font=>'-*-*-*-*-*-*-*-'.($_>=99?7:10)*$size.'-*-*-*-*-*-',-tags=>["${_}b",'text'],-fill=>$numcolor);
	}
	}continue{
		$x+=$size;
		($x-2)/$size==$cols and $y+=$size,$x=2;
	}
	if($_[0] and $gamemenu->entrycget(1,'label') eq 'Continue'){
		my($x,$y)=($board->cget('width')/2,$board->cget('height')/2);
		$board->createText($x-2,$y-2,-text=>'Pause',-font=>'-*-*-*-*-*-*-*-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$numcolor,-tags=>['pause']);
		$board->createText($x,$y,-text=>'Pause',-font=>'-*-*-*-*-*-*-*-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$hlcolor,-tags=>['pause']);
	}
				
}


$board->bind('all','<Leave>'=>my $leave=sub{$board->itemconfigure(($board->gettags('current'))[0].'&&box',-fill=>$boardcolor)});
$arrows->bind('all','<ButtonRelease-1>'=>sub{my $dir=($arrows->gettags('current'))[0];$arrows->itemconfigure("$dir&&se",-fill=>'black');$arrows->itemconfigure("$dir&&nw",-fill=>'grey')});
sub setbinds{
	$mw->bind('<Up>'=>$move{up});
	$mw->bind('<Down>'=>$move{down});
	$mw->bind('<Left>'=>$move{left});
	$mw->bind('<Right>'=>$move{right});

	$board->bind('all','<Enter>'=>$enter);
	$board->bind('all','<1>'=>$mouseclick);

	$arrows->bind('all','<ButtonPress-1>'=>$press);
}

sub releasebinds{
	$mw->bind('<Up>'=>undef);
	$mw->bind('<Down>'=>undef);
	$mw->bind('<Left>'=>undef);
	$mw->bind('<Right>'=>undef);

	$board->bind('all','<Enter>'=>undef);
	$board->bind('all','<1>'=>undef);


	$arrows->bind('all','<ButtonPress-1>'=>undef);
}

sub check{
	for(1..$#box-1){return unless $box[$_] && $box[$_]>$box[$_-1]}
	return 1;
}

sub gameover{
	releasebinds();
	$rpt->cancel;
	if($image){
		$board->delete('all');
		$board->update;
		for(0..2){
			$board->createImage($cols*$size/2+2,$rows*$size/2+2,-image=>$fimg,-tags=>['fimg']);
			$board->update;
			select undef,undef,undef,0.3;
			$board->delete('fimg');
			$board->update;
			select undef,undef,undef,0.3;
		}
	}else{
		for(0..2){
			$board->itemconfigure('box',-outline=>undef,-fill=>$boardcolor);
			$board->itemconfigure('text',-fill=>$hlcolor);
			$board->update;
			select undef,undef,undef,0.3;
			$board->itemconfigure('box',-outline=>$boxcolor);
			$board->itemconfigure('text',-fill=>$numcolor);
			$board->update;
			select undef,undef,undef,0.3;
		}
	}
	if(!$$bestime{$cols,$rows} or $dif<$$bestime{$cols,$rows}[0]){my $dial=$mw->DialogBox(-title=>"New Time Record for ${cols}x$rows",-bg=>$bgcolor);$dial->add('Label',-text=>'Enter your name: ',-bg=>$bgcolor)->pack;$dial->add('Entry',-textvariable=>\$name)->pack;$dial->Show;$$bestime{$cols,$rows}=[$dif,$name]}
	if(!$$bestmoves{$cols,$rows} or $moves<$$bestmoves{$cols,$rows}[0]){my $dial=$mw->DialogBox(-title=>"New Moves Record for ${cols}x$rows",-bg=>$bgcolor);$dial->add('Label',-text=>'Enter your name: ',-bg=>$bgcolor)->pack;$dial->add('Entry',-textvariable=>\$name)->pack;$dial->Show;$$bestmoves{$cols,$rows}=[$moves,$name]}
	setbinds();
	init();
}


sub pause{
	releasebinds();
	$rpt->cancel;
	$ptime=time;
	$gamemenu->entryconfigure(1,-label=>'Continue',-command=>\&continuen);$mw->bind('<F6>'=>\&continuen);
	my($x,$y)=($board->cget('width')/2,$board->cget('height')/2);
	$board->createText($x-2,$y-2,-text=>'Pause',-font=>'-*-*-*-*-*-*-*-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$numcolor,-tags=>['pause']);
	$board->createText($x,$y,-text=>'Pause',-font=>'-*-*-*-*-*-*-*-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$hlcolor,-tags=>['pause']);
}

sub continuen{
	setbinds();
	$btime+=time-$ptime;
	$timesh=sprintf 'Time: %02d:%02d',int((time-$btime)/60),(time-$btime)%60;
	$rpt=$mw->repeat(1000,$updatetime);
	$board->delete('pause');
	$gamemenu->entryconfigure(1,-label=>'Pause',-command=>\&pause);$mw->bind('<F6>'=>\&pause);
}

sub setimage{
	open my $f,$image or die $!;
	my $simage=GD::Image->newFromJpeg($f);
	my($swidth,$sheight)=imgsize($image);
	my $nimg=new GD::Image(my $w=$size*$cols,my $h=$size*$rows);
	$nimg->copyResized($simage,0,0,0,0,$w,$h,$swidth,$sheight);
	my $tmpname;{my $i;do{$tmpname='temp'.$i++}while -e $tmpname}
	open O,">$tmpname";
	binmode O;
	print O $nimg->jpeg;
	close O;
	$fimg=$mw->Photo(-file=>$tmpname,-format=>'jpeg');
	unlink $tmpname;
	my($ix,$iy,$n)=(0,0);
	@image=();
	for(0..$rows*$cols-2){
		my $timg=$mw->Photo;
		$timg->copy($fimg,-from=>$ix+1,$iy+1,$ix+$size-1,$iy+$size-1,-to=>0,0);
		$image[$_]=$timg;
		$ix+=$size;
		$n++;
		$n%$cols or $iy+=$size,$ix=0;
	}
}

{my $def=do{(my $c=$mw->Label)->cget('background')};
sub setdefcols{($bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$size,$rows,$cols)=($def,undef,'black','red','black',40,4,4)}
}
setbinds();
init();
MainLoop;