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




-- cslid.adb : ColorTerminalBlockSlider = block slider in a terminal window
--

with snd4ada_hpp;
with tput00_h;
with gnat.os_lib;
with realtime_hpp;
with ada.characters.handling;

with Interfaces.C.Strings;
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 fbfs;

with GNATCOLL.Terminal;  use GNATCOLL.Terminal;





procedure cslid 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, playedonce : boolean := false;
	fanfare: interfaces.c.int;

	solutionPath: unbounded_string;

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

	gamefiles, shortname : array(1..maxNpuz) of unbounded_string;
	infilname : unbounded_string;
	savename : unbounded_string := to_unbounded_string("puzzles/resume_block.txt");

	objectiveText : string(1..60);
	movesText: string(1..9);

-----------------------------------------------------------------
-- 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, blank2 : integer := 0;


-- nrowmax	ncolmax
--	6 			4
	goalrow : array(1..6) of boolean := (others=>false);
	goalcol : array(1..5) of boolean := (others=>false);





	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 dumpGameState(fnam: string) is
	fileid : text_io.file_type;
begin

   text_io.Create
      (File => FileId,
       Mode => text_io.Out_File,
       Name => fnam);

	put_line(fileid, objectiveText);
	myint_io.put(fileid, nrow);
	new_line(fileid);
	myint_io.put(fileid, ncol);
	new_line(fileid);
	myint_io.put(fileid, dblk);
	new_line(fileid);
	myint_io.put(fileid, gblk);
	new_line(fileid);
	for g in 1..gblk loop
		myfloat_io.put(fileid, grow(g));
		myfloat_io.put(fileid, gcol(g));
	end loop;
	new_line(fileid);

	for i in 1..nblk loop
		myint_io.put(fileid, bshape(i));
		put(fileid," ");
		myfloat_io.put(fileid, rowcen(i));
		put(fileid," ");
		myfloat_io.put(fileid, colcen(i));
		put(fileid," ");
		if i<nblk-1 then
		put_line(fileid, "black");
		else
		put_line(fileid, "white");
		end if;
	end loop;

   text_io.Close (File => FileId);

end dumpGameState;



procedure init( fname: string ) is
	fileid : text_io.file_type;
	len: natural;
	clrstr: string(1..40);
	--ich: character;
	igrow,igcol: integer;
begin

   text_io.Open
      (File => FileId,
       Mode => text_io.In_File,
       Name => fname);


	objectiveText:=(others=>' ');
	text_io.get_line(fileid, objectiveText, len);
	movesText := objectiveText(len-8..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); --line2  5


	myint_io.get(fileid, ncol); --line3  4

	myint_io.get(fileid, dblk); --line4 10 (total # nonblank blocks)


	myint_io.get(fileid, gblk); -- gblk = 1 = #goal blocks


	nblk:=dblk+2; -- here, always 2 empty square cells

	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)); --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( 96+i ); --a=97...z=122
	end loop;

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



   text_io.Close (File => FileId);

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

-- note bshape(1) is either 21 or 22...
	igrow := integer( grow(1) ); --rounded to nint
	igcol := integer( gcol(1) ); --rounded to nint

	goalrow := (others=>false);
	goalcol := (others=>false);

	goalrow( igrow ) := true;
	goalrow( igrow+1 ) := true;

	goalcol( igcol ) := true;
	if bshape(1)=22 then
		goalcol( igcol+1 ) := true;
	elsif bshape(1) /= 21 then
		raise program_error;
	end if;

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, goalpos: boolean;
	ch: character;
	rc,cc: float;
	ulr, ulc, shape : integer;
	-- largets puzzle is 6x4
	tj : array(1..6,1..4) of character := (others=>(others=>' '));
	ts : array(1..6,1..4) of integer := (others=>(others=>11));
	-- ts=1 => primary object, ts=0 => empty
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(" CoTerminalBlok--help-screen");
	put_line(" q,x => quit,  ? => toggle-help,  r => restart");
	put_line(" The blocks of letters slide up,down,left,right");
	put_line(" The objective is stated, but often requires");
	put_line(" moving the large red block to a goal position.");
	--put_line(" Note: last # in puzzle name is minimum moves.");
	put_line("=======================================");
	put_line(" Select block using keys a..m");
	put_line(" Then use arrow-keys to move it.");
	put_line(" Keys: <+>, <-> => next, prev puzzle.");
	put_line("==============================");

else

	put_line(" CoTerminalBlok");
	--put_line(" move the red 'a' block to black goal space");

	put_line(objectiveText);
	put_line(" minimum: " & movesText );

	put_line(" q = quit,  ? = toggle-help,  + = next");
	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;

				if i=1 then
				ts(ulr+0,ulc+0):=1;
				ts(ulr+0,ulc+1):=1; --red
				else
				ts(ulr+0,ulc+0):=12;
				ts(ulr+0,ulc+1):=12; --cyan
				end if;

			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;

				if i=1 then
				ts(ulr+0,ulc+0):=1;
				ts(ulr+1,ulc+0):=1; --red
				else
				ts(ulr+0,ulc+0):=21;
				ts(ulr+1,ulc+0):=21; --green
				end if;

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

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

			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;

				if i=1 then
				ts(ulr+0,ulc+0):=1;
				ts(ulr+1,ulc+0):=1; --red
				ts(ulr+0,ulc+1):=1;
				ts(ulr+1,ulc+1):=1;
				else
				ts(ulr+0,ulc+0):=22;
				ts(ulr+1,ulc+0):=22; --magenta
				ts(ulr+0,ulc+1):=22;
				ts(ulr+1,ulc+1):=22;
				end if;

			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;
				ts(ulr+0,ulc+0):=0; -- blank
			when others => null;
		end case;
	end loop;



for g in 1..gblk loop


if bshape(g) = 22 then

	ulr := integer(float'rounding(+0.0+grow(g)));
	ulc := integer(float'rounding(+0.0+gcol(g)));
	ts(ulr+0,ulc+0):=ts(ulr+0,ulc+0)+100;
	ts(ulr+1,ulc+0):=ts(ulr+1,ulc+0)+100;
	ts(ulr+0,ulc+1):=ts(ulr+0,ulc+1)+100;
	ts(ulr+1,ulc+1):=ts(ulr+1,ulc+1)+100;

elsif bshape(g) = 12 then

	ulr := integer(float'rounding(+0.5+grow(g)));
	ulc := integer(float'rounding(+0.0+gcol(g)));
	ts(ulr+0,ulc+0):=ts(ulr+0,ulc+0)+100;
	ts(ulr+0,ulc+1):=ts(ulr+0,ulc+1)+100;

elsif bshape(g) = 21 then

	ulr := integer(float'rounding(+0.0+grow(g)));
	ulc := integer(float'rounding(+0.5+gcol(g)));
	ts(ulr+0,ulc+0):=ts(ulr+0,ulc+0)+100;
	ts(ulr+1,ulc+0):=ts(ulr+1,ulc+0)+100;

end if;

end loop;





-- colors available:
-- black,red,green,yellow,blue,magenta,cyan,grey
-- begin draw puzzle--------------------

   --Info.Set_Color (style=>bright);--may upset colors
   --Info.Set_Style (style=>bright);--may upset colors
	Info.Set_Color (background=>black); --grey); --black);

	info.set_color(foreground=>red);

	--0th row = upper boundary:
	put("#");
	for col in 1..ncol loop
		if goalcol(col)=true then
			put(" .");
		else
			put(" #");
		end if;
	end loop;
	put_line(" #");

	--rows 1..nrow:
	for row in 1..nrow loop

		--Left Boundary:
		if goalrow(row)=true then
			put(".");
		else
			put("#");
		end if;

		for col in 1..ncol loop
			shape:=ts(row,col);
			put(" ");
			if shape>=100 then
				goalpos:=true;
				shape:=shape-100;
   			--Info.Set_Color (background=>grey); --black);
			else
				goalpos:=false;
   			--Info.Set_Color (background=>black); --grey);
			end if;
   		Info.Set_Color (background=>black); --grey);
			--put(" ");
			case shape is
				when  1 => -- primary object
					info.set_color(foreground=>red);
				when 22 => 
					info.set_color(foreground=>magenta);
				when 12 => 
					info.set_color(foreground=>green);
				when 21 => 
					info.set_color(foreground=>cyan);

				when 11 => 
					info.set_color(foreground=>yellow);

				when others => 
					null; --info.set_color(foreground=>unchanged);
			end case;
			if shape = 0 then
				put(" "); --blank
			else
				put( tj(row,col) );
			end if;

			Info.Set_Color (background=>black); --grey);

		end loop; --col

		info.set_color(foreground=>red);

		--Right Boundary:
		if goalrow(row)=true then
			put(" .");
		else
			put(" #");
		end if;
		new_line;
	end loop; --row

	-- row nrow+1 = lower boundary:
	put("#");
	for col in 1..ncol loop
		if goalcol(col)=true then
		put(" .");
		else
		put(" #");
		end if;
	end loop;
	put_line(" #");


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

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

	put("Press = to solve...");
	if movesrem>0 then
		put_line(integer'image(movesrem)&" steps remain");
	else
		put_line("                         ");
	end if;


	put_line( to_string(infilname) );



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

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='?') or (ch='=') or (ch='+') or (ch='-')
	then
		return true;

	else
		return false;

	end if;
end;



procedure handle_key_down( ch: character; puzdir: unbounded_string ) is
	ret, preBlock : integer;
	idch, ckch, mvch : character;

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 '=' =>

		if not winner then

			if movesrem>0 then

				idch := element(solutionPath,1);
				ckch := element(solutionPath,2);
				mvch := element(solutionPath,3);
				myassert(ckch='-');
				delete(solutionPath,1,3);
				movesrem := length(solutionPath)/3;
				selBlock := character'pos(idch) - character'pos('a') + 1;

				if    mvch='u' then ret:=moveup;
				elsif mvch='d' then ret:=movedown;
				elsif mvch='l' then ret:=moveleft;
				elsif mvch='r' then ret:=moveright;
				else raise program_error; end if;

			else -- initiate solver

				dumpGameState("slid.txt");
				fbfs.bfs( to_unbounded_string("slid.txt"), solutionPath);
				movesrem := length(solutionPath)/3;
				changed:=true;

			end if;

		end if; --not winner


		when 'a'..'m' => 
			preBlock:= character'pos(ch) - character'pos('a') + 1;
			if preBlock>=1 and preBlock<=dblk then
				selBlock:=preBlock;
				movesrem:=0;
			end if;


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

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

		when 'r' => --restart
			movesrem:=0;
			Init( to_string(infilname) ); 
			--erase:=true;
			changed:=true;


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

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


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


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


		when '+' => 
			movesrem:=0;
			npuz:=npuz+1;
			if npuz>totgame then npuz:=1; end if;
			infilname := puzdir & shortname(npuz);
			Init( to_string(infilname) );
			erase:=true;

		when '-' => 
			movesrem:=0;
			npuz:=npuz-1;
			if npuz<1 then npuz:=totgame; end if;
			infilname := puzdir & shortname(npuz);
			Init( to_string(infilname) );
			erase:=true;


		when others => changed:=false;

	end case;

end if;
end handle_key_down;







procedure initsounds( path: string ) is
begin

	snd4ada_hpp.initSnds;

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

end initsounds;









gfil: text_io.file_type;

surchdir : unbounded_string := to_unbounded_string("puzzles/");
up2 : constant string := "../../";


	--linestr: string(1..9);
	--last: natural;

	rtime: interfaces.c.int;

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


begin -- cslid 


	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;



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

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

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



	if not ada.directories.exists( to_string(surchdir) ) then
		surchdir := up2 & surchdir;
		savename := up2 & savename;
	end if;



------- begin dynamic read of ./puzzles/ directory --------------------------------

	-- find *.rush files under ./puzzles/
	put_line("Here are the blok files found under ./puzzles/ :");
	totgame:=0;
	start_search( search, to_string(surchdir), "*.blok" );
	while more_entries( search ) loop

		get_next_entry( search, directory_entry );
		totgame:=totgame+1;

		gamefiles(totgame)  := to_unbounded_string( full_name( directory_entry ) );
		shortName(totgame):= to_unbounded_string( simple_name(directory_entry) );
		put_line( shortName(totgame) );

	end loop; -- while more_entries
	--fmax:=totgame;
	put_line("...for a total of totgame="&integer'image(totgame));
	new_line;


------- end dynamic read of ./puzzles/ directory --------------------------------



	npuz:=1; -- default to easiest

	if( ada.directories.exists( to_string(savename) ) ) then
		text_io.open(gfil, text_io.in_file, to_string(savename) );

		myint_io.get(gfil, npuz);
		--linestr := (others=>' ');
		--text_io.get_line(gfil,linestr,last);
		--myint_io.get(linestr,npuz,last);

		text_io.close(gfil);
		if npuz<1 then npuz:=1; end if;
		if npuz>totgame then npuz:=totgame; end if;
	end if;

	infilname := surchdir & shortname(npuz);


	Init( to_string(infilname) ); --// 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, surchdir );
		Draw;
	end loop;

-- end main event loop:

	-- save current state:
	text_io.create(gfil, text_io.out_file, to_string(savename) );
	myint_io.put(gfil, npuz);
	text_io.close(gfil);

	snd4ada_hpp.termSnds; --13may20

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


end cslid;

