
--
-- Copyright (C) 2021  <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/>.
--




-- tpan.adb : TerminalBlockSlider = panama slider in a terminal window
--

with snd4ada;
with tput00_h;


with Text_IO;
with SysUtils;  use SysUtils;
with ada.directories;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;
with ada.characters.handling;
with gnat.os_lib;
with realtime;
with interfaces.c;
use type interfaces.c.int;
with interfaces.c.strings;

with GNATCOLL.Terminal;  use GNATCOLL.Terminal;





procedure cpana 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;

erase,changed,
	userexit, help, Ok, winner, playedonce : boolean := false;
	fanfare: interfaces.c.int;

	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..2) of float; -- goal pos
	epsilon : constant float := 0.01;

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

	ntrail, blank1 : 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
	rc,cc : integer;
	Ok : boolean;
begin
	winner := true;

	for k in 1..dblk loop

		rc := integer(float'rounding(+0.5+rowcen(k)));
		cc := integer(float'rounding(+0.5+colcen(k)));

		--rc:= integer( round(rowcen(k)+0.5) );
		--cc:= integer( round(colcen(k)+0.5) );

		ch:= idchar(k);

		if rc=1 then --first row

			case cc is
				when 1 => Ok:=(ch='p');
				when 2 => Ok:=(ch='a');
				when 3 => Ok:=(ch='n');
				when 4 => Ok:=(ch='a');
				when 5 => Ok:=(ch='m');
				when 6 => Ok:=(ch='a');
				when others => Ok:=false;
			end case;

		elsif rc=2 then -- 2nd row

			case cc is
				when 1 => Ok:=(ch='c');
				when 2 => Ok:=(ch='a');
				when 3 => Ok:=(ch='n');
				when 4 => Ok:=(ch='a');
				when 5 => Ok:=(ch='l');
				when others => Ok:=false;
			end case;

		end if;

		winner := winner and Ok;

	end loop; -- for k

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/panama.blk";
	fileid : text_io.file_type;
	len: natural;
	clrstr: string(1..40);
	updir : string := "../../";
begin

	--note:  if user calls this executable from the directory in
	--       which it resides, we need to adjust the path thusly:
	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); --2
	myint_io.get(fileid, ncol); --6
	myint_io.get(fileid, dblk); --11
	myint_io.get(fileid, gblk); --1

	nblk:=dblk+1;

	myassert( gblk = 1 ); -- this code only handles single object block
	myassert( nblk <= maxblk );
	myassert( dblk <= maxcar ); -- allow labels a..m for vehicles


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


--put_line("input letter check:");

	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):=clrstr(2);

--put_line(" "&idchar(i));
--put_line("|"&clrstr&"|");

	end loop;

--new_line;

	blank1 := dblk+1;

--put_line("hit enter> to continue:");
--get_line(clrstr,len);

   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);

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

begin

	if( shape=11 ) then

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


	end if;



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


	if( ret > 0 )	
	then
		changed:=true;
		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);


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

begin


	if( shape=11 ) then

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


	end if;



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



	if( ret > 0 )
	then
		changed:=true;
		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);


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

begin


	if( shape=11 ) then

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

	end if;


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



	if( ret > 0 )	
	then
		changed:=true;
		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);

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

begin

	if( shape=11 ) then

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


	end if;


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



	if( ret > 0 )	
	then
		changed:=true;
		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, i : integer;
	tj : array(1..2,1..6) of character := (others=>(others=>' '));
	blankpos : array(1..2,1..6) 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.bShell("cls", Ok); -- erase-terminal
	else
		SysUtils.bShell("clear", Ok); -- erase-terminal
	end if;
	erase:=false;

else

	if mswin then
		--SysUtils.bShell("cls", Ok); -- erase-terminal
		tput00_h.cursorHome;
	else
		SysUtils.bShell("tput cup 0 0", Ok); -- erase-terminal
	end if;

end if;





if help then

	put_line(" Panama--help-screen...q,x => quit");
	put_line(" ? => toggle-help,  r => restart");
	put_line("============================================");
	put_line(" use arrow-keys to move.");
	put_line("============================================");

else


	--put_line(objectiveText);
	put_line("Use arrow keys to move letters");
	put_line("...and spell: panama canal");

	put_line(" q = quit,  r = restart");
	new_line;

	for i in 1..dblk 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;

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


	i := dblk+1;
	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;
		when others => null;
	end case;









-- colors available:
-- black,red,green,yellow,blue,magenta,cyan,grey
-- begin draw puzzle--------------------
   --Info.Set_Color (style=>bright); --sometimes has odd effects
	Info.Set_Color (background=>black);
	Info.Set_Color (foreground=>blue);


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

	for row in 1..nrow loop
		Info.Set_Color (foreground=>blue);
		put("#");

		Info.Set_Color (foreground=>magenta);
		for col in 1..ncol loop
			if blankpos(row,col) then
				put("  "); --blank
			else
				put( ' ' & tj(row,col) );
			end if;
		end loop;

		Info.Set_Color (foreground=>blue);
		put(" #");
		new_line;
	end loop;

	Info.Set_Color (foreground=>blue);

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

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

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

	put_line( to_string(infilname) );



	if winner then
		put_line("Correct !");
		put_line("Solved in "&integer'image(nMoves)&" steps");
		if not playedonce then
			snd4ada.playSnd(fanfare);
			playedonce:=true;
		end if;
	else
		playedonce:=false;
		put_line("                         ");
		put_line("                         ");
	end if;

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










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 ada.characters.handling.is_letter(ch) or (ch='?') then


	case ch is

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

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

		when 'H' | 'A' =>	
			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' =>	
			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' =>	
			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' =>	
			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 'r' => 
			init; --restart
			changed:=true;

		when others => changed:=false;

	end case;

end if;
end handle_key_down;









--Ok: boolean := false;

gfil: text_io.file_type;


	rtime: interfaces.c.int;

procedure initsounds( path: string ) is
begin

	snd4ada.initSnds;
	fanfare := snd4ada.initSnd(
		Interfaces.C.Strings.New_String(path&"applause.wav"));
	if fanfare<0 then
		put_line("snd4ada.initSnd ERROR fanfare");
		raise program_error;
	end if;

end initsounds;

	path0 : constant string(1..7)  := "sounds/";
	path1 : constant string(1..13) := "../../sounds/";




begin --cpana


	if mswin then
		rtime:=realtime.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;



---------------- begin sound addendum --------------------------

	if ada.directories.Exists(path0) then
		initsounds(path0);
	else
		initsounds(path1);
	end if;

---------------- end sound addendum --------------------------




	Init; --// define puzzle parameters here



	if mswin then
		SysUtils.bShell("cls", Ok); -- erase-terminal
	else
		SysUtils.bShell("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:


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

	snd4ada.termSnds;



end cpana;

