
--
-- 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/>.
--




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

with snd4ada;
with tput00_h;


with gnat.os_lib;
with realtime;
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 GNATCOLL.Terminal;  use GNATCOLL.Terminal;





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

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

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


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


	blank: constant array(1..8) of integer := (6,7,8,9,10,11,12,13);






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






function same( a, b : float ) return boolean is
	epsilon : constant float := 0.1;
begin
	if abs(b-a) < epsilon then
		return true;
	else
		return false;
	end if;
end same;






procedure test4winner is
	r0,c0,rc,cc : integer;
begin

	-- a (center)
	r0 := integer(float'rounding(rowcen(1)));
	c0 := integer(float'rounding(colcen(1)));
	winner := ((r0=2) or (r0=3) or (r0=4)) and (c0=2);

	-- b (UL)
	rc := integer(float'rounding(+0.5+rowcen(2)));
	cc := integer(float'rounding(+0.5+colcen(2)));
	winner := winner and (rc=r0-1) and (cc=1);

	-- c (UR)
	rc := integer(float'rounding(+0.5+rowcen(3)));
	cc := integer(float'rounding(+0.5+colcen(3)));
	winner := winner and (rc=r0-1) and (cc=4);

	-- d (LL)
	rc := integer(float'rounding(+0.5+rowcen(4)));
	cc := integer(float'rounding(+0.5+colcen(4)));
	winner := winner and (rc=r0+2) and (cc=1);

	-- e (LR)
	rc := integer(float'rounding(+0.5+rowcen(5)));
	cc := integer(float'rounding(+0.5+colcen(5)));
	winner := winner and (rc=r0+2) and (cc=4);

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
	--len: natural;
	--clrstr: string(1..40);
begin

	-- (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

	nrow:=6;
	ncol:=4;
	dblk:=5;
	gblk:=1;

	nblk:=dblk+8; --13

	myassert( nblk <= maxblk );
	myassert( dblk <= maxcar ); -- allow labels a..m for vehicles

	grow(1):=3.0;
	gcol(1):=2.0;

	bshape(1):=22;
	rowcen(1):=5.0;
	colcen(1):=2.0;
	idchar(1):='a';

	bshape(2):=91;
	rowcen(2):=0.5;
	colcen(2):=0.5;
	idchar(2):='b';

	bshape(3):=92;
	rowcen(3):=0.5;
	colcen(3):=3.5;
	idchar(3):='c';

	bshape(4):=93;
	rowcen(4):=3.5;
	colcen(4):=0.5;
	idchar(4):='d';

	bshape(5):=94;
	rowcen(5):=3.5;
	colcen(5):=3.5;
	idchar(5):='e';

	bshape(6):=11;
	rowcen(6):=1.5;
	colcen(6):=1.5;
	idchar(6):=' ';

	bshape(7):=11;
	rowcen(7):=1.5;
	colcen(7):=2.5;
	idchar(7):=' ';

	bshape(8):=11;
	rowcen(8):=2.5;
	colcen(8):=1.5;
	idchar(8):=' ';

	bshape(9):=11;
	rowcen(9):=2.5;
	colcen(9):=2.5;
	idchar(9):=' ';

	bshape(10):=11;
	rowcen(10):=4.5;
	colcen(10):=0.5;
	idchar(10):=' ';

	bshape(11):=11;
	rowcen(11):=4.5;
	colcen(11):=3.5;
	idchar(11):=' ';

	bshape(12):=11;
	rowcen(12):=5.5;
	colcen(12):=0.5;
	idchar(12):=' ';

	bshape(13):=11;
	rowcen(13):=5.5;
	colcen(13):=3.5;
	idchar(13):=' ';




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

end init;



function moveleft return integer is

	ret: integer := 0;

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

	br,bc : array(1..8) of float;
	found1, found2 : integer := 0;

begin

	for j in 1..8 loop
		br(j):=rowcen(blank(j));
		bc(j):=colcen(blank(j));
	end loop;


	if   ( shape=91 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc-1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
		end if;

	elsif( shape=92 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc-2.0) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc-1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
		end if;

	elsif( shape=93 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc-1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
		end if;

	elsif( shape=94 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc-2.0) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc-1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
		end if;

	elsif( shape=22 ) then
		for j in 1..8 loop
			if same(br(j),sr-0.5) and same(bc(j),sc-1.5) then found1:=blank(j); end if;
			if same(br(j),sr+0.5) and same(bc(j),sc-1.5) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 2.0;
			ret := 1;
		end if;

	elsif( shape=11 ) then
		null;

	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;

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

	br,bc : array(1..8) of float;
	found1, found2 : integer := 0;

begin

	for j in 1..8 loop
		br(j):=rowcen(blank(j));
		bc(j):=colcen(blank(j));
	end loop;


	if   ( shape=91 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc+2.0) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
		end if;

	elsif( shape=92 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc+1.0) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
		end if;

	elsif( shape=93 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc+2.0) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
		end if;

	elsif( shape=94 ) then
		for j in 1..8 loop
			if same(br(j),sr) and same(bc(j),sc+1.0) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
		end if;

	elsif( shape=22 ) then
		for j in 1..8 loop
			if same(br(j),sr-0.5) and same(bc(j),sc+1.5) then found1:=blank(j); end if;
			if same(br(j),sr+0.5) and same(bc(j),sc+1.5) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 2.0;
			ret := 1;
		end if;

	elsif( shape=11 ) then
		null;

	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;

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

	br,bc : array(1..8) of float;
	found1, found2 : integer := 0;

begin

	for j in 1..8 loop
		br(j):=rowcen(blank(j));
		bc(j):=colcen(blank(j));
	end loop;


	if   ( shape=91 ) then
		for j in 1..8 loop
			if same(br(j),sr-1.0) and same(bc(j),sc) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			rowcen(found2)   := rowcen(found2) + 1.0;
			ret := 1;
		end if;

	elsif( shape=92 ) then
		for j in 1..8 loop
			if same(br(j),sr-1.0) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 1.0;
			rowcen(found2)   := rowcen(found2) + 2.0;
			ret := 1;
		end if;

	elsif( shape=93 ) then
		for j in 1..8 loop
			if same(br(j),sr-2.0) and same(bc(j),sc) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			rowcen(found2)   := rowcen(found2) + 1.0;
			ret := 1;
		end if;

	elsif( shape=94 ) then
		for j in 1..8 loop
			if same(br(j),sr-1.0) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr-2.0) and same(bc(j),sc) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 1.0;
			rowcen(found2)   := rowcen(found2) + 2.0;
			ret := 1;
		end if;

	elsif( shape=22 ) then
		for j in 1..8 loop
			if same(br(j),sr-1.5) and same(bc(j),sc-0.5) then found1:=blank(j); end if;
			if same(br(j),sr-1.5) and same(bc(j),sc+0.5) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			rowcen(found2)   := rowcen(found2) + 2.0;
			ret := 1;
		end if;

	elsif( shape=11 ) then
		null;

	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;

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

	br,bc : array(1..8) of float;
	found1, found2 : integer := 0;

begin

	for j in 1..8 loop
		br(j):=rowcen(blank(j));
		bc(j):=colcen(blank(j));
	end loop;


	if   ( shape=91 ) then
		for j in 1..8 loop
			if same(br(j),sr+2.0) and same(bc(j),sc) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			rowcen(found2)   := rowcen(found2) - 1.0;
			ret := 1;
		end if;

	elsif( shape=92 ) then
		for j in 1..8 loop
			if same(br(j),sr+1.0) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr+2.0) and same(bc(j),sc) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 1.0;
			rowcen(found2)   := rowcen(found2) - 2.0;
			ret := 1;
		end if;

	elsif( shape=93 ) then
		for j in 1..8 loop
			if same(br(j),sr+1.0) and same(bc(j),sc) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			rowcen(found2)   := rowcen(found2) - 1.0;
			ret := 1;
		end if;

	elsif( shape=94 ) then
		for j in 1..8 loop
			if same(br(j),sr+1.0) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 1.0;
			rowcen(found2)   := rowcen(found2) - 2.0;
			ret := 1;
		end if;

	elsif( shape=22 ) then
		for j in 1..8 loop
			if same(br(j),sr+1.5) and same(bc(j),sc-0.5) then found1:=blank(j); end if;
			if same(br(j),sr+1.5) and same(bc(j),sc+0.5) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			rowcen(found2)   := rowcen(found2) - 2.0;
			ret := 1;
		end if;

	elsif( shape=11 ) then
		null;

	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 : integer;
	tj : array(1..6,1..5) of character := (others=>(others=>' '));
	blankpos : array(1..6,1..5) 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("tput00", Ok); -- erase-terminal
		--ret:=tput00_h.tput00;
		tput00_h.cursorHome;
	else
		SysUtils.bShell("tput cup 0 0", Ok); -- erase-terminal
	end if;

end if;


if help then

	put_line(" HIO--help-screen...q,x => quit");
	put_line(" ? => toggle-help,  r => restart");
	put_line("============================================");
	put_line(" use arrow-keys to move.");
	put_line(" Type a letter to select a block.");
	put_line("============================================");

else

	put_line(" Hole-in-One");
	put_line(" move the red 'a' block to the center");
	put_line(" of the 4 L-shaped corner pieces");

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

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

			when 91 =>

				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;

			when 92 =>

				ulr := integer(float'rounding(+0.0+rc));
				ulc := integer(float'rounding(-1.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;

			when 93 =>

				ulr := integer(float'rounding(-1.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;

			when 94 =>

				ulr := integer(float'rounding(-1.0+rc));
				ulc := integer(float'rounding(-1.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;


			when others => null;
		end case;
	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_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("#");

		for col in 1..ncol loop
			ch:=tj(row,col);
			case ch is
				when 'a' =>
					info.set_color(foreground=>red);

				when 'b' =>
					info.set_color(foreground=>grey);

				when 'c' =>
					info.set_color(foreground=>cyan);

				when 'd' =>
					info.set_color(foreground=>green);

				when 'e' =>
					info.set_color(foreground=>magenta);

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

			end case;
			put( ' ' & ch );
		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(float'image(rowcen(1))&","&float'image(colcen(1)));
--put_line(float'image(rowcen(2))&","&float'image(colcen(2)));
--put_line(float'image(rowcen(3))&","&float'image(colcen(3)));
--put_line(float'image(rowcen(4))&","&float'image(colcen(4)));
--put_line(float'image(rowcen(5))&","&float'image(colcen(5)));


	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;







function goodChar(ch: character) return boolean is
begin
	if ada.characters.handling.is_letter(ch) then
		return true;
	elsif (ch='?')  then
		return true;
	else
		return false;
	end if;
end;





procedure handle_key_down( ch: character ) is
	ret,preblock : 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 'a'..'m' => 
			--selBlock:= character'pos(ch) - character'pos('a') + 1;
			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 '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;








	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 -- chio


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

