
--
-- Copyright (C) 2019  <fastrgv@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You may read the full text of the GNU General Public License
-- at <http://www.gnu.org/licenses/>.
--




-- c9.adb : Grabarchuk's Nine puzzle.
--


with tput00_h;


with gnat.os_lib;
with ada.characters.handling;

with Interfaces.C;
use type interfaces.c.int;



with Text_IO;
with SysUtils;  use SysUtils;
with ada.directories;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;

with GNATCOLL.Terminal;  use GNATCOLL.Terminal;
with realtime_hpp;




procedure c9 is

use Ada.Strings.Unbounded;
use Ada.Strings.Unbounded.Text_IO;
use ada.directories;
use text_io;


	mswin: constant boolean := (gnat.os_lib.directory_separator='\');



	search : search_type;
	directory_entry : directory_entry_type;
	totgame, nlevels : integer := 0;



	ch: character;

	changed, erase,
	userexit, help, Ok, winner : boolean := false;

	nMoves, mxpuz, npuz : integer := 0;
	maxNpuz: constant integer := 76;

	gamefiles, shortname : array(1..maxNpuz) of unbounded_string;
	infilname : unbounded_string;

	objectiveText : string(1..60);

-----------------------------------------------------------------
-- maximum # cars/trucks:
	maxcar: constant integer := 13; -- allow a..m

-- maximum # cars/trucks/blanks
	maxblk: constant integer := 36;

-- car centers:
	rowcen, colcen : array(1..maxblk) of float;
	idchar : array(1..maxblk) of character := (others=>' ');
	bshape : array(1..maxblk) of integer; -- 12,21, 13,31

-----------------------------------------------------------------

	grow, gcol : array(1..9) of float; -- goal pos
	epsilon : constant float := 0.01;

	dblk, nblk, gblk, selBlock, nrow,ncol: integer:=1;

	ntrail, blank1, blank2 : integer := 0;









	package myint_io is new text_io.integer_io(integer);
	package myfloat_io is new text_io.float_io(float);


procedure test4winner is
begin
	winner := true;

	for g in 1..gblk loop -- gblk is 1 or 2
		if
		(abs(rowcen(g)-grow(g)) < epsilon )
		and
		(abs(colcen(g)-gcol(g)) < epsilon )
		then
			null;
		else
			winner:=false;
		end if;
	end loop;

end test4winner;





procedure myassert( condition : boolean;  flag: integer:=0 ) is
begin
  if condition=false then
  		put("ASSERTION Failed!  ");
		if flag /= 0 then
			put_line( "@ " & integer'image(flag) );
		end if;
		new_line;
  		raise program_error;
  end if;
end myassert;






procedure init is
	fname : string := "puzzles/nine.blk";
	updir : string := "../../";
	fileid : text_io.file_type;
	len: natural;
	clrstr: string(1..40);
begin

if ada.directories.Exists( fname ) then
   text_io.Open
      (File => FileId,
       Mode => text_io.In_File,
       Name => fname);
else
   text_io.Open
      (File => FileId,
       Mode => text_io.In_File,
       Name => updir&fname);
end if;


	objectiveText:=(others=>' ');
	text_io.get_line(fileid, objectiveText, len);


	-- (nrow,ncol) = outer dimension
	-- dblk = # non-blank rectangles
	-- nblk = # blanks
	-- gblk = # goal positions that must be attained
	-- (grow,gcol) = goal position[s]
	-- bshape = 11 or 12 or 21 or 22 = block shape

	myint_io.get(fileid, nrow); --4
	myint_io.get(fileid, ncol); --4
	myint_io.get(fileid, dblk); --9
	myint_io.get(fileid, gblk); --9

	nblk:=dblk+2;

	myassert( gblk = 9 );
	myassert( nblk <= maxblk );
	myassert( dblk <= maxcar );


for g in 1..gblk loop
	myfloat_io.get(fileid, grow(g)); --4.0
	myfloat_io.get(fileid, gcol(g)); --2.0
end loop;


	for i in 1..nblk loop
		myint_io.get(fileid, bshape(i));
		myfloat_io.get(fileid, rowcen(i));
		myfloat_io.get(fileid, colcen(i));
		text_io.get_line(fileid, clrstr, len); --ignore
		idchar(i):=character'val( 48+i ); --1..9
	end loop;

	blank1 := dblk+1;
	blank2 := dblk+2;



   text_io.Close (File => FileId);

	winner:=false;
	nMoves:=0;
	ntrail:=0;

end init;





function moveleft return integer is

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

	sr : float := rowcen(selBlock);
	sc : float := colcen(selBlock);
	shape : integer := bshape(selBlock);

begin

	if( shape=22 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc+1.5)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank1) := bc1+2.0;
			colcen(blank2) := bc2+2.0;
		end if;

	elsif( shape=21 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc+1.0)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank1) := bc1+1.0;
			colcen(blank2) := bc2+1.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(br1-sr) < 0.1
				and
			abs(bc1-sc+1.5)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank1) := bc1+2.0;
		elsif
			abs(br2-sr) < 0.1
				and
			abs(bc2-sc+1.5)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank2) := bc2+2.0;
		end if;



	elsif( shape=11 ) then

		if
			abs(br1-sr) < 0.1
				and
			abs(bc1-sc+1.0)<0.1
		then
			colcen(selBlock) := bc1;
			colcen(blank1) := sc;
		elsif
			abs(br2-sr) < 0.1
				and
			abs(bc2-sc+1.0)<0.1
		then
			colcen(selBlock) := bc2;
			colcen(blank2) := sc;
		end if;


	end if;



	if
		abs(obr1-rowcen(blank1))<0.1
			and
		abs(obr2-rowcen(blank2))<0.1
			and
		abs(obc1-colcen(blank1))<0.1
			and
		abs(obc2-colcen(blank2))<0.1
	then
		ret := 0;
	else
		ret := 1;
	end if;


	if( ret > 0 )	
	then

	  	 changed:=true;
		 if winner then erase:=true; end if;


		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;

end moveleft;










function moveright return integer is

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

	sr : float := rowcen(selBlock);
	sc : float := colcen(selBlock);
	shape : integer := bshape(selBlock);

begin


	if( shape=22 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc-1.5)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank1) := bc1-2.0;
			colcen(blank2) := bc2-2.0;
		end if;

	elsif( shape=21 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc-1.0)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank1) := bc1-1.0;
			colcen(blank2) := bc2-1.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(br1-sr) < 0.1
				and
			abs(bc1-sc-1.5)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank1) := bc1-2.0;
		elsif
			abs(br2-sr) < 0.1
				and
			abs(bc2-sc-1.5)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank2) := bc2-2.0;
		end if;



	elsif( shape=11 ) then

		if
			abs(br1-sr) < 0.1
				and
			abs(bc1-sc-1.0)<0.1
		then
			colcen(selBlock) := bc1;
			colcen(blank1) := sc;
		elsif
			abs(br2-sr) < 0.1
				and
			abs(bc2-sc-1.0)<0.1
		then
			colcen(selBlock) := bc2;
			colcen(blank2) := sc;
		end if;


	end if;



	if
		abs(obr1-rowcen(blank1))<0.1
			and
		abs(obr2-rowcen(blank2))<0.1
			and
		abs(obc1-colcen(blank1))<0.1
			and
		abs(obc2-colcen(blank2))<0.1
	then
		ret := 0;
	else
		ret := 1;
	end if;



	if( ret > 0 )
	then

	  	 changed:=true;
		 if winner then erase:=true; end if;


		nMoves:=nMoves+1;
		test4winner;
	end if;


	return ret;


end moveright;








function moveup return integer is

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

	sr : float := rowcen(selBlock);
	sc : float := colcen(selBlock);
	shape : integer := bshape(selBlock);

begin

	if( shape=22 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr+1.5)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank1) := br1+2.0;
			rowcen(blank2) := br2+2.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr+1.0)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank1) := br1+1.0;
			rowcen(blank2) := br2+1.0;
		end if;


	elsif( shape=21 ) then

		if
			abs(bc1-sc)<0.1
				and
			abs(br1-sr+1.5)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank1) := br1+2.0;
		elsif
			abs(bc2-sc)<0.1
				and
			abs(br2-sr+1.5)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank2) := br2+2.0;
		end if;



	elsif( shape=11 ) then

		if
			abs(bc1-sc)<0.1
				and
			abs(br1-sr+1.0)<0.1
		then
			rowcen(selBlock) := br1;
			rowcen(blank1) := sr;
		elsif
			abs(bc2-sc)<0.1
				and
			abs(br2-sr+1.0)<0.1
		then
			rowcen(selBlock) := br2;
			rowcen(blank2) := sr;
		end if;


	end if;


	if
		abs(obr1-rowcen(blank1))<0.1
			and
		abs(obr2-rowcen(blank2))<0.1
			and
		abs(obc1-colcen(blank1))<0.1
			and
		abs(obc2-colcen(blank2))<0.1
	then
		ret := 0;
	else
		ret := 1;
	end if;



	if( ret > 0 )	
	then

	  	 changed:=true;
		 if winner then erase:=true; end if;


		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;

end moveup;






function movedown return integer is

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

	sr : float := rowcen(selBlock);
	sc : float := colcen(selBlock);
	shape : integer := bshape(selBlock);

begin

	if( shape=22 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr-1.5)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank1) := br1-2.0;
			rowcen(blank2) := br2-2.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr-1.0)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank1) := br1-1.0;
			rowcen(blank2) := br2-1.0;
		end if;


	elsif( shape=21 ) then

		if
			abs(bc1-sc)<0.1
				and
			abs(br1-sr-1.5)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank1) := br1-2.0;
		elsif
			abs(bc2-sc)<0.1
				and
			abs(br2-sr-1.5)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank2) := br2-2.0;
		end if;



	elsif( shape=11 ) then

		if
			abs(bc1-sc)<0.1
				and
			abs(br1-sr-1.0)<0.1
		then
			rowcen(selBlock) := br1;
			rowcen(blank1) := sr;
		elsif
			abs(bc2-sc)<0.1
				and
			abs(br2-sr-1.0)<0.1
		then
			rowcen(selBlock) := br2;
			rowcen(blank2) := sr;
		end if;


	end if;


	if
		abs(obr1-rowcen(blank1))<0.1
			and
		abs(obr2-rowcen(blank2))<0.1
			and
		abs(obc1-colcen(blank1))<0.1
			and
		abs(obc2-colcen(blank2))<0.1
	then
		ret := 0;
	else
		ret := 1;
	end if;



	if( ret > 0 )	
	then

	  	 changed:=true;
		 if winner then erase:=true; end if;


		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;


end movedown;













procedure Draw is
	info: terminal_info;
	Ok: boolean;
	ch: character;
	rc,cc: float;
	ulr, ulc : integer;

	-- m=magenta, y=yellow, r=red, g=green, b=blue, c=cyan, e=grey
	type enum is (m,y,r,g,b,c,e,x); -- x => not yet set
	nucolr, olcolr : enum := x;

	tc : array(1..4,1..4) of enum:=(others=>(others=>x));

	tj : array(1..4,1..4) of character := (others=>(others=>' '));

	blankpos : array(1..4,1..4) of boolean := (others=>(others=>false));
begin
if changed or erase then

	changed:=false;

	info.init_for_stdout(auto);

if erase then

	if mswin then
		SysUtils.Shell("cls", Ok); -- erase-terminal
	else
		SysUtils.Shell("clear", Ok); -- erase-terminal
	end if;
	erase:=false;

else

	if mswin then
		--SysUtils.Shell("tput00", Ok); -- erase-terminal
		--ret := tput00_h.tput00;
		tput00_h.cursorHome;
	else
		SysUtils.Shell("tput cup 0 0", Ok); -- erase-terminal
	end if;

end if;


if help then

	put_line(" 9-block--help-screen");
	put_line(" q,x => quit,  ? => toggle-help");
	put_line(" The rectangular blocks of numerals slide.");
	put_line("============================================");
	put_line(" Select a block using keys 1..9,");
	put_line(" Then use arrow-keys to move it.");
	put_line("============================================");

else

	--put_line(" TerminalBlok -- move 'a' block to");
	--put_line(" goal position indicated by border");
	--put_line(objectiveText);

	put_line(" Nine:  reverse the order of the numbered blocks.");
	put_line(" Put 1-block @ lower right, 9-block @ upper left.");

	put_line(" q = quit,  ? = toggle-help");
	new_line;

	for i in 1..dblk loop
		ch := idchar(i);
		rc := rowcen(i);
		cc := colcen(i);
		case bshape(i) is

			when 12 => 
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.0+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+0,ulc+1):=ch;

				tc(ulr+0,ulc+0):=c; --cyan
				tc(ulr+0,ulc+1):=c;

			when 21 =>
				ulr := integer(float'rounding(+0.0+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+1,ulc+0):=ch;

				tc(ulr+0,ulc+0):=y; --yellow
				tc(ulr+1,ulc+0):=y;

----------------------------------------------------------------------

			when 11 =>
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;

				tc(ulr+0,ulc+0):=g; --green

			when 22 =>
				ulr := integer(float'rounding(+0.0+rc));
				ulc := integer(float'rounding(+0.0+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+1,ulc+0):=ch;
				tj(ulr+0,ulc+1):=ch;
				tj(ulr+1,ulc+1):=ch;

				tc(ulr+0,ulc+0):=r; --red
				tc(ulr+1,ulc+0):=r;
				tc(ulr+0,ulc+1):=r;
				tc(ulr+1,ulc+1):=r;

			when others => null;
		end case;
	end loop;


	for i in dblk+1..dblk+2 loop
		ch := idchar(i);
		rc := rowcen(i);
		cc := colcen(i);
		case bshape(i) is
			when 11 =>
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;
				blankpos(ulr,ulc):=true;
				tc(ulr+0,ulc+0):=x;
			when others => null;
		end case;
	end loop;









-- begin draw puzzle--------------------

   Info.Set_Color (style=>bright);
	Info.Set_Color (background=>black);
	info.set_color(foreground=>grey);
	olcolr:=e;

	put("+");
	for col in 1..ncol loop
		put(" +");
	end loop;
	put_line(" +");

	for row in 1..nrow loop
		put("+");

		for col in 1..ncol loop
			nucolr:=tc(row,col);
			if olcolr /= nucolr then
			case nucolr is
				when m =>
					info.set_color(foreground=>magenta);
				when y =>
					info.set_color(foreground=>yellow);
				when r =>
					info.set_color(foreground=>red);
				when g =>
					info.set_color(foreground=>green);
				when b =>
					info.set_color(foreground=>blue);
				when c =>
					info.set_color(foreground=>cyan);
				--when x =>
				--	info.set_color(foreground=>red);
				when others => null;
					--info.set_color(foreground=>red);
			end case;
			olcolr:=nucolr;
			end if;

			if blankpos(row,col) then
				put("  "); --blank
			else
				put( ' ' & tj(row,col) );
			end if;
		end loop;

		info.set_color(foreground=>grey);
		olcolr:=e;
		put(" +");
		new_line;
	end loop;

	put("+");
	for col in 1..ncol loop
		put(" +");
	end loop;
	put_line(" +");

-- end draw puzzle----------------------

	put_line( to_string(infilname) );



	if winner then
		put_line("Correct !");
		put_line("Solved in "&integer'image(nMoves)&" steps");
	end if;

   Info.Set_Color (Standard_Output, Style => Reset_All);

end if;
end if; --changed
end Draw;







function goodChar(ch: character) return boolean is
begin
	if ada.characters.handling.is_letter(ch) then
		return true;

	elsif (ch in '1'..'9') then
		return true;

	elsif 
		(ch='?') or (ch='=') or (ch='+') or 
		(ch='-') or (ch='\') or (ch='/') or (ch='.')
	then
		return true;

	else
		return false;

	end if;
end;





procedure handle_key_down( ch: character ) is
	ret : integer;
begin


-- note that arrow keys typically produce chars
-- preceded by 1 or 2 non-printable chars.
--
-- on Linux:		<home>='H'	<end>='F'
--   A		
-- D B C
--
-- or on MSWin:	<home>='G'	<end>='O'
--   H
-- K P M


if goodChar(ch) then


	case ch is

		when '1'..'9' => selBlock:= character'pos(ch) - character'pos('1') + 1;

		when 'x' | 'q' =>	userexit:=true;

		when '?' => help := not help; erase:=true;

		when 'r' => init; erase:=true;

		when 'H'|'A'|'i'|'w' =>	
			ret:=moveup;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					exit when selBlock>dblk;
					ret:=moveup;
				end loop;
			end if;

		when 'P'|'B'|'k'|'s' =>	
			ret:=movedown;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					exit when selBlock>dblk;
					ret:=movedown;
				end loop;
			end if;


		when 'M'|'C'|'l'|'d' =>	
			ret:=moveright;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					exit when selBlock>dblk;
					ret:=moveright;
				end loop;
			end if;


		when 'K'|'D'|'j'|'a' =>	
			ret:=moveleft;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					exit when selBlock>dblk;
					ret:=moveleft;
				end loop;
			end if;


		when others => changed:=false;

	end case;

end if;
end handle_key_down;











gfil: text_io.file_type;


	rtime: interfaces.c.int;


begin --c9


	if mswin then
		rtime:=realtime_hpp.hiPriority;
		-- note:  this seems necessary because some, 
		-- but not all, windows commandline terminals 
		-- seem to randomly freeze at normal priority.
	else
		rtime:=1;
	end if;






	init; --// define puzzle parameters here


	if mswin then
		SysUtils.Shell("cls", Ok); -- erase-terminal
	else
		SysUtils.Shell("clear", Ok); -- erase-terminal
	end if;



-- begin main event loop:

	changed:=true;
	Draw;
	while not userexit loop
		get_immediate(ch);
		handle_key_down( ch );
		Draw;
	end loop;

-- end main event loop:

end c9;

