

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


-- Breadth First Search block slider puzzle solver that allows
-- L-shaped pieces to solve the Annoying16 (and Klotsky too).
-- The main upgrade here is to handle cells omitted from
-- a rectangular field of possible block positions.
-- Also upgraded to handle a goal of swapping 2 identically-shaped
-- blocks, which, algorithmically must be distinguish...
-- using a rather ingenious trick. (normally, identically shaped blocks 
-- are treated as though they are indistinguishable)
--
-- Note: tweaks were performed to allow this app to solve 
-- Klotski puzzles (*.blok), 
-- and TrafficRush puzzles (*.rush), too.
--
-- Uses a splaytree, to test whether a given config was seen before.  
-- Extremely fast access.
--
-- Uses a fullproof Key-type, for which we must define
-- operators "<" and ">".

-- Note that the location of the L-shaped pieces is defined
-- to be the location of the 1-X-1 corner piece center !!!

-- Clients are any of the Annoying-Sliders input files:
-- ad##.blk, where ## is 01..16
-- which must specify number & position of blanks,
-- as well as number & positions of all locations
-- omitted from a rectangular playing field.





with splaylist;
with text_io;

with ada.strings.fixed;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;

with ada.command_line;
with ada.calendar;





procedure bfsa is


	use Ada.Strings.Unbounded;
	use Ada.Strings.Unbounded.Text_IO;

	use text_io;


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


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


--------------- begin types for hashtable --------------------------

type ubyte is range 0..255; -- 2**8-1 (1-byte)
type ushort is range 0..65_535; -- 2**16-1 (2-bytes)
--type ulong is range 0..4_294_967_295; -- 2**32-1
type ulong is range 0 .. 2**36-1;



	type keytype is 
	record
		sum22, sum11, 
		sum12, sum21,
		sum13, sum31,
		sum91, sum92, 
		sum93, sum94 : ulong;
	end record;

	type hashrectype is
	record
		tchr : character;
		tsel : ubyte;
		prevkey : keytype;
	end record;



	function "<" (k1, k2: in keytype ) return boolean is
	begin

		if    k1.sum22 < k2.sum22 then return true;
		elsif k1.sum22 > k2.sum22 then return false;

		elsif k1.sum11 < k2.sum11 then return true;
		elsif k1.sum11 > k2.sum11 then return false;


		elsif k1.sum12 < k2.sum12 then return true;
		elsif k1.sum12 > k2.sum12 then return false;

		elsif k1.sum21 < k2.sum21 then return true;
		elsif k1.sum21 > k2.sum21 then return false;


		elsif k1.sum13 < k2.sum13 then return true;
		elsif k1.sum13 > k2.sum13 then return false;

		elsif k1.sum31 < k2.sum31 then return true;
		elsif k1.sum31 > k2.sum31 then return false;



		elsif k1.sum91 < k2.sum91 then return true;
		elsif k1.sum91 > k2.sum91 then return false;

		elsif k1.sum92 < k2.sum92 then return true;
		elsif k1.sum92 > k2.sum92 then return false;

		elsif k1.sum93 < k2.sum93 then return true;
		elsif k1.sum93 > k2.sum93 then return false;


		else return (k1.sum94<k2.sum94);

		end if;

	end "<";



	function ">" (k1, k2: in keytype ) return boolean is
	begin

		if    k1.sum22 > k2.sum22 then return true;
		elsif k1.sum22 < k2.sum22 then return false;

		elsif k1.sum11 > k2.sum11 then return true;
		elsif k1.sum11 < k2.sum11 then return false;


		elsif k1.sum12 > k2.sum12 then return true;
		elsif k1.sum12 < k2.sum12 then return false;

		elsif k1.sum21 > k2.sum21 then return true;
		elsif k1.sum21 < k2.sum21 then return false;


		elsif k1.sum13 > k2.sum13 then return true;
		elsif k1.sum13 < k2.sum13 then return false;

		elsif k1.sum31 > k2.sum31 then return true;
		elsif k1.sum31 < k2.sum31 then return false;



		elsif k1.sum91 > k2.sum91 then return true;
		elsif k1.sum91 < k2.sum91 then return false;

		elsif k1.sum92 > k2.sum92 then return true;
		elsif k1.sum92 < k2.sum92 then return false;

		elsif k1.sum93 > k2.sum93 then return true;
		elsif k1.sum93 < k2.sum93 then return false;

		else return (k1.sum94>k2.sum94);

		end if;

	end ">";


	package mysplay is new splaylist( keytype, hashrectype, "<", ">" );
	use mysplay;

	mytree : listtype;
	status : statustype; -- Ok, found, ...


--------------- end types for hashtable --------------------------



-- rush: 6row X 6col
-- sliders: 5rowX4col
-- dirty: 5row X 6col = largest

-- 1<=r<=6, 1<=c<=6
function endx(r,c : ushort) return ushort is -- returns 0..35
begin
	myassert( r<=6, 998, "r>6" );
	myassert( c<=6, 999, "c>6" );
	return  (r-1)*6 +(c-1);
end endx;



-- this ftn allows additive accumulation of up to
-- 36 encoded locations, always producing a unique
-- result for each set of locations in the sum.
-- They are essentially 36 binary T/F flags.
function bitrep( e: ushort ) return ulong is -- 0<=e<=35
	l: ulong := 2**natural(e);
begin
	return l;
end bitrep;










	goal3 : boolean :=false; --flags existence of 3rd block with same shape as 2 goals

	grow,gcol : array(1..2) of float; -- gblk=#goals = 1..2

	winner, trush  : boolean := false;


	mxblnk: constant integer := 16;
	blank : array(1..mxblnk) of integer; -- 2 to 16 blanks
	numblanks : integer; -- 2..16

	mxomit: constant integer := 5;
	omit : array(1..mxomit) of integer; -- 0 to 5 omissions
	nomit : integer; -- 0..5


	nrow,ncol,
	dblk, nblk, gblk : integer := 1;
	maxblk : constant integer := 16; -- # puz. pieces
	totblk : constant integer := maxblk+mxblnk+mxomit; -- max # blocks + blanks + omits

	rowcen0, colcen0,
	rowcen, colcen : array(1..totblk) of float;

	bshape : array(1..totblk) of integer;
	idchar : array(1..totblk) of character := (others=>' ');


	depth: integer := 0;

	infilname : unbounded_string;




trailmax: constant integer := 300; -- even klotski needs only 116 moves
ntrail : integer := 0;
trailsel : array(1..trailmax) of integer := (others=>0);
trailchr : array(1..trailmax) of character := (others=>'X');

trailenc31,
trailenc13,
trailenc91, --  needed for DD
trailenc92, 
trailenc93, 
trailenc94, --  needed for DD (91=UL-L, 94=LR-L)
trailenc22, trailenc12, trailenc21, 
	trailenc11 : array(1..trailmax) of ulong;


-- procedure to print out the solution path;
--
procedure dump is

	letters: array(1..maxblk) of character :=
		('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p');

	fout: text_io.file_type;


begin

	text_io.create( fout, out_file, "lpath.txt" );


		new_line;
		put_line(" writing solution to file:  lpath.txt");
		new_line;

		new_line(fout);
		put_line(fout,"Nonblank blocks are lettered sequentially");
		put_line(fout,"according to their order in the puzzle file.");
		put_line(fout,"Thus, each move is described by a block ID");
		put_line(fout,"followed by the move direction {u,d,l,r}:");
		new_line(fout);

		put_line(fout, to_string(infilname) );
		new_line(fout);

		put_line(fout,"Solution path with #steps="
					&integer'image(ntrail)&" :");
		new_line(fout);
		new_line(fout);


	put(fout, integer'image(ntrail) );
	put(fout, "  "&infilname);
	new_line(fout);

	for i in 1..ntrail loop
		put(fout, letters(trailsel(i)) &"-"& trailchr(i)&"  " );
		if 0=(i mod 10) then new_line(fout); end if;
	end loop;
	text_io.close(fout);

end dump;



function rush_shape( k: integer ) return boolean is
begin
	if k=12 or k=13 or k=21 or k=31 then
		return true;
	else
		return false;
	end if;
end;

procedure init( fname: string ) is
	fin : text_io.file_type;
	len : natural := 1;
	rcd : string(1..99);

	goalshaped: integer := 0; --counts # pieces with goal shape

	anoyfile: constant boolean :=
		ada.strings.fixed.head
			(fname,2)="ad"; -- AnnoyingSliders file

	blokfile: constant boolean :=
		ada.strings.fixed.tail
			(fname,4)="blok"; -- bslider puzzle file extension

	rushfile: constant boolean :=
		ada.strings.fixed.tail
			(fname,4)="rush"; -- TrafficRush puzzle file extension

begin

	if rushfile then trush:=true; else trush:=false; end if;

	--note that trush puzzles are here assumed to use
	--shapes 12, 21, 13, 31 only.

--	if rushfile then
--		myassert( false, 0, "bfsa cannot solve traffic rush puzzles.");
--	end if;

	text_io.open(fin, in_file, fname);

	text_io.get_line(fin, rcd, len); -- objective-text (ignore)

	myint_io.get(fin, nrow); --
	myint_io.get(fin, ncol); --
	myint_io.get(fin, dblk); --#nonBlank objects
	myint_io.get(fin, gblk); --#goal positions (1 or 2)

myassert( gblk > 0, 1, "gblk too small" );
myassert( gblk < 3, 2, "gblk too big" );

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

	for i in 1..dblk loop -- define puzzle blocks
		myint_io.get(fin, bshape(i));
		if bshape(i)=bshape(1) then goalshaped:=goalshaped+1; end if;
		myfloat_io.get(fin, rowcen(i));
		myfloat_io.get(fin, colcen(i));
		text_io.get_line(fin, rcd, len); -- color (ignore)
		idchar(i):=character'val(96+i); --a=97...z=122
		rowcen0(i):=rowcen(i);
		colcen0(i):=colcen(i);
		if trush then
			myassert( rush_shape(bshape(i)) , 3, "wrong shape for Trush");
		end if;
	end loop;
	if goalshaped>2 and gblk>1 then
		goal3:=true; -- need extra discriminator
	end if;

	if blokfile then -- indicates "bslider" puzzle format
		numblanks:=2;
	elsif rushfile then
		myint_io.get(fin, numblanks);
	else -- dirty12 or annoy puzzle format
		myint_io.get(fin, numblanks);
	end if;
	myassert( numblanks>=2, 3, "wrong #blanks");
	myassert( numblanks<=mxblnk, 3, "wrong #blanks");
	--note:  want this to work for MaBoy too (4 blanks)
	nblk := dblk+numblanks;

	for i in dblk+1..nblk loop -- define blank 1x1 cells
		myint_io.get(fin, bshape(i));
		myfloat_io.get(fin, rowcen(i));
		myfloat_io.get(fin, colcen(i));
		text_io.get_line(fin, rcd, len); -- color (ignore)
		--idchar(i):=character'val(96+i); --a=97...z=122
		rowcen0(i):=rowcen(i);
		colcen0(i):=colcen(i);
		myassert( bshape(i) = 11, 4, "blank shape not 11" );
	end loop;

	--if not blokfile and not rushfile then --allow omissions (annoy format)
	if anoyfile then

		myint_io.get(fin, nomit);

		for i in nblk+1..nblk+nomit loop -- define cells omitted from rectangular field
			myint_io.get(fin, bshape(i));
			myfloat_io.get(fin, rowcen(i));
			myfloat_io.get(fin, colcen(i));
			text_io.get_line(fin, rcd, len); -- color (ignore)
			rowcen0(i):=rowcen(i);
			colcen0(i):=colcen(i);
			myassert( bshape(i) = 11, 5, "omit shape not 11" );
		end loop;

		for j in 1..nomit loop
			omit(j):=nblk+j;
		end loop;

	else
		nomit:=0;
	end if;


	text_io.close(fin);

	for j in 1..numblanks loop
		blank(j):=dblk+j;
	end loop;


	ntrail:=0;
	winner:=false;

--	put(" ok @ init"); new_line;
--	put("nrow="); put(integer'image(nrow));
--	put(" ncol="); put(integer'image(ncol));
--	put(" dblk="); put(integer'image(dblk));
--	put(" gblk="); put(integer'image(gblk));
--	put(" numblanks="); put(integer'image(numblanks));
--	put(" nomit="); put(integer'image(nomit));
--	new_line;

--	for j in 1..nomit loop
--		put( integer'image( omit(j) ) ); put(" ");
--		put( float'image( rowcen(nblk+j) ) ); put(" ");
--		put( float'image( colcen(nblk+j) ) ); put(" ");
--		new_line;
--	end loop;

-- all is Ok here


end init;




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



procedure test4winner is
	epsilon: constant float := 0.1;
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;

	if winner then
		dump;
	end if;


end test4winner;









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

function valid( f1, f2, f3 : integer;  dr1,dc1, dr2,dc2, dr3,dc3 : float ) 
				return boolean is
	ok: boolean := true;
	nubr1,nubc1,nubr2,nubc2, nubr3,nubc3: float;
begin
	nubr1:=rowcen(f1)+dr1;
	nubc1:=colcen(f1)+dc1;
	nubr2:=rowcen(f2)+dr2;
	nubc2:=colcen(f2)+dc2;
	nubr3:=rowcen(f3)+dr3;
	nubc3:=colcen(f3)+dc3;
	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;
		if same(nubr3,rowcen(nblk+j)) and same(nubc3,colcen(nblk+j)) then ok:=false; end if;
	end loop;
	return ok;
end;



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( selBlock: integer; track: boolean ) return integer is

	ok: boolean := false;
	ret: integer := 0;
	found1, found2, found3 : integer := -1;

	s13,s31,s91,s92,s93,s94,
	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

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

	br, bc : array(1..mxblnk) of float;

begin

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





--moveLEFT
	if( shape=91 ) then -- UL-L

		for j in 1..numblanks 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>=1 and found2>=1 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 -- UR-L

		for j in 1..numblanks 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>=1 and found2>=1 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 -- LL-L

		for j in 1..numblanks 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>=1 and found2>=1 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 -- LR-L

		for j in 1..numblanks 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>=1 and found2>=1 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..numblanks 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>=1 and found2>=1 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 ) and not trush then


		for j in 1..numblanks 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>=1 and found2>=1 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..numblanks loop

			if same(br(j),sr) and same(bc(j),sc-1.5) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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=31 ) and not trush then


		for j in 1..numblanks 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-0.0) and same(bc(j),sc-1.0) then
				found2:=blank(j);
			end if;

			if same(br(j),sr+1.0) and same(bc(j),sc-1.0) then
				found3:=blank(j);
			end if;

		end loop;

		if found1>=1 and found2>=1 and found3>=1 then
			ok := valid(found1,found2,found3, 0.0, 1.0, 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;
			colcen(found3) := colcen(found3) + 1.0;
			ret:=1;
			end if;
		end if;





	elsif( shape=13 ) then

		for j in 1..numblanks loop

			if same(br(j),sr) and same(bc(j),sc-2.0) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 then
			ok := valid(found1, 0.0, 3.0);
			if ok then
			colcen(selBlock) := colcen(selBlock) - 1.0;
			colcen(found1) := colcen(found1) + 3.0;
			ret:=1;
			end if;
		end if;



	elsif( shape=11 ) then


		for j in 1..numblanks loop

			if same(br(j),sr) and same(bc(j),sc-1.0) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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;  -- all shapes



	if track and ret>0 then

		s11:=0; s12:=0; s21:=0; s22:=0; s13:=0; s31:=0;
		s91:=0; s92:=0; s93:=0; s94:=0; s22:=0;

		for j in 1..dblk loop
			case bshape(j) is

				when 12 => -- 1 row, 2 cols
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j) ) );

--note: typically, one does not distinguish between identically shaped blocks,
--but here we must, whenever the given shape can be a goal shape,
--and the goal is to swap 2 identicaly shaped blocks. These 2 must be
--distinguished from each other, and from all others.

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s12 := s12 + bitrep( endx(r,c) );

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s21 := s21 + bitrep( endx(r,c) );

				when 13 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)-0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s13 := s13 + bitrep( endx(r,c) );

				when 31 =>
					r := ushort( float'rounding( rowcen(j)-0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s31 := s31 + bitrep( endx(r,c) );



				when 91 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s91 := s91 + bitrep( endx(r,c) );

				when 92 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s92 := s92 + bitrep( endx(r,c) );

				when 93 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s93 := s93 + bitrep( endx(r,c) );

				when 94 => -- LR-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s94 := s94 + bitrep( endx(r,c) );

				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s22 := s22 + bitrep( endx(r,c) );


				when 11 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s11 := s11 + bitrep( endx(r,c) );

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

		ntrail:=ntrail+1;
		trailenc91(ntrail):=s91;
		trailenc92(ntrail):=s92;
		trailenc93(ntrail):=s93;
		trailenc94(ntrail):=s94;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc11(ntrail):=s11;
		trailenc13(ntrail):=s13;
		trailenc31(ntrail):=s31;
		trailsel(ntrail):=selblock;
		trailchr(ntrail):='l';

	end if;


	return ret;

end moveleft;







function moveright( selBlock: integer; track: boolean ) return integer is

	ok: boolean := false;
	ret: integer := 0;
	found1, found2, found3 : integer := -1;

	s13,s31,s91,s92,s93,s94,
	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

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

	br, bc : array(1..mxblnk) of float;

begin

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





--moveRight
	if( shape=91 ) then -- UL-L

		for j in 1..numblanks 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>=1 and found2>=1 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 -- UR-L


		for j in 1..numblanks 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>=1 and found2>=1 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 -- LL-L


		for j in 1..numblanks 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>=1 and found2>=1 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 -- LR-L


		for j in 1..numblanks 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>=1 and found2>=1 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..numblanks 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>=1 and found2>=1 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 )  and not trush then


		for j in 1..numblanks 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>=1 and found2>=1 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..numblanks loop

			if same(br(j),sr) and same(bc(j),sc+1.5) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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=31 ) and not trush then


		for j in 1..numblanks 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-0.0) and same(bc(j),sc+1.0) then
				found2:=blank(j);
			end if;

			if same(br(j),sr+1.0) and same(bc(j),sc+1.0) then
				found3:=blank(j);
			end if;

		end loop;

		if found1>=1 and found2>=1 and found3>=1 then
			ok := valid(found1,found2,found3, 0.0,-1.0, 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;
			colcen(found3) := colcen(found3) - 1.0;
			ret:=1;
			end if;
		end if;





	elsif( shape=13 ) then


		for j in 1..numblanks loop

			if same(br(j),sr) and same(bc(j),sc+2.0) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 then
			ok := valid(found1, 0.0,-3.0);
			if ok then
			colcen(selBlock) := colcen(selBlock) + 1.0;
			colcen(found1) := colcen(found1) - 3.0;
			ret:=1;
			end if;
		end if;



	elsif( shape=11 ) then


		for j in 1..numblanks loop

			if same(br(j),sr) and same(bc(j),sc+1.0) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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;  -- all shapes



	if track and ret>0 then

		s11:=0; s12:=0; s21:=0; s22:=0; s13:=0; s31:=0;
		s91:=0; s92:=0; s93:=0; s94:=0; s22:=0;

		for j in 1..dblk loop
			case bshape(j) is

				when 12 => -- 1 row, 2 cols
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s12 := s12 + bitrep( endx(r,c) );

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s21 := s21 + bitrep( endx(r,c) );

				when 13 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)-0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s13 := s13 + bitrep( endx(r,c) );

				when 31 =>
					r := ushort( float'rounding( rowcen(j)-0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s31 := s31 + bitrep( endx(r,c) );



				when 91 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s91 := s91 + bitrep( endx(r,c) );

				when 92 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s92 := s92 + bitrep( endx(r,c) );

				when 93 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s93 := s93 + bitrep( endx(r,c) );

				when 94 => -- LR-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s94 := s94 + bitrep( endx(r,c) );

				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 large goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s22 := s22 + bitrep( endx(r,c) );


				when 11 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s11 := s11 + bitrep( endx(r,c) );

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


		ntrail:=ntrail+1;
		trailenc91(ntrail):=s91;
		trailenc92(ntrail):=s92;
		trailenc93(ntrail):=s93;
		trailenc94(ntrail):=s94;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc13(ntrail):=s13;
		trailenc31(ntrail):=s31;
		trailenc11(ntrail):=s11;
		trailsel(ntrail):=selblock;
		trailchr(ntrail):='r';

	end if;




	return ret;


end moveright;








function moveup( selBlock: integer; track: boolean ) return integer is

	ok: boolean := false;
	ret: integer := 0;
	found1, found2, found3 : integer := -1;

	s13,s31,s91,s92,s93,s94,
	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

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

	br, bc : array(1..mxblnk) of float;

begin

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





--moveUp
	if( shape=91 ) then -- UL-L

		for j in 1..numblanks 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>=1 and found2>=1 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-L


		for j in 1..numblanks 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>=1 and found2>=1 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-L


		for j in 1..numblanks 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>=1 and found2>=1 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-L


		for j in 1..numblanks 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>=1 and found2>=1 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..numblanks 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>=1 and found2>=1 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=12 ) and not trush then

		for j in 1..numblanks 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>=1 and found2>=1 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=21 ) then


		for j in 1..numblanks loop

			if same(br(j),sr-1.5) and same(bc(j),sc) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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=13 ) and not trush then


		for j in 1..numblanks 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+0.0) then
				found2:=blank(j);
			end if;

			if same(br(j),sr-1.0) and same(bc(j),sc+1.0) then
				found3:=blank(j);
			end if;

		end loop;

		if found1>=1 and found2>=1 and found3>=1 then
			ok := valid(found1,found2,found3, 1.0, 0.0, 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;
			rowcen(found3) := rowcen(found3) + 1.0;
			ret:=1;
			end if;
		end if;





	elsif( shape=31 ) then


		for j in 1..numblanks loop

			if same(br(j),sr-2.0) and same(bc(j),sc) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 then
			ok := valid(found1, 3.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock) - 1.0;
			rowcen(found1) := rowcen(found1) + 3.0;
			ret:=1;
			end if;
		end if;



	elsif( shape=11 ) then


		for j in 1..numblanks loop

			if same(br(j),sr-1.0) and same(bc(j),sc) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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;  -- all shapes



	if track and ret>0 then

		s11:=0; s12:=0; s21:=0; s22:=0; s13:=0; s31:=0;
		s91:=0; s92:=0; s93:=0; s94:=0; s22:=0;

		for j in 1..dblk loop
			case bshape(j) is

				when 12 => -- 1 row, 2 cols
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s12 := s12 + bitrep( endx(r,c) );

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s21 := s21 + bitrep( endx(r,c) );

				when 13 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)-0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s13 := s13 + bitrep( endx(r,c) );

				when 31 =>
					r := ushort( float'rounding( rowcen(j)-0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s31 := s31 + bitrep( endx(r,c) );



				when 91 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s91 := s91 + bitrep( endx(r,c) );

				when 92 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s92 := s92 + bitrep( endx(r,c) );

				when 93 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s93 := s93 + bitrep( endx(r,c) );

				when 94 => -- LR-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s94 := s94 + bitrep( endx(r,c) );

				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 large goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s22 := s22 + bitrep( endx(r,c) );


				when 11 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s11 := s11 + bitrep( endx(r,c) );

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


		ntrail:=ntrail+1;
		trailenc91(ntrail):=s91;
		trailenc92(ntrail):=s92;
		trailenc93(ntrail):=s93;
		trailenc94(ntrail):=s94;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc13(ntrail):=s13;
		trailenc31(ntrail):=s31;
		trailenc11(ntrail):=s11;
		trailsel(ntrail):=selblock;

		trailchr(ntrail):='u';

	end if;



	return ret;

end moveup;






function movedown( selBlock: integer; track: boolean ) return integer is


	ok: boolean := false;
	ret: integer := 0;
	found1, found2, found3 : integer := -1;

	s13,s31,s91,s92,s93,s94,
	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

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

	br, bc : array(1..mxblnk) of float;

begin

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





--moveDown
	if( shape=91 ) then -- UL-L

		for j in 1..numblanks 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>=1 and found2>=1 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-L


		for j in 1..numblanks 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>=1 and found2>=1 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-L


		for j in 1..numblanks 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>=1 and found2>=1 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-L


		for j in 1..numblanks 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>=1 and found2>=1 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..numblanks 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>=1 and found2>=1 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=12 ) and not trush then

		for j in 1..numblanks 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>=1 and found2>=1 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=21 ) then


		for j in 1..numblanks loop

			if same(br(j),sr+1.5) and same(bc(j),sc) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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=13 )  and not trush then


		for j in 1..numblanks 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+0.0) then
				found2:=blank(j);
			end if;

			if same(br(j),sr+1.0) and same(bc(j),sc+1.0) then
				found3:=blank(j);
			end if;

		end loop;

		if found1>=1 and found2>=1 and found3>=1 then
			ok := valid(found1,found2,found3, -1.0,0.0, -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;
			rowcen(found3) := rowcen(found3) - 1.0;
			ret:=1;
			end if;
		end if;





	elsif( shape=31 ) then


		for j in 1..numblanks loop

			if same(br(j),sr+2.0) and same(bc(j),sc) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 then
			ok := valid(found1,-3.0, 0.0);
			if ok then
			rowcen(selBlock) := rowcen(selBlock) + 1.0;
			rowcen(found1) := rowcen(found1) - 3.0;
			ret:=1;
			end if;
		end if;



	elsif( shape=11 ) then


		for j in 1..numblanks loop

			if same(br(j),sr+1.0) and same(bc(j),sc) then
				found1:=blank(j);
			end if;

		end loop;

		if found1>=1 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;  -- all shapes



	if track and ret>0 then

		s11:=0; s12:=0; s21:=0; s22:=0; s13:=0; s31:=0;
		s91:=0; s92:=0; s93:=0; s94:=0; s22:=0;

		for j in 1..dblk loop
			case bshape(j) is

				when 12 => -- 1 row, 2 cols
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s12 := s12 + bitrep( endx(r,c) );

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s21 := s21 + bitrep( endx(r,c) );

				when 13 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)-0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s13 := s13 + bitrep( endx(r,c) );

				when 31 =>
					r := ushort( float'rounding( rowcen(j)-0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if not trush then
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal
					end if;

					s31 := s31 + bitrep( endx(r,c) );



				when 91 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s91 := s91 + bitrep( endx(r,c) );

				when 92 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s92 := s92 + bitrep( endx(r,c) );

				when 93 => -- UL-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s93 := s93 + bitrep( endx(r,c) );

				when 94 => -- LR-L
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );

					-- strategy to distinguish between 2 goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s94 := s94 + bitrep( endx(r,c) );

				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );

					-- strategy to distinguish between 2 large goal blocks:
					if j=1 then c:=c+1; end if; --goal
					if goal3 and j=2 then c:=c+2; end if; --goal

					s22 := s22 + bitrep( endx(r,c) );


				when 11 =>
					r := ushort( float'rounding( rowcen(j)+0.5 ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s11 := s11 + bitrep( endx(r,c) );

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


		ntrail:=ntrail+1;
		trailenc91(ntrail):=s91;
		trailenc92(ntrail):=s92;
		trailenc93(ntrail):=s93;
		trailenc94(ntrail):=s94;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc13(ntrail):=s13;
		trailenc31(ntrail):=s31;
		trailenc11(ntrail):=s11;
		trailsel(ntrail):=selblock;

		trailchr(ntrail):='d';

	end if;


	return ret;


end movedown;










procedure undo is
 res, selBlock: integer;
 chr: character;
begin

	if ntrail>0 then

 		chr := trailchr(ntrail);
		selBlock := trailsel(ntrail);
		ntrail := ntrail-1;

		case chr is
			when 'd' =>
				res := moveup(selBlock,false);
				myassert(res>0,11,"undo 1");

			when 'u' =>
				res := movedown(selBlock,false);
				myassert(res>0,12, "undo 2");

			when 'r' =>
				res := moveleft(selBlock,false);
				myassert(res>0,13, "undo 3");

			when 'l' =>
				res := moveright(selBlock,false);
				myassert(res>0,14, "undo 4");

			when others => null;
		end case;


	end if;

end undo;



















procedure addifnew( okey: keytype ) is
	rec : hashrectype;
	nt: constant integer := ntrail;
	key : keytype := --careful, order critical
		(  trailenc22(nt), trailenc11(nt), 
			trailenc12(nt), trailenc21(nt), 
			trailenc13(nt), trailenc31(nt),
			trailenc91(nt), trailenc92(nt),
			trailenc93(nt), trailenc94(nt)
		);
begin

	mysplay.search( key, mytree, rec, status );

	-- if found, we have reached this config earlier, so ignore

	if status=notfound then

		rec.prevkey := okey;
		rec.tsel := ubyte(trailsel(nt));
		rec.tchr := trailchr(nt);

		-- insert to tail of list:
		mysplay.addnode( key, rec, mytree, status );
		myassert( status=ok, 15, "addnode error" );

		test4winner;

	end if; -- not seen

end addifnew;






-- recursive ftn to load trail* from pointers
function getrail( pkey: keytype ) return integer is
	k: integer := 0;
	rec : hashrectype;
begin

	mysplay.search( pkey, mytree, rec, status );

	if status=notfound then
		return 0;

	--elsif rec.tchr = 's' or rec.tsel=0 then
	elsif rec.tchr = 's'  then
		return 0;

	else

		k := getrail( rec.prevKey );
		myassert(k>=0,16, "getrail error");

		k := k+1;
		trailchr(k) := rec.tchr;
		trailsel(k) := integer(rec.tsel);

	end if;

	return k;

end getrail;




procedure restore( okey: keytype ) is
 res, selblock : integer;
 chr : character;
begin

	-- restore original block positions:
	for i in 1..nblk loop
		rowcen(i):=rowcen0(i);
		colcen(i):=colcen0(i);
	end loop;

-- now, restore block configuration

	ntrail:=getrail(okey);
	for i in 1..ntrail loop
		selblock := trailsel(i);
		chr := trailchr(i);
		case chr is
			when 'u' =>
				res := moveup(selblock,false);
				myassert(res>0,101,"restore 1");

			when 'd' =>
				res := movedown(selblock,false);
				myassert(res>0,102,"restore 2");

			when 'l' =>
				res := moveleft(selblock,false);
				myassert(res>0,103,"restore 3");

			when 'r' =>
				res := moveright(selblock,false);
				myassert(res>0,104,"restore 4");

			when others => 
				null;
				put_line("ERROR in restore...bad trailchr");
				myassert(false);
		end case;
	end loop;
end restore;







procedure checkForUserFile( ok: out boolean ) is

begin

	ok:=false;

	-- here we should process single cmdline arg:  infilname
   if Ada.Command_Line.Argument_Count =1 then
   
     declare
       fstr : string := Ada.Command_Line.Argument(1);--File
     begin
       infilname := to_unbounded_string(fstr);
		 ok:=true;
     end; --declare

	else

		put_line("One parameter is expected:");
		put_line("1) filename,");
		myassert(false);
 
   end if;

end checkForUserFile;





procedure trymove is
	newstop, oldstop: integer := 0;
	okey: keytype;
	orec: hashrectype;
	res: integer;
begin --trymove


	newstop:=0;

	while (depth<500) and (not winner) loop

		depth:=depth+1;

		oldstop:=newstop;
		newstop:=mysplay.length(mytree);

		--exit when oldstop=newstop;
		if oldstop=newstop then
			put("exit outer...old=new"); new_line;
			exit;
		end if;



		for it in 1 .. newstop-oldstop loop

			exit when winner;

			if depth=1 and it=1 then
				mysplay.head( mytree, status ); --put iterator @ list-head
				myassert( status=Ok, 111, "head error" );
			else
				mysplay.next( mytree, status ); --move iterator to next
				myassert( status=Ok, 112, "next error" );
			end if;

			-- get data @ iterator's current position:
			mysplay.data( mytree, okey, orec, status ); --get okey, orec
				myassert( status=Ok, 113, "splay.data error" );

			restore(okey);


			for ii in 1..dblk loop

				res := moveup(ii,true);
				if res>0 then
					addifnew(okey);
					exit when winner;
					undo;
				end if;

				res := movedown(ii,true);
				if res>0 then
					addifnew(okey);
					exit when winner;
					undo;
				end if;

				res := moveright(ii,true);
				if res>0 then
					addifnew(okey);
					exit when winner;
					undo;
				end if;

				res := moveleft(ii,true);
				if res>0 then
					addifnew(okey);
					exit when winner;
					undo;
				end if;

			end loop;


			exit when winner;



		end loop; --it::944

		exit when winner;

	end loop; -- while::940



end trymove;



	myok: boolean;
	key0 : keytype := (0,0,0,0,0,0,0,0,0,0);
	rec0 : hashrectype;
	len: integer;

begin -- bfsa

	checkForUserFile(myok);
	-- defines:  infilname


	if myok then

		init( to_string(infilname) ); -- read puzzle file

		rec0.prevKey := key0; --points to itself
		rec0.tsel := 0;
		rec0.tchr := 's';

		mysplay.addnode( key0, rec0, mytree, status );
		myassert( status=ok, 114, "bfsa addnode error" );

		trymove;

		if winner then
			put_line(" Solution Found!");
		else
			put_line("Failure to find solution.");
			myassert(false, 119, "soln NOT found error");
		end if;
		-- solution in "lpath.txt"


		len := mysplay.length( mytree );
		put(integer'image(len)); put(" leaves still in splaylist"); new_line;
		put(integer'image(depth)); put(" depth"); new_line;


	end if;

end bfsa; --proc

