

--
-- Copyright (C) 2019  <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...
-- a brute-force solver for *.blok
--
-- 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 ">".









with splaylist;
with text_io;

with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;

with ada.command_line;
with ada.calendar;


package body fbfs is


procedure bfs (
	infilname: unbounded_string;
	solutionPath : out unbounded_string
) 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 (big enough here)




	type keytype is 
	record
		sum11, sum12, sum21, sum22 : 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.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;

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

		end if;
	end "<";

	function ">" (k1, k2: in keytype ) return boolean is
	begin
		if    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;

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

		end if;
	end ">";

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

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


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






-- puzzles mostly 5x4 but one 6x4 = 6rows 4cols
-- 1<=r<=6, 1<=c<=4
function endx(r,c : ushort) return ushort is -- returns 1..31
begin
	--myassert( r>0, 10101 );
	--myassert( c>0, 10201 );
	--myassert( r<=6 );
	--myassert( c<=4 );
	return  (r-1)*4 +(c-1) +1;
end endx;









-- here, ulong=4-bytes, so insure e<32
function bitrep( e: ushort ) return ulong is -- 1<=e<=31
	l: ulong := 2;
begin
	for i in 2..e loop
		l:=l*2;
	end loop;
	return l;
end bitrep;











	grow,gcol : array(1..2) of float;

	winner  : boolean := false;

	nrow,ncol,
	dblk, nblk, gblk : integer;
	maxblk : constant integer := 15;

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

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

	blank1, blank2: integer;

	depth: integer := 0;





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

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

begin

	set_unbounded_string(solutionPath, "");
	for i in 1..ntrail loop
		append(solutionPath,
			letters(trailsel(i)) &"-"& trailchr(i)
		);
	end loop;

end dump;




procedure test4winner is
	canwin: boolean := true;
begin

if not winner then -- never overwrite first[shortest] one

	for g in 1..gblk loop
	 canwin := canwin and 
	 	( abs(rowcen(g)-grow(g))<0.1 ) and
	 	( abs(colcen(g)-gcol(g))<0.1 );
	end loop;

	if canwin then
		winner:=true;
		dump;
	end if;

end if;
end test4winner;



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

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

	myint_io.get(fin, nrow); --5
	myint_io.get(fin, ncol); --4
	myint_io.get(fin, dblk); --11
	myint_io.get(fin, gblk); --1

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

	nblk:=dblk+2; --13

myassert( nblk <= maxblk, 3, "nblk too big");

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

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

	text_io.close(fin);

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

	ntrail:=0;
	winner:=false;

end init;







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

	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

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

begin

	if( shape=22 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc+1.5)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank1) := bc1+2.0;
			colcen(blank2) := bc2+2.0;
		end if;

	elsif( shape=21 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc+1.0)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank1) := bc1+1.0;
			colcen(blank2) := bc2+1.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(br1-sr) < 0.1
				and
			abs(bc1-sc+1.5)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank1) := bc1+2.0;
		elsif
			abs(br2-sr) < 0.1
				and
			abs(bc2-sc+1.5)<0.1
		then
			colcen(selBlock) := sc-1.0;
			colcen(blank2) := bc2+2.0;
		end if;



	elsif( shape=11 ) then

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


	end if;



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


	if track and ret>0 then
		s11:=0; s12:=0; s21:=0; s22:=0;
		for j in 1..dblk loop
			case bshape(j) is
				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );
					--s22 := s22 + bitrep( endx(r,c) );

					--strategy to handle swapping 2 large blocks
					if j=1 then s22 := s22 + bitrep( endx(r,c) );
					else        s22 := s22 + bitrep( endx(r+1,c) );
					end if;

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

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s21 := s21 + 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;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc11(ntrail):=s11;
		trailsel(ntrail):=selblock;
		trailchr(ntrail):='l';

	end if;


	return ret;

end moveleft;










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

	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

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

begin


	if( shape=22 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc-1.5)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank1) := bc1-2.0;
			colcen(blank2) := bc2-2.0;
		end if;

	elsif( shape=21 ) then

		if
			abs(br1-br2) < 1.1
				and
			abs( (br1+br2)/2.0 - sr ) < 0.1
				and
			abs(bc1-bc2)<0.1
				and
			abs(bc1-sc-1.0)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank1) := bc1-1.0;
			colcen(blank2) := bc2-1.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(br1-sr) < 0.1
				and
			abs(bc1-sc-1.5)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank1) := bc1-2.0;
		elsif
			abs(br2-sr) < 0.1
				and
			abs(bc2-sc-1.5)<0.1
		then
			colcen(selBlock) := sc+1.0;
			colcen(blank2) := bc2-2.0;
		end if;



	elsif( shape=11 ) then

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


	end if;



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


	if track and ret>0 then
		s11:=0; s12:=0; s21:=0; s22:=0;
		for j in 1..dblk loop
			case bshape(j) is
				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );
					--s22 := s22 + bitrep( endx(r,c) );

					--strategy to handle swapping 2 large blocks
					if j=1 then s22 := s22 + bitrep( endx(r,c) );
					else        s22 := s22 + bitrep( endx(r+1,c) );
					end if;

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

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s21 := s21 + 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;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc11(ntrail):=s11;
		trailsel(ntrail):=selblock;
		trailchr(ntrail):='r';

	end if;




	return ret;


end moveright;








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

	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

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

begin

	if( shape=22 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr+1.5)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank1) := br1+2.0;
			rowcen(blank2) := br2+2.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr+1.0)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank1) := br1+1.0;
			rowcen(blank2) := br2+1.0;
		end if;


	elsif( shape=21 ) then

		if
			abs(bc1-sc)<0.1
				and
			abs(br1-sr+1.5)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank1) := br1+2.0;
		elsif
			abs(bc2-sc)<0.1
				and
			abs(br2-sr+1.5)<0.1
		then
			rowcen(selBlock) := sr-1.0;
			rowcen(blank2) := br2+2.0;
		end if;



	elsif( shape=11 ) then

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


	end if;


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


	if track and ret>0 then
		s11:=0; s12:=0; s21:=0; s22:=0;
		for j in 1..dblk loop
			case bshape(j) is
				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );
					--s22 := s22 + bitrep( endx(r,c) );

					--strategy to handle swapping 2 large blocks
					if j=1 then s22 := s22 + bitrep( endx(r,c) );
					else        s22 := s22 + bitrep( endx(r+1,c) );
					end if;

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

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s21 := s21 + 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;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		trailenc11(ntrail):=s11;
		trailsel(ntrail):=selblock;
		trailchr(ntrail):='u';

	end if;



	return ret;

end moveup;






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

	s11,s12,s21,s22: ulong := 0;
	r,c : ushort;

	ret: integer := 0;

	obr1,br1: float := rowcen(blank1);
	obc1,bc1: float := colcen(blank1);

	obr2,br2: float := rowcen(blank2);
	obc2,bc2: float := colcen(blank2);

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

begin

	if( shape=22 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr-1.5)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank1) := br1-2.0;
			rowcen(blank2) := br2-2.0;
		end if;

	elsif( shape=12 ) then

		if
			abs(bc1-bc2)<1.1
				and
			abs( (bc1+bc2)/2.0 - sc )<0.1
				and
			abs(br1-br2)<0.1
				and
			abs(br1-sr-1.0)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank1) := br1-1.0;
			rowcen(blank2) := br2-1.0;
		end if;


	elsif( shape=21 ) then

		if
			abs(bc1-sc)<0.1
				and
			abs(br1-sr-1.5)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank1) := br1-2.0;
		elsif
			abs(bc2-sc)<0.1
				and
			abs(br2-sr-1.5)<0.1
		then
			rowcen(selBlock) := sr+1.0;
			rowcen(blank2) := br2-2.0;
		end if;



	elsif( shape=11 ) then

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


	end if;


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


	if track and ret>0 then
		s11:=0; s12:=0; s21:=0; s22:=0;
		for j in 1..dblk loop
			case bshape(j) is
				when 22 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j) ) );
					--s22 := s22 + bitrep( endx(r,c) );

					--strategy to handle swapping 2 large blocks
					if j=1 then s22 := s22 + bitrep( endx(r,c) );
					else        s22 := s22 + bitrep( endx(r+1,c) );
					end if;

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

				when 21 =>
					r := ushort( float'rounding( rowcen(j) ) );
					c := ushort( float'rounding( colcen(j)+0.5 ) );
					s21 := s21 + 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;
		trailenc22(ntrail):=s22;
		trailenc12(ntrail):=s12;
		trailenc21(ntrail):=s21;
		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 := 
		( trailenc11(nt), trailenc12(nt), 
			trailenc21(nt), trailenc22(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);

		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 database
function getrail( pkey: keytype ) return integer is
	k: integer := 0;
	rec : hashrectype;
begin

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

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

	elsif status=notfound 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 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;



		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);
					undo;
				end if;

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

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

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

			end loop;


			exit when winner;



		end loop; --it::944

		exit when winner;

	end loop; -- while::940



end trymove;


	key0 : keytype := (0,0,0,0);
	rec0 : hashrectype;
begin -- bfs


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

	rec0.prevKey := key0;
	rec0.tsel := 0;
	rec0.tchr := 's';

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


	trymove;

end bfs; --proc

end fbfs; --package
