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




-- cann.adb : Annoying BlockSliders
--

with snd4ada;
with cls_h;


with gnat.os_lib;
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.fixed;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;

with GNATCOLL.Terminal;  use GNATCOLL.Terminal;

with ada.calendar;
with realtime;

with fbfsa;


procedure cann is

use ada.calendar;
use realtime;

use ada.characters.handling;
use ada.strings.fixed;
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;


	pzldir : unbounded_string := to_unbounded_string("puzzles/");

	solutionPath: unbounded_string;

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

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

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

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

-----------------------------------------------------------------
	mxblnk: constant integer := 9;
	blank:  array(1..mxblnk) of integer;
	nblanks: integer := 0;

-- maximum # cars/trucks:
	maxcar: constant integer := 8;

-- maximum # cars/trucks/blanks
	maxblk: constant integer := maxcar+mxblnk;

-- block centers:
	rowcen, colcen : array(1..maxblk) of float;
	idchar : array(1..maxblk) of character := (others=>' ');
	bshape : array(1..maxblk) of integer; -- 11,12,21, 91,92,93,94

-----------------------------------------------------------------
	gclr : array(1..2) of character;
	grow, gcol : array(1..2) of float; -- goal pos
	epsilon : constant float := 0.1;

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

	nomit, ntrail : integer := 0;



	totgame: constant integer := 16;

	shortname : constant array(1..totgame) of string(1..8)
	:=(
	 "ad01.blk", "ad02.blk", "ad03.blk", "ad04.blk",
	 "ad05.blk", "ad06.blk", "ad07.blk", "ad08.blk",
	 "ad09.blk", "ad10.blk", "ad11.blk", "ad12.blk",
	 "ad13.blk", "ad14.blk", "ad15.blk", "ad16.blk" );


	-- goal locations
	rgr,rgc, bgr,bgc : array(1..4) of integer;
	ng: integer := 1;





	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
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..dblk loop -- non-blank blocks
		myint_io.put(fileid, bshape(i));
		put(fileid," ");
		myfloat_io.put(fileid, rowcen(i));
		put(fileid," ");
		myfloat_io.put(fileid, colcen(i));
		put(fileid," ");
		put_line(fileid, "black");
	end loop;

	myint_io.put(fileid, nblanks);
	new_line(fileid);

	for i in dblk+1..dblk+nblanks loop -- blank 1x1 blocks
		myint_io.put(fileid, bshape(i));
		put(fileid," ");
		myfloat_io.put(fileid, rowcen(i));
		put(fileid," ");
		myfloat_io.put(fileid, colcen(i));
		put(fileid," ");
		put_line(fileid, "white");
	end loop;


	myint_io.put(fileid, nomit);
	new_line(fileid);

	for i in dblk+nblanks+1..dblk+nblanks+nomit loop -- omitted cells
		myint_io.put(fileid, bshape(i));
		put(fileid," ");
		myfloat_io.put(fileid, rowcen(i));
		put(fileid," ");
		myfloat_io.put(fileid, colcen(i));
		put(fileid," ");
		put_line(fileid, "omit");
	end loop;


   text_io.Close (File => FileId);

end dumpGameState;





procedure init( fname: string ) is
	fileid : text_io.file_type;
	len: natural;
	str, clrstr: string(1..40) := (others=>' ');
	bblk, rr,rc,br,bc : 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 puzzle pieces
	--// nblk = # pieces including blank 1x1 squares = dblk+nblanks
	--// gblk = # goal positions that must be attained
	--// (grow,gcol) = goal position[s]
	--// nomit = # field positions to be Omitted from rectangular
	--// bshape = 11 or 12 or 21 or 22 or 91..94 = block shape
	--// 91=>UL-L
	--// 92=>UR-L
	--// 93=>LL-L
	--// 84=>LR-L (center is center of corner)

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


	myassert( gblk <= 2 ); -- this code only handles 1 or 2 object blocks
	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..dblk loop -- define non-blank puzzle blocks (pieces).
		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);
		declare
			str: string := trim(clrstr,ada.strings.both);
		begin
			idchar(i) := str(1);
		end;

		if i<=2 then gclr(i):=idchar(i); end if;

	end loop;



	myint_io.get(fileid, bblk);
	myassert( bblk <= mxblnk );
	nblanks := bblk;
	nblk := dblk + nblanks;
	myassert( nblk <= maxblk );


	for i in dblk+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

		declare
			str: string := trim(clrstr,ada.strings.both);
		begin
			idchar(i) := str(1);
		end;

		myassert( bshape(i) = 11 );
	end loop;




	myint_io.get(fileid, nomit);
	for i in nblk+1..nblk+nomit 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

		declare
			str: string := trim(clrstr,ada.strings.both);
		begin
			idchar(i) := str(1);
		end;

		myassert( bshape(i) = 11 );
	end loop;



   text_io.Close (File => FileId);

	for i in 1..nblanks loop
		blank(i) := dblk+i;
	end loop;






	-- define all goal cell coords:
	case bshape(1) is
		when 11 =>

			ng:=1;

			rgr(1) := integer( float'rounding(0.5+grow(1)) );
			rgc(1) := integer( float'rounding(0.5+gcol(1)) );

			bgr(1) := integer( float'rounding(0.5+grow(2)) );
			bgc(1) := integer( float'rounding(0.5+gcol(2)) );

		when 12 =>

			ng:=2;

			rgr(1) := integer( float'rounding(0.5+grow(1)) );
			rgc(1) := integer( float'rounding(0.0+gcol(1)) );

			bgr(1) := integer( float'rounding(0.5+grow(2)) );
			bgc(1) := integer( float'rounding(0.0+gcol(2)) );

			rgr(2):=rgr(1)+0;
			rgc(2):=rgc(1)+1;
			bgr(2):=bgr(1)+0;
			bgc(2):=bgc(1)+1;


		when 21 =>

			ng:=2;

			rgr(1) := integer( float'rounding(0.0+grow(1)) );
			rgc(1) := integer( float'rounding(0.5+gcol(1)) );

			bgr(1) := integer( float'rounding(0.0+grow(2)) );
			bgc(1) := integer( float'rounding(0.5+gcol(2)) );

			rgr(2):=rgr(1)+1;
			rgc(2):=rgc(1)+0;
			bgr(2):=bgr(1)+1;
			bgc(2):=bgc(1)+0;



		-- currently no goal blocks are 2x2; but prep anyway.
		when 22 =>

			ng:=4;

			rgr(1) := integer( float'rounding(-0.5+grow(1)) );
			rgc(1) := integer( float'rounding(-0.5+gcol(1)) );

			bgr(1) := integer( float'rounding(-0.5+grow(2)) );
			bgc(1) := integer( float'rounding(-0.5+gcol(2)) ); --UL

			rgr(2):=rgr(1)+1; --LL
			rgc(2):=rgc(1)+0;
			bgr(2):=bgr(1)+1;
			bgc(2):=bgc(1)+0;

			rgr(3):=rgr(1)+0; --UR
			rgc(3):=rgc(1)+1;
			bgr(3):=bgr(1)+0;
			bgc(3):=bgc(1)+1;

			rgr(4):=rgr(1)+1; --LR
			rgc(4):=rgc(1)+1;
			bgr(4):=bgr(1)+1;
			bgc(4):=bgc(1)+1;



		when 91 => --UL

			ng:=3;

			rgr(1) := integer( float'rounding(0.5+grow(1)) );
			rgc(1) := integer( float'rounding(0.5+gcol(1)) );

			bgr(1) := integer( float'rounding(0.5+grow(2)) );
			bgc(1) := integer( float'rounding(0.5+gcol(2)) );

			rgr(2):=rgr(1)+1;
			rgc(2):=rgc(1)+0;
			bgr(2):=bgr(1)+1;
			bgc(2):=bgc(1)+0;

			rgr(3):=rgr(1)+0;
			rgc(3):=rgc(1)+1;
			bgr(3):=bgr(1)+0;
			bgc(3):=bgc(1)+1;





		when 92 => --UR

			ng:=3;

			rgr(1) := integer( float'rounding(+0.5+grow(1)) );
			rgc(1) := integer( float'rounding(-0.5+gcol(1)) );

			bgr(1) := integer( float'rounding(+0.5+grow(2)) );
			bgc(1) := integer( float'rounding(-0.5+gcol(2)) );

			rgr(2):=rgr(1)+0;
			rgc(2):=rgc(1)+1;
			bgr(2):=bgr(1)+0;
			bgc(2):=bgc(1)+1;

			rgr(3):=rgr(1)+1;
			rgc(3):=rgc(1)+1;
			bgr(3):=bgr(1)+1;
			bgc(3):=bgc(1)+1;


		when 93 => --LL

			ng:=3;

			rgr(1) := integer( float'rounding(-0.5+grow(1)) );
			rgc(1) := integer( float'rounding(+0.5+gcol(1)) );

			bgr(1) := integer( float'rounding(-0.5+grow(2)) );
			bgc(1) := integer( float'rounding(+0.5+gcol(2)) );

			rgr(2):=rgr(1)+1;
			rgc(2):=rgc(1)+0;
			bgr(2):=bgr(1)+1;
			bgc(2):=bgc(1)+0;

			rgr(3):=rgr(1)+1;
			rgc(3):=rgc(1)+1;
			bgr(3):=bgr(1)+1;
			bgc(3):=bgc(1)+1;


		when 94 => --LR

			ng:=3;

			rr := integer( float'rounding(-0.5+grow(1)) );
			rc := integer( float'rounding(-0.5+gcol(1)) );

			br := integer( float'rounding(-0.5+grow(2)) );
			bc := integer( float'rounding(-0.5+gcol(2)) );

			rgr(1):=rr+1;
			rgc(1):=rc+0;
			bgr(1):=br+1;
			bgc(1):=bc+0;

			rgr(2):=rr+0;
			rgc(2):=rc+1;
			bgr(2):=br+0;
			bgc(2):=bc+1;

			rgr(3):=rr+1;
			rgc(3):=rc+1;
			bgr(3):=br+1;
			bgc(3):=bc+1;


		when others => null;

	end case; -- to define visual goal locations




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

end init;




-- these 2 functions check that the proposed new positions
-- of blanks is indeed inside the playing field.

function valid( f1, f2 : integer;  dr1, dc1, dr2, dc2 : float ) 
				return boolean is
	ok: boolean := true;
	nubr1,nubc1,nubr2,nubc2: float;
begin
	nubr1:=rowcen(f1)+dr1;
	nubc1:=colcen(f1)+dc1;
	nubr2:=rowcen(f2)+dr2;
	nubc2:=colcen(f2)+dc2;
	for j in 1..nomit loop -- should NOT match any pos Omitted from playing field
		if same(nubr1,rowcen(nblk+j)) and same(nubc1,colcen(nblk+j)) then ok:=false; end if;
		if same(nubr2,rowcen(nblk+j)) and same(nubc2,colcen(nblk+j)) then ok:=false; end if;
	end loop;
	return ok;
end;



function valid( f1 : integer;  dr1, dc1 : float ) 
				return boolean is
	ok: boolean := true;
	nubr1,nubc1: float;
begin
	nubr1:=rowcen(f1)+dr1;
	nubc1:=colcen(f1)+dc1;
	for j in 1..nomit loop -- should NOT match any pos Omitted from playing field
		if same(nubr1,rowcen(nblk+j)) and same(nubc1,colcen(nblk+j)) then ok:=false; end if;
	end loop;
	return ok;
end;







function moveleft return integer is -- done, I believe

	ret: integer := 0;

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

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

begin

if selBlock in 1..dblk then

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


	if   ( shape=91 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, 2.0, 0.0, 1.0);
			if ok then
				colcen(selBlock) := colcen(selBlock)-1.0;
				colcen(found1)   := colcen(found1) + 2.0;
				colcen(found2)   := colcen(found2) + 1.0;
				ret := 1;
			end if;
		end if;

	elsif( shape=92 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, 2.0, 0.0, 1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=93 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, 2.0, 0.0, 1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=94 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, 2.0, 0.0, 1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=22 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, 2.0, 0.0, 2.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			colcen(found2)   := colcen(found2) + 2.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=21 ) then
		for j in 1..nblanks loop
			if same(br(j),sr-0.5) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
			if same(br(j),sr+0.5) and same(bc(j),sc-1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			ok := valid(found1,found2, 0.0, 1.0, 0.0, 1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 1.0;
			colcen(found2)   := colcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=12 ) then
		for j in 1..nblanks loop
			if same(br(j),sr) and same(bc(j),sc-1.5) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, 0.0, 2.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 2.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=11 ) then
		for j in 1..nblanks loop
			if same(br(j),sr) and same(bc(j),sc-1.0) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, 0.0, 1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)-1.0;
			colcen(found1)   := colcen(found1) + 1.0;
			ret := 1;
			end if;
		end if;

	end if;



	if( ret > 0 )	
	then
		changed:=true;
		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;

else
	return 0;
end if;
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..mxblnk) of float;
	found1, found2 : integer := 0;

begin

if selBlock in 1..dblk then

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


	if   ( shape=91 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, -2.0, 0.0, -1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=92 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, -2.0, 0.0, -1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=93 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, -2.0, 0.0, -1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=94 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, -2.0, 0.0, -1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=22 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 0.0, -2.0, 0.0, -2.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			colcen(found2)   := colcen(found2) - 2.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=21 ) then
		for j in 1..nblanks loop
			if same(br(j),sr-0.5) and same(bc(j),sc+1.0) then found1:=blank(j); end if;
			if same(br(j),sr+0.5) and same(bc(j),sc+1.0) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			ok := valid(found1,found2, 0.0, -1.0, 0.0, -1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 1.0;
			colcen(found2)   := colcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=12 ) then
		for j in 1..nblanks loop
			if same(br(j),sr) and same(bc(j),sc+1.5) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, 0.0, -2.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 2.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=11 ) then
		for j in 1..nblanks loop
			if same(br(j),sr) and same(bc(j),sc+1.0) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, 0.0, -1.0);
			if ok then
			colcen(selBlock) := colcen(selBlock)+1.0;
			colcen(found1)   := colcen(found1) - 1.0;
			ret := 1;
			end if;
		end if;





	end if;





	if( ret > 0 )
	then

	  	 changed:=true;

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


	return ret;

else
	return 0;
end if;
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..mxblnk) of float;
	found1, found2 : integer := 0;

begin


if selBlock in 1..dblk then

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


	if   ( shape=91 ) then --UL
		for j in 1..nblanks 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
			ok := valid(found1,found2, 2.0, 0.0, 1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			rowcen(found2)   := rowcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=92 ) then --UR
		for j in 1..nblanks 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
			ok := valid(found1,found2, 1.0, 0.0, 2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 1.0;
			rowcen(found2)   := rowcen(found2) + 2.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=93 ) then --LL
		for j in 1..nblanks 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
			ok := valid(found1,found2, 2.0, 0.0, 1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			rowcen(found2)   := rowcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=94 ) then --LR
		for j in 1..nblanks 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
			ok := valid(found1,found2, 1.0, 0.0, 2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 1.0;
			rowcen(found2)   := rowcen(found2) + 2.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=22 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, 2.0, 0.0, 2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			rowcen(found2)   := rowcen(found2) + 2.0;
			ret := 1;
			end if;
		end if;



	elsif( shape=21 ) then
		for j in 1..nblanks loop
			if same(br(j),sr-1.5) and same(bc(j),sc) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, 2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 2.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=12 ) then
		for j in 1..nblanks loop
			if same(br(j),sr-1.0) and same(bc(j),sc-0.5) then found1:=blank(j); end if;
			if same(br(j),sr-1.0) and same(bc(j),sc+0.5) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			ok := valid(found1,found2, 1.0, 0.0, 1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 1.0;
			rowcen(found2)   := rowcen(found2) + 1.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=11 ) then
		for j in 1..nblanks loop
			if same(br(j),sr-1.0) and same(bc(j),sc) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, 1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)-1.0;
			rowcen(found1)   := rowcen(found1) + 1.0;
			ret := 1;
			end if;
		end if;


	end if;




	if( ret > 0 )	
	then

	  	 changed:=true;

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

	return ret;

else
	return 0;
end if;
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..mxblnk) of float;
	found1, found2 : integer := 0;

begin

if selBlock in 1..dblk then

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


	if   ( shape=91 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, -2.0, 0.0, -1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			rowcen(found2)   := rowcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=92 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, -1.0, 0.0, -2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 1.0;
			rowcen(found2)   := rowcen(found2) - 2.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=93 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, -2.0, 0.0, -1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			rowcen(found2)   := rowcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=94 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, -1.0, 0.0, -2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 1.0;
			rowcen(found2)   := rowcen(found2) - 2.0;
			ret := 1;
			end if;
		end if;

	elsif( shape=22 ) then
		for j in 1..nblanks 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
			ok := valid(found1,found2, -2.0, 0.0, -2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			rowcen(found2)   := rowcen(found2) - 2.0;
			ret := 1;
			end if;
		end if;




	elsif( shape=21 ) then
		for j in 1..nblanks loop
			if same(br(j),sr+1.5) and same(bc(j),sc) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, -2.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 2.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=12 ) then
		for j in 1..nblanks loop
			if same(br(j),sr+1.0) and same(bc(j),sc-0.5) then found1:=blank(j); end if;
			if same(br(j),sr+1.0) and same(bc(j),sc+0.5) then found2:=blank(j); end if;
		end loop;
		if found1>0 and found2>0 then
			ok := valid(found1,found2, -1.0, 0.0, -1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 1.0;
			rowcen(found2)   := rowcen(found2) - 1.0;
			ret := 1;
			end if;
		end if;


	elsif( shape=11 ) then
		for j in 1..nblanks loop
			if same(br(j),sr+1.0) and same(bc(j),sc) then found1:=blank(j); end if;
		end loop;
		if found1>0 then
			ok := valid(found1, -1.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock)+1.0;
			rowcen(found1)   := rowcen(found1) - 1.0;
			ret := 1;
			end if;
		end if;



	end if;




	if( ret > 0 )	
	then

	  	 changed:=true;

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

	return ret;

else
	return 0;
end if;
end movedown;













procedure Draw( ich: character ) is

	info: terminal_info;

	Ok: boolean;
	ch: character;
	rc,cc: float;
	
	ulr,ulc, urr,urc, llr,llc, lrr,lrc : integer;
	tj : array(1..6,1..6) of character := (others=>(others=>' '));
	ts : array(1..6,1..6) of integer := (others=>(others=>0));
	omit,
	blankpos : array(1..6,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("tput00", Ok); -- erase-terminal
			--ret:=tput00_h.tput00;
			--tput00_h.cursorHome;
			cls_h.cursorHome;
		else
			SysUtils.bShell("tput cup 0 0", Ok); -- erase-terminal
		end if;

	end if;


if help then -- ideally, this should be indented 1 tab. Still within outer IF changed.

	put_line(" Annoying Sliders Help Screen");

	put_line(" q,x => quit");
	put_line(" ?  => toggle-help");
	put_line(" 0  => restart");
	put_line(" =  => AutoSolve (5 sec.wait)");
	put_line(" +  => next puzzle");
	put_line(" -  => prev puzzle");

	put_line("============================================");
	put_line(" Select block using keys r,b,y,g,c, then...");
	put_line(" to Move: use arrow-keys or ijkl or wasd.");
	put_line("============================================");

else

	put_line(" Annoying Sliders");
	put_line(objectiveText); -- usually contains Min Moves, too

-- this WAS for debug purposes...leave in anyway.
put(" Input Char: ");
put(ich);
put("  selBlock: ");
put( integer'image(selBlock) );
new_line;


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


	-- prepare to identify 1x1 cells omitted from playing field
	for i in nblk+1..nblk+nomit loop
		rc:=rowcen(i);
		cc:=colcen(i);

		ulr := integer(float'rounding(+0.5+rc));
		ulc := integer(float'rounding(+0.5+cc));

		omit(ulr,ulc):=true;

	end loop;


	for i in 1..dblk loop --all nonBlanks
		ch := idchar(i); -- first letter of color
		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;

				ts(ulr+0,ulc+0):=12;
				ts(ulr+0,ulc+1):=12;

			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;

				ts(ulr+0,ulc+0):=21;
				ts(ulr+1,ulc+0):=21;

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


			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;

			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;

				ts(ulr+0,ulc+0):=22;
				ts(ulr+1,ulc+0):=22;
				ts(ulr+0,ulc+1):=22;
				ts(ulr+1,ulc+1):=22;


-- note that the center of L-shaped pieces is taken to be
-- the center of the corner 1x1 square...

			when 91 => --UL

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

				ts(ulr+0,ulc+0):=91;
				ts(ulr+1,ulc+0):=91;
				ts(ulr+0,ulc+1):=91;



			when 92 => --UR

				urr := integer(float'rounding(+0.5+rc));
				urc := integer(float'rounding(-0.5+cc));
				tj(urr+0,urc+0):=ch;
				tj(urr+0,urc+1):=ch;
				tj(urr+1,urc+1):=ch;

				ts(urr+0,urc+0):=92;
				ts(urr+0,urc+1):=92;
				ts(urr+1,urc+1):=92;

			when 93 => --LL

				llr := integer(float'rounding(-0.5+rc));
				llc := integer(float'rounding(+0.5+cc));
				tj(llr+0,llc+0):=ch;
				tj(llr+1,llc+0):=ch;
				tj(llr+1,llc+1):=ch;

				ts(llr+0,llc+0):=93;
				ts(llr+1,llc+0):=93;
				ts(llr+1,llc+1):=93;

			when 94 => --LR

				lrr := integer(float'rounding(-0.5+rc));
				lrc := integer(float'rounding(-0.5+cc));

				tj(lrr+1,lrc+0):=ch;
				tj(lrr+0,lrc+1):=ch;
				tj(lrr+1,lrc+1):=ch;

				ts(lrr+1,lrc+0):=94;
				ts(lrr+0,lrc+1):=94;
				ts(lrr+1,lrc+1):=94;


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




	for i in dblk+1..dblk+nblanks 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;
			when others => null;
		end case;
	end loop;




-- colors available:
-- black,red,green,yellow,blue,magenta,cyan,grey
-- but since grey is used only for background, we take "g"=green.

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

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

	-- draw upper boundary of field:
	put("#");
	for col in 1..ncol loop
		put(" #");
	end loop;
	put_line(" #");

	-- draw interior:
	for row in 1..nrow loop
		Info.Set_Color (foreground=>black);
		put("#");

		for col in 1..ncol loop

			ch:=tj(row,col);
			case ch is
				when 'r' =>
					info.set_color(foreground=>red);

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

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

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

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

				when 'y' =>
					info.set_color(foreground=>yellow);

				when others =>
					info.set_color(foreground=>grey);
					ch:=' ';

					-- if no other char is here,
					-- and this cell is a goal,
					-- then it is visible so
					-- draw the goal colors

					if ng>=1 then

						if rgr(1)=row and rgc(1)=col then
							info.set_color(foreground=>red);
							ch:='.';
						elsif bgr(1)=row and bgc(1)=col then
							info.set_color(foreground=>blue);
							ch:='.';
						end if;

					end if;

					if ng>=2 then

						if rgr(2)=row and rgc(2)=col then
							info.set_color(foreground=>red);
							ch:='.';
						elsif bgr(2)=row and bgc(2)=col then
							info.set_color(foreground=>blue);
							ch:='.';
						end if;

					end if;

					if ng=3 then

						if rgr(3)=row and rgc(3)=col then
							info.set_color(foreground=>red);
							ch:='.';
						elsif bgr(3)=row and bgc(3)=col then
							info.set_color(foreground=>blue);
							ch:='.';
						end if;

					end if;


			end case;

			if omit(row,col) then
				info.set_color(foreground=>black);
				ch:='#';
			end if;


			put( ' ' & ch ); -- draw a char


		end loop; --col

		Info.Set_Color (foreground=>black);
		put(" #"); -- draw right boundary of field
		new_line;

	end loop; --row

	Info.Set_Color (foreground=>black);

	-- draw lower boundary of field:
	put("#");
	for col in 1..ncol loop
		put(" #");
	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("file: ");
	put_line( shortName(npuz) );


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

		if not playedonce then
			snd4ada.playSnd(fanfare);
			playedonce:=true;
		end if;
	else
		playedonce:=false;
		put_line("                         ");
		put_line("                         ");
	end if;

end if; -- not help

end if; -- changed or erase

end Draw;







function ogoodChar(ch: character) return boolean is
begin

	if ch=' ' then
		return false;
	elsif is_control(ch) then
		return false;

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


function goodChar(ch: character) return boolean is
	ok: boolean := false;
begin
	case ch is
		when 'H'|'P'|'M'|'K'     => ok:=true; --mswin arrowKeys
		when 'A'|'B'|'C'|'D'     => ok:=true; --linux/osx arrows
		when 'w'|'s'|'d'|'a'     => ok:=true; --move
		when 'i'|'k'|'l'|'j'     => ok:=true; --move
		when 'r'|'b'|'y'|'g'|'c'|'m' => ok:=true; --colors
		when '+'|'-'|'?'|'q'|'0'|'=' => ok:=true; --next,prev,help,quit,restart,solve
		when others => ok:=false;
	end case;
	return ok;
end;






procedure handle_key_down( ch: character; puzdir: unbounded_string; digested: out boolean ) is
	ret,preblock : integer;
	idch, ckch, mvch: character;
begin

	digested:=false;

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

			digested:=true;

		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;

				myassert( ret>0, 999 );
				if winner then nMoves:=0; end if;


			else -- initiate solver

				dumpGameState("ann.txt");
				fbfsa.bfsa( to_unbounded_string("ann.txt"), solutionPath);
				movesrem := length(solutionPath)/3;
				changed:=true;

			end if;

		end if; --not winner



		when 'r' | 'b' | 'y' | 'g' | 'c' | 'm' => --acceptable colors

			digested:=true;
			preBlock:=0;
			for i in 1..dblk loop
				if ch=idchar(i) then
					preBlock:=i;
				end if;
			end loop;

			if preBlock in 1..dblk then
				selBlock:=preBlock;
				movesrem:=0;
			end if;



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

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

		when 'H'|'A'|'w'|'i' =>
			movesrem:=0;
			if winner then nmoves:=0; end if;
			winner:=false;

			digested:=true;
			ret:=0;
			if selBlock in 1..dblk then
				ret:=moveup;
			end if;
			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'|'s'|'k' =>	
			movesrem:=0;
			if winner then nmoves:=0; end if;
			winner:=false;

			digested:=true;
			ret:=0;
			if selBlock in 1..dblk then
				ret:=movedown;
			end if;
			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'|'d'|'l' =>	
			movesrem:=0;
			if winner then nmoves:=0; end if;
			winner:=false;

			digested:=true;
			ret:=0;
			if selBlock in 1..dblk then
				ret:=moveright;
			end if;
			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'|'a'|'j' =>	
			movesrem:=0;
			if winner then nmoves:=0; end if;
			winner:=false;

			digested:=true;
			ret:=0;
			if selBlock in 1..dblk then
				ret:=moveleft;
			end if;
			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 '0' => 
			movesrem:=0;

			init( to_string(infilname) ); --restart
			changed:=true;
			digested:=true;


		when '+' => 
			movesrem:=0;
			npuz:=npuz+1;
			if npuz>totgame then npuz:=1; end if;
			infilname := puzdir & shortname(npuz);
			Init( to_string(infilname) );
			erase:=true;
			digested:=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;
			digested:=true;



		when others => changed:=false;

	end case;


end if; -- goodChar(ch)

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/";


	up2 : constant string := "../../";

	gfil: text_io.file_type;

	avail, digested, pending: boolean := false;
	nextChar: character;

	onextime: Time := clock;
	tick: duration := 0.01;


begin -- cann (main)


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



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


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

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



	infilname := pzldir & 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;



	selBlock:=1;
	changed:=true;
	Draw('x');


------------- event loop top ---------------------------------
	while not userexit loop

		erase:=false;
		changed:=false;
		avail:=false;

		loop

			nextChar:=' ';
			--get_immediate(nextChar, avail);
			get_immediate(nextChar);

			--if avail then
			if goodChar(nextChar) then
				handle_key_down(nextChar, pzldir, digested);
				--erase:=true; 2nov22
				changed:=true;
				exit;
			end if;

			-- this enables strict timing:
			--onextime:=onextime+tick;  delay until onextime;

		end loop;


		Draw(nextChar);

	end loop;
------------- event loop bottom ---------------------------------


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



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


	snd4ada.termSnds;


	if mswin then
		if rtime=0 then
			put_line("RealTime achieved");
		else
			put_line("RealTime NOT achieved");
		end if;
	end if;

	delay 1.0; --let user read msg




end cann;

