
with splaylist;
with text_io;

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

with ada.command_line;
with ada.calendar;
with text_io;


package body emutils is


	use text_io;


	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;















-- r<=maxrows=20,  c<=maxcols=25
-- (r,c) is 1-based;  indx in [1..maxsize=20*25=500]
function indx(r,c : ushort) return ushort is
begin
	return  (r-1)*maxcols +(c-1) +1; -- 1..500
end indx;

-- example usage of this configuration-key generation system:
--
-- bitrep(nb, e, suma, sumb, sumc );  nb<=24, e<=255
--
-- where e(1..nb) = ee( indx(ri,ci) ), nb<=24, EE<256
--
-- then  key : keytype := (suma,sumb,sumc,pulkey);
--
-- where pulkey, calculated in dpcorral, represents
-- the upperleft cell of the corral containing puller
--















--NOT necessary:
function "="(k1,k2: in keytype) return boolean is
begin
	return 
		k1.suma=k2.suma and 
		k1.sumb=k2.sumb and 
		k1.sumc=k2.sumc and 
		k1.pulkey=k2.pulkey;
end "=";


	function "<" (k1, k2: in keytype ) return boolean is
	begin
		if    k1.suma < k2.suma then return true;
		elsif k1.suma > k2.suma then return false;

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

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

		else return (k1.pulkey < k2.pulkey);
		end if;
	end "<";

	function ">" (k1, k2: in keytype ) return boolean is
	begin
		if    k1.suma > k2.suma then return true;
		elsif k1.suma < k2.suma then return false;

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

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

		else return (k1.pulkey > k2.pulkey);
		end if;
	end ">";



















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

--////////////////////// bx.cc::553 ////////////////////////////




kbest, kmax, bestcfg : integer := 0;

function psetwinkey( wpkey: ubyte ) return keytype is
	k,ii:ushort:=0;
	eloc : etype;
	key : keytype;
	xee : ushort;
begin
	win_suma:=0;
	win_sumb:=0;
	win_sumc:=0;

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		if ff(ii)=2 then -- goal position = box receptacle
			xee := ee(ii);
			myassert(xee<=255, 1234);
			myassert(xee>0, 1235);
			k:=k+1;
			eloc(k):=ubyte(xee);
		end if;
	end loop;
	end loop;
	bitrep(k,eloc,win_suma,win_sumb,win_sumc);
	key.suma:=win_suma;
	key.sumb:=win_sumb;
	key.sumc:=win_sumc; --unused in puller
	key.pulkey:=wpkey;

	return key;

end psetwinkey;





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

-- these test box-moves


function ptestleft return boolean is
	ii : ushort := indx(pr,pc-1);
begin
	if pc<=2 then
		return false;
	elsif vf(ii)=1 or ff(ii)=1 or not pvalid(ii) then 
		return false;
	else
		return true;
	end if;
end ptestleft;

function ptestright return boolean is
	ii : ushort := indx(pr,pc+1);
begin
	if ushort(pc)>=ncols-1 then
		return false;
	elsif vf(ii)=1 or ff(ii)=1  or not pvalid(ii) then 
		return false;
	else
		return true;
	end if;
end ptestright;

function ptestdown return boolean is
	ii : ushort := indx(pr+1,pc);
begin
	if ushort(pr)>=nrows-1 then
		return false;
	elsif vf(ii)=1 or ff(ii)=1  or not pvalid(ii) then 
		return false;
	else
		return true;
	end if;
end ptestdown;

function ptestup return boolean is
	ii : ushort := indx(pr-1,pc);
begin
	if pr<=2 then
		return false;
	elsif vf(ii)=1 or ff(ii)=1  or not pvalid(ii) then 
		return false;
	else
		return true;
	end if;
end ptestup;


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

function bwallleft return boolean is
begin
	if pc<=2 then
		return true;
	elsif ff(indx(pr,pc-1))=1 then 
		return true;
	elsif vf(indx(pr,pc-1))=1 then --boxlf
		return true;
	else
		return false;
	end if;
end bwallleft;

function bwallright return boolean is
begin
	if ushort(pc)>=ncols-1 then
		return true;
	elsif ff(indx(pr,pc+1))=1 then 
		return true;
	elsif vf(indx(pr,pc+1))=1 then --boxrt
		return true;
	else
		return false;
	end if;
end bwallright;

function bwalldown return boolean is
begin
	if ushort(pr)>=nrows-1 then
		return true;
	elsif ff(indx(pr+1,pc))=1 then 
		return true;
	elsif vf(indx(pr+1,pc))=1 then --boxdn
		return true;
	else
		return false;
	end if;
end bwalldown;

function bwallup return boolean is
begin
	if pr<=2 then
		return true;
	elsif ff(indx(pr-1,pc))=1 then 
		return true;
	elsif vf(indx(pr-1,pc))=1 then --boxup
		return true;
	else
		return false;
	end if;
end bwallup;

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

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

function wallleft return boolean is
begin
	if pc<=2 then
		return true;
	elsif ff(indx(pr,pc-1))=1 then 
		return true;
	else
		return false;
	end if;
end wallleft;

function wallright return boolean is
begin
	if ushort(pc)>=ncols-1 then
		return true;
	elsif ff(indx(pr,pc+1))=1 then 
		return true;
	else
		return false;
	end if;
end wallright;

function walldown return boolean is
begin
	if ushort(pr)>=nrows-1 then
		return true;
	elsif ff(indx(pr+1,pc))=1 then 
		return true;
	else
		return false;
	end if;
end walldown;

function wallup return boolean is
begin
	if pr<=2 then
		return true;
	elsif ff(indx(pr-1,pc))=1 then 
		return true;
	else
		return false;
	end if;
end wallup;

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

















function ignore_this_line( line : string; len:natural ) return boolean is
	token: character;
	nb: integer := 0;

	-- I believe both methods work, 
	-- so this boolean can be set either way!
	test: constant boolean := true;

begin

	if len<2 then return true; end if;

	myassert( len>0, 0);
	myassert( line'first=1, 8);
	myassert( line'last>=len, 9);

	if line( line'first )=':' and line( line'first+1 )=':' then 
		return true; 
	end if;

if test then -- simplest strategy:

	for i in 1..len loop
	  	if( line(i) = '#' ) then --only blanks preceded this token 
	  		return false;         --thus, assume valid line
			
		elsif( line(i) /= ' ' ) then --nonblank precedes first "#"
			return true;              --so assume invalid line

		end if;
	end loop;

	return true; --only blanks this line, so skip it

else -- alternative strategy:

	nb:=0;
	for i in 1..len loop
	token:=line(i);
	if 
		token='@' or token='#' or token='$' or
		token='*' or token='.' or token='+' or token=' '

	then             -- valid puzzle character
		if token/=' ' then
			nb:=nb+1;
		end if;

	elsif i<len then -- invalid...part of commentary
		return true;

	end if;

	end loop;

	if nb>0 then
		return false; -- no invalid tokens in this line...
	else
		return true; -- all blanks so ignore this
	end if;


end if;


end ignore_this_line;








procedure readPuzzle( fnam: unbounded_string; lvl1: integer ) is

  gfil : file_type;
  l1,l2: natural := 1;
  rcd1, rcd2: string(1..99);
  lv : integer := 1;
  nbx,lc, nrcpt : integer := 0;
  row : ushort;
	fp : ushort := 0;
	ii: ushort;
	sawleftwall: boolean;
begin

	myassert( fp=0, 1000);

	myassert( lvl1 >= 1, 1001 );
	myassert( lvl1 <= maxlevel, 1002 );


	for i in 1..maxrows loop
	for j in 1..maxcols loop
		ii:=indx(i,j);
		ee(ii):=usmx;
		ff(ii):=0;
		vf(ii):=0;
	end loop;
	end loop;


	text_io.open( 
			file=> gfil, 
			name=> to_string(fnam),
			mode=>text_io.in_file);

--put_line("flev="&integer'image(flev));

	while( lv < lvl1 ) loop

		 rcd2:=(others=>' ');
     text_io.get_line(gfil, rcd2, l2); lc:=lc+1;

		--get 1st nonblank into rcd2
     while( ignore_this_line(rcd2,l2) ) loop
	    rcd1:=rcd2;  l1:=l2;  
		 rcd2:=(others=>' ');
       text_io.get_line(gfil, rcd2, l2);  lc:=lc+1;
     end loop;
	  -- rcd2 is 1st nonblank

	--go to end of data block:
	  while( not ignore_this_line(rcd2,l2) ) loop
	  	 rcd1:=rcd2; l1:=l2;
		 rcd2:=(others=>' ');
       text_io.get_line(gfil, rcd2, l2); lc:=lc+1;
	 end loop;
	 lv := lv+1; -- 1-based block count

	end loop;


	 rcd2:=(others=>' ');
    text_io.get_line(gfil, rcd2, l2);  lc:=lc+1;

	--get 1st nonblank into rcd2
    while( ignore_this_line(rcd2,l2) ) loop 
	    rcd1:=rcd2;  l1:=l2;
		 rcd2:=(others=>' ');
       text_io.get_line(gfil, rcd2, l2);  lc:=lc+1;
    end loop;
	-- rcd2 is 1st nonblank


-- we should now be in the right place with rcd2 holding 1st pattern

	if 
		rcd2(l2) /= '#' and
		rcd2(l2) /= '$' and
		rcd2(l2) /= '.' and
		rcd2(l2) /= '+' and
		rcd2(l2) /= '*' and
		rcd2(l2) /= '@' 
	then
		l2:=l2-1;
	end if; --elliminate cr,lf 11jan16


--put_line(" 1st line @ line#: "&integer'image(lc)); --line # in file

	nrows:=0; ncols:=0;
	while not failure loop 

		rcd1:=rcd2; l1:=l2;
		nrows := nrows + 1;
		row := nrows; -- local variable with nicer name
		--NOTE:  this (row,col) is 1-based !

		if( l1>natural(ncols) ) then ncols:=ushort(l1); end if;

		savefp:=fp; -- exclude final row


-- this prints to screen the puzzle being read in:
--put_line(rcd1(1..l1)&"| len="&natural'image(l1));


		sawleftwall:=false;
		for col in 1..ushort(l1) loop
			ii:=indx(row,col);

			-- this solver works backwards from solution to
			-- initial configuration.  Thus the role of
			-- goals and boxes is REVERSED !
			case rcd1(integer(col)) is
			when '#' =>  --wall
				ff(ii):=1;
				sawleftwall:=true;

			when ' ' => --space
				ff(ii):=0;

			when '.' =>  --goal, but treat as box
				vf(ii):=1; nbx:=nbx+1;

			when '$' =>  --box, but treat as goal
				ff(ii):=2;

			when '@' =>  --pusher
				pr:=row;
				pc:=col;

			when '+' =>  -- goal+pusher, treat as box+pusher
				vf(ii):=1; nbx:=nbx+1;
				pr:=row;
				pc:=col;

			when '*' =>  -- both goal and barrel
				ff(ii):=2;
				vf(ii):=1; nbx:=nbx+1;

			when others => -- treat as space
				ff(ii):=0;

			end case;

			if 
				sawleftwall and
				row>1 and col>1 and
				col<ushort(l1) and ff(ii)/=1
			then
				fp := fp+1;
				-- note:  if fp is too big, we don't need it because
				-- ee only needs to encode valid locations
				if fp<=255 then
					ee(ii) := fp;
				end if;
			end if;

		end loop; --col

		exit when end_of_file(gfil); -- 26feb15 critical addendum
		 rcd2:=(others=>' ');
		text_io.get_line(gfil, rcd2, l2); --l2 includes control char...

		exit when ignore_this_line(rcd2,l2);


		if 
			rcd2(l2) /= '#' and
			rcd2(l2) /= '$' and
			rcd2(l2) /= '.' and
			rcd2(l2) /= '+' and
			rcd2(l2) /= '*' and
			rcd2(l2) /= '@' 
		then
			l2:=l2-1;
		end if; 	--elliminate cr,lf 11jan16

		if( l2>natural(maxcols) ) then
			put_line("nrows="&ushort'image(nrows));
			put_line(rcd2(1..l2));
			put_line("####################");
			failure:=true;
		end if;


	end loop;

   text_io.close(gfil);


if not failure then


	-- 1nov18:
	ovf:=vf;  --save bacwOrigBoxPos=forwGoalPos
	dppuller; -- generate pvalid
	dpbox;    -- generate bvalid





	myassert( savefp<=255, 2001, "puzzle size too big" );
	myassert( nbx<=integer(maxbx), 2002, "# boxes exceeds limit" );

	gpr:=pr;
	gpc:=pc;


	dpwcorral(gpr,gpc, bwin_pulkey);
	bwin_key := bsetwinkey(bwin_pulkey);
	-- win_pulkey = UL corner of the initial puller corral


myassert( ee(indx(gpr,gpc)) < 256, 2003, "bad pwin_pulkey");
	pwin_pulkey := ubyte(ee(indx(gpr,gpc)));
	pwin_key := psetwinkey(pwin_pulkey);



-- Define all possible start positions for puller 
-- [ = end pos for pusher ] by finding all open 
-- locations adjacent to a pullable box, because
-- we don't yet know which is best, or even valid:

	pfmax:=0;
	for r in 2..nrows-1 loop
	for c in 2..ncols-1 loop

		pr:=r;
		pc:=c; -- necessary to use testup, etc.

		ii:=indx(r,c);
		dppathprep(r,c);

		if 
			    ff(ii)/=1 --not on a wall
			and vf(ii)/=1 --not on a box
			--and ee(ii)<256 
			--valid interior location
			and pvalid(ii)

			and --adjacent to pullable box:
		(
			(vf(indx(r-1,c))=1 and btestdown(r-1,c)) --box above
			or
			(vf(indx(r+1,c))=1 and btestup(r+1,c))   --box below
			or
			(vf(indx(r,c+1))=1 and btestleft(r,c+1)) --box@right
			or
			(vf(indx(r,c-1))=1 and btestright(r,c-1)) --box@left
		)
		then
			pfmax:=pfmax+1;
			prfinal(pfmax):=r;
			pcfinal(pfmax):=c;
		end if;


	end loop; --c
	end loop; --r


	-- count goals
	gngoals:=0;
	for r in 1..nrows loop
	for c in 1..ncols loop
		if ff(indx(r,c))=2 then
			gngoals:=gngoals+1;
			grow(gngoals):=r;
			gcol(gngoals):=c;
		end if;
	end loop;
	end loop; --c



end if; -- not failure

end readPuzzle;














procedure prestore( rec : hashrectype ) is
	jj,ii: ushort;
	jb: ubyte;
begin

	for col in 1..ncols loop
	for row in 1..nrows loop
		ii := indx(row,col);
		jj := ee(ii);
		if jj<=255 then
			jb:=ubyte(jj);
			vf(ii):=rec.vfsave(jb);
		else
			vf(ii):=0;
		end if;
	end loop;
	end loop;
	pr := ushort(rec.prsave);
	pc := ushort(rec.pcsave);

end prestore;




procedure brestore( rec : hashrectype;  pr,pc : out ushort ) is
	ii: ushort;
	js: ushort;
	jb: ubyte;
begin

	for col in 1..ncols loop
	for row in 1..nrows loop
		ii := indx(row,col);
		js := ee(ii);
		if js<=255 then
			jb:=ubyte(js);
			vf(ii):=rec.vfsave(jb);
		else
			vf(ii):=0;
		end if;
	end loop;
	end loop;
	pr := ushort(rec.prsave);
	pc := ushort(rec.pcsave);

end brestore;





procedure bdump is
	ii : ushort;
	goal,wall,valid: boolean;
begin

	put_line("  Layout:");
	for row in 1..nrows loop
	for col in 1..ncols loop

		ii:=indx(row,col);
		goal := (ff(ii)=2);
		wall := (ff(ii)=1);
		valid := (ee(ii)<256);


		if xtunn(ii) then put("T");         --critical point
		elsif valid and (vtunl(ii) or htunl(ii)) then put("t");
		elsif nexus(ii) and goal  then put("N"); --important/goal
		elsif nexus(ii)   then put("n");    --important point
		--elsif enexus(ii)   then put("e"); --interesting point
		elsif goal and vf(ii)=1 then put("*");
		elsif wall then put("#");
		elsif goal then put("g");
		else put(" "); end if;

	end loop;
	new_line;
	end loop; --row
	new_line;

end bdump;








-- recursive procedure to print out the solution;
--
-- Here we start with the final move in the pull-sequence
-- which is the first move in the push-sequence, print it
-- and then recurse.
--
-- Also, the pull-directions must be reversed to give push-directions.
--
procedure bdocument(
	solutionPath: in out unbounded_string;
	key : keytype;
	nmoves, bmoves : in out ushort;
	firstcall: boolean
	) is

	use mysplay;

	rec, prec : hashrectype;
	prkey : keytype;
	status : statustype;
	dir, pull : ubyte := 0;
	nstp : ushort := 0;
	np, np0 : ubyte := 0;

	xpr,xpc, opr,opc, prnow,pcnow, prnext,pcnext : ushort;

	zkey : constant keytype := (0,0,0,0);

begin --document

	search( key, mytree, rec, status ); -- direct accessor
	myassert( status=found, 101 );
	dir := rec.prevmove;


	if dir>=0 and dir<=3 then --keep recursing
		pull:=rec.boxpull;
		bmoves := bmoves+ushort(pull);
		prkey := rec.prevkey;
		search( prkey, mytree, prec, status );


		if status=found then

			prnext:=ushort(prec.prsave);
			pcnext:=ushort(prec.pcsave);
			opr := ushort(rec.prsave);
			opc := ushort(rec.pcsave);
			nstp:= ushort(pull);

			np0:=0;
			if firstcall then
				dppathprep(gpr,gpc);
				dppath(opr,opc, np0);
				myassert(np0<ubinf, 89898);
				for k in 1..np0 loop 
					append(solutionPath, ppath(k) );
				end loop;
			end if;

			prnow:=opr;
			pcnow:=opc;

			-- push dir = opposite pull dir
			if pull>0 then
				if    dir=0 then
					for i in 1..pull loop
						append(solutionPath,'D');
						prnow:=prnow+1; 
					end loop;
				elsif dir=1 then
					for i in 1..pull loop 
						append(solutionPath,'U');
						prnow:=prnow-1; 
					end loop;
				elsif dir=2 then
					for i in 1..pull loop 
						append(solutionPath,'L');
						pcnow:=pcnow-1; 
					end loop;
				elsif dir=3 then
					for i in 1..pull loop 
						append(solutionPath,'R');
						pcnow:=pcnow+1; 
					end loop;
				else
					append(solutionPath,'X');
				end if;
			end if;



			np:=0;
			-- now print out pusher-path from (prnow,pcnow) to (prnext,pcnext)
			if 
				(prec.prevkey /= zkey ) and
				(prec.prevmove>=0) and 
				((prnow/=prnext) or (pcnow/=pcnext))
			then

				brestore(prec,xpr,xpc);
				dppathprep(prnow,pcnow);
				dppath(prnext,pcnext, np);
				myassert(np<ubinf, 98989);
				for k in 1..np loop 
					append(solutionPath, ppath(k) );
				end loop;

			end if;

			nmoves:=nmoves + nstp + ushort(np) + ushort(np0);
			bdocument(solutionPath,prkey,nmoves,bmoves,false); --recursion

		end if;

	end if;

end bdocument;















-- recursive procedure to print out the solution;
--
-- Here we start with the final move in the pull-sequence
-- which is the first move in the push-sequence, print it
-- and then recurse.
--
-- Also, the pull-directions must be reversed to give push-directions.
--
procedure pdocument(
	solutionPath: in out unbounded_string;
	key : keytype;
	nmoves, bmoves : in out integer ) is

	rec, prec : hashrectype;
	prkey : keytype;
	status : statustype;
	j, pull : ubyte;
	nstp : integer := 0;
begin --pdocument

	search( key, mytree, rec, status ); -- direct accessor
	myassert( status=found, 101 );
	j := rec.prevmove;


	if j>=0 and j<=3 then --keep recursing
		pull:=rec.boxpull;
		bmoves := bmoves+integer(pull);
		prkey := rec.prevkey;
		search( prkey, mytree, prec, status );


		if status=found then

			nstp:= integer(
				abs(integer(rec.prsave)-integer(prec.prsave)) + 
				abs(integer(rec.pcsave)-integer(prec.pcsave))
				);

			-- push dir = opposite pull dir
			if pull>0 then
				if    j=0 then
					for i in 1..pull loop 
						append(solutionPath, "D");
					end loop;
				elsif j=1 then
					for i in 1..pull loop 
						append(solutionPath, "U");
					end loop;
				elsif j=2 then
					for i in 1..pull loop 
						append(solutionPath, "L");
					end loop;
				elsif j=3 then
					for i in 1..pull loop 
						append(solutionPath, "R");
					end loop;
				else
						append(solutionPath, "X");
				end if;
			else
				if    j=0 then
					for i in 1..nstp loop 
						append(solutionPath, "d");
					end loop;
				elsif j=1 then
					for i in 1..nstp loop 
						append(solutionPath, "u");
					end loop;
				elsif j=2 then
					for i in 1..nstp loop 
						append(solutionPath, "l");
					end loop;
				elsif j=3 then
					for i in 1..nstp loop 
						append(solutionPath, "r");
					end loop;
				else
						append(solutionPath, "x");
				end if;
			end if;

			nmoves:=nmoves + nstp;
			pdocument(solutionPath,prkey,nmoves,bmoves); --recursion

		end if;

	end if;

end pdocument;






-- trim an integer in [1..9999] to a minimal UB-string
function trimmed_int( i: integer ) return unbounded_string is
	outstr: string(1..4);
	beg: natural:=1;
	ubstr: unbounded_string;
begin
	myint_io.put(outstr,i);

	while outstr(beg)=' ' loop
		beg:=beg+1;
	end loop;
	myassert( beg<=4, 98789 );

	ubstr := to_unbounded_string( outstr(beg..4) );
	return ubstr;
end trimmed_int;





procedure pwinnertest( 
	key: keytype; 
	solutionPath: in out unbounded_string;
	tpulz, tmovz: ushort
	) is
	ofname : string :=
		to_string( infilname ) &
		"_lev_" &
		to_string( trimmed_int(level) ) &
		"_soln_puller.txt";
	fout : text_io.file_type;
	nmoves, bmoves: integer:=0;
begin

if 

	(tmovz<minMoves and tpulz<=minBoxPulls) or
	(tpulz<minBoxPulls and tmovz<=minMoves)

then -- 9sep18 (overwrite if shorter)

	if key=pwin_key then

		winner:=true;
		minBoxPulls:=tpulz; -- 9sep18
		minMoves:=tmovz;

		tsec1:=ada.calendar.seconds(ada.calendar.clock);
		set_unbounded_string(solutionPath, "");
		pdocument(solutionPath,key,nmoves,bmoves);
	end if; --winner


end if; --not winner
end pwinnertest;








function min(a,b: ushort) return ushort is
begin
	if a<b then return a;
	else return b;
	end if;
end min;












procedure psaveifnew( 
	solutionPath: in out unbounded_string;
	okey: keytype; pmove, boxpulls, moves : ushort ) is

	nukey : keytype := (0,0,0,0);
	rec, nurec : hashrectype;
	eloc : etype;
	nk : ushort := 0;
	k,ii,jj : ushort := 0;
	jb: ubyte:=0;
	totp, totm : ushort;

begin

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		if vf(ii)=1 then
			k:=k+1;
			eloc(k):=ubyte(ee(ii));
			if ff(ii)=2 then
				nk:=nk+1; --tally goals
			end if;
		end if;
		jj:=ee(ii);
		if jj<256 then
			jb:=ubyte(jj);
			nurec.vfsave(jb):=vf(ii); --used to restore vf config
		end if;
	end loop;
	end loop;

	if bestnk<nk then bestnk:=nk; end if;

	bitrep(k,eloc,nukey.suma,nukey.sumb,nukey.sumc);
	nukey.pulkey := ubyte(ee(indx(pr,pc)));

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

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

	if status=notfound then
		totp := olpulz + ushort(boxpulls);
		totm := olmovz + ushort(moves);

		nurec.prsave:=ubyte(pr);
		nurec.pcsave:=ubyte(pc);
		nurec.boxpull := ubyte(boxpulls);
		nurec.prevmove := ubyte(pmove);
		nurec.prevkey := okey;
		nurec.ngoals := ubyte(nk);
		nurec.totpulz := totp;
		nurec.totmovz := totm;
		mysplay.addnode( nukey, nurec, mytree, status );
		myassert( status=ok, 111, "addnode error" );
		pwinnertest( nukey, solutionPath, totp, totm );

	end if; -- not seen

end psaveifnew;



procedure psave0 is
	irec : hashrectype;
	zkey : constant keytype := (0,0,0,0);
	nukey : keytype;
	eloc : etype;
	k  : ushort := 0;
	ii,jj : ushort;
	jb: ubyte:=0;
begin --psave0

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		if vf(ii)=1 then
			k:=k+1;
			eloc(k) := ubyte(ee(ii));
		end if;
	end loop;
	end loop; --row

	-- save configs for each possible start pos of puller
	-- (end pos of pusher):
	for i in 1..pfmax loop
		irec.prsave:=ubyte(prfinal(i));
		irec.pcsave:=ubyte(pcfinal(i));
		irec.prevkey:=zkey;
		irec.prevmove:=9; -- valid moves in {0..3}
		irec.boxpull:=0;
		irec.totmovz:=0;
		irec.totpulz:=0;

		nukey.pulkey := ubyte(ee( indx(prfinal(i),pcfinal(i)) ));

		bitrep(k,eloc, nukey.suma, nukey.sumb, nukey.sumc);

		for col in 1..ncols loop
		for row in 1..nrows loop
			ii := indx(row,col);
			jj := ee(ii);
			if jj<256 then
				jb:=ubyte(jj);
				irec.vfsave(jb):=vf(ii);
			end if;
		end loop;
		end loop;

		mysplay.addnode( nukey, irec, mytree, status );
		myassert( status=Ok, 113, "addnode error in psave0" );

	end loop; -- i

	myassert(pfmax=ushort(length(mytree)), 114, "emutils.psave0");

end psave0;








procedure pcountbest( k,g : in out ushort ) is
begin
	k:=0;
	g:=0;
	for r in 2..nrows-1 loop
	for c in 2..ncols-1 loop
		if ff(indx(r,c))=2 then --this is target
			g:=g+1;
			if vf(indx(r,c))=1 then --a box is here
				k:=k+1;
			end if;
		end if;
	end loop; --c
	end loop; --r

end pcountbest;








procedure pdump is
	ii : ushort;
	goal,wall: boolean;
begin

	put_line("  Layout:");
	for row in 1..nrows loop
	for col in 1..ncols loop

		ii:=indx(row,col);
		goal := (ff(ii)=2);
		wall := (ff(ii)=1);


		if xtunn(ii) then put("T");         --critical point
		--elsif valid and (vtunl(ii) or htunl(ii)) then put("t");
		elsif nexus(ii) and goal  then put("N"); --important/goal
		elsif nexus(ii)   then put("n");    --important point
		elsif goal and vf(ii)=1 then put("*");
		elsif wall then put("#");
		elsif goal then put("g");
		else put(" "); end if;

	end loop;
	new_line;
	end loop; --row
	new_line;

end pdump;

-------------------- ibox stuff below this line ----------------------









-- plan:  255 valid, 20rX25c, 24 boxes, using 3-64bit-ulong ?

-- WARNING:  size limitations here...(current=20rx25c<=255ip)
-- interior sizes permitted:  ee<255 reachable positions;
-- puzzle with moveable boxes, all with distinct locations
-- ...note that original#13 puzzle[13x19] has eemax=124
-- ...so we would like to have at least that much interior room
-- even though this algorithm won't solve that puzzle.

-- bitrep generates:  (suma, sumb, sumc) a triple of ulongs,
-- and together with "pulkey", a ushort (puller-corral-id)
-- they represent each possible puzzle configuration.

procedure bitrep(
	nb : ushort; -- 1..24
	e  : etype; -- 1..255
	suma, sumb, sumc : in out ulong ) is
	le: ulong;
begin
	myassert( nb <= maxbx, 4321 ); --maxBx=24
	suma:=0; sumb:=0; sumc:=0;
	for i in 1..nb loop
		le := ulong( e(i) ); -- le<=1111_1111 binary = 2**8-1 = 255
		myassert( le < 256, 4322 );
		myassert( le >   0, 4323 );
		if i<=8 then
			suma := suma + le;
			if i<8 then suma:=suma*256; end if;
			-- shifts suma by 8 places each of 7 times...
			-- => suma <= 56 ones followed by 8more 
			-- = 64 ones = 2**64-1 = max ulong
		elsif i<=16 then -- i in [9..16]
			sumb := sumb + le;
			if i<16 then sumb:=sumb*256; end if;
		else -- i in [17..24]
			sumc := sumc + le;
			if i<nb then sumc:=sumc*256; end if;
		end if;
	end loop;
end bitrep;






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





function dppathexists( r1,c1 : ushort ) return boolean is
begin
	return bestcost( indx(r1,c1) ) < ubinf;
end dppathexists;



procedure dppath( r1,c1 : ushort;  np: out ubyte ) is
	rr,cc : ushort;
begin
	np:=( bestcost(indx(r1,c1)) );
	rr:=r1;
	cc:=c1;

	if np<ubinf then -- => exists a puller path to (r1,c1)

		for i in reverse 1..np loop
			case bestpred(indx(rr,cc)) is

				when fromno =>
					rr:=rr-1;
					ppath(i):='d';

				when fromso =>
					rr:=rr+1;
					ppath(i):='u';

				when fromea =>
					cc:=cc+1;
					ppath(i):='l';

				when fromwe =>
					cc:=cc-1;
					ppath(i):='r';

				when others => null;

			end case;

		end loop;

	end if;

end dppath;





procedure initwdpcorral is
	ic: ushort;
begin

	for row in 1..nrows loop
	for col in 1..ncols loop
		ic:=indx(row,col);

		if ff(ic) /= 0 then fff(ic):=1;
		else                fff(ic):=0; end if;

		corral(ic):=false;

		cviano(ic):=false;
		cviaso(ic):=false;
		cviaea(ic):=false;
		cviawe(ic):=false;

	end loop;
	end loop;


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ic:=indx(row,col);

		if fff(ic)=0 and fff(indx(row-1,col))=0 then cviano(ic):=true; end if;
		if fff(ic)=0 and fff(indx(row+1,col))=0 then cviaso(ic):=true; end if;
		if fff(ic)=0 and fff(indx(row,col+1))=0 then cviaea(ic):=true; end if;
		if fff(ic)=0 and fff(indx(row,col-1))=0 then cviawe(ic):=true; end if;

	end loop;
	end loop;

end initwdpcorral;



procedure initdpcorral is
	ic: ushort;
begin

	for row in 1..nrows loop
	for col in 1..ncols loop
		ic:=indx(row,col);

		if ff(ic)=1 or vf(ic)=1 then fff(ic):=1;
		else                         fff(ic):=0; end if;

		corral(ic):=false;

		cviano(ic):=false;
		cviaso(ic):=false;
		cviaea(ic):=false;
		cviawe(ic):=false;

	end loop;
	end loop;


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ic:=indx(row,col);

		--if ee(ic)<=255 then
		if pvalid(ic) then

			if fff(ic)=0 and fff(indx(row-1,col))=0 then cviano(ic):=true; end if;
			if fff(ic)=0 and fff(indx(row+1,col))=0 then cviaso(ic):=true; end if;
			if fff(ic)=0 and fff(indx(row,col+1))=0 then cviaea(ic):=true; end if;
			if fff(ic)=0 and fff(indx(row,col-1))=0 then cviawe(ic):=true; end if;

		end if;

	end loop;
	end loop;

end initdpcorral;




-- define puller corral and find the index of its upper left
-- corner using relaxation (flood-fill)
procedure dpcorral(
	r0,c0 : ushort; --puller.pos
	ulkey : out ubyte -- 3rd component of keytype
	) is

	ip: constant ushort := indx(r0,c0);
	ndelta : integer;
	irc,ino,iso,iea,iwe: ushort;
	rul,cul: ushort;
begin

	initdpcorral;
	corral(ip):=true;
	ndelta:=5;

	while ndelta>0 loop
		ndelta:=0;

		-- sweep forward
		for row in 2..nrows-1 loop
		for col in 2..ncols-1 loop
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then
			ino:=indx(row-1,col);
			iso:=indx(row+1,col);
			iea:=indx(row,col+1);
			iwe:=indx(row,col-1);
			if cviano(irc) and corral(ino) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaso(irc) and corral(iso) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaea(irc) and corral(iea) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviawe(irc) and corral(iwe) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
		end if;
		end loop;
		end loop; --row


		-- now sweep back
		for row in reverse 2..nrows-1 loop
		for col in reverse 2..ncols-1 loop
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then
			ino:=indx(row-1,col);
			iso:=indx(row+1,col);
			iea:=indx(row,col+1);
			iwe:=indx(row,col-1);
			if cviano(irc) and corral(ino) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaso(irc) and corral(iso) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaea(irc) and corral(iea) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviawe(irc) and corral(iwe) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
		end if;
		end loop;
		end loop; --row

	end loop; --while ndelta

--/////////// bx.cc::399 ////////////////////

	rul:=256; cul:=256;
	-- finally, find UL corner of corral
	for row in 2..nrows-1 loop
	if rul>255 then
		for col in 2..ncols-1 loop
		if rul>255 and corral(indx(row,col)) then
			rul:=row; cul:=col; --grab, use first one
		end if;
		end loop; --col
	end if;
	end loop; --row

myassert( ee(indx(rul,cul))<=255, 70707);
	ulkey:=ubyte( ee(indx(rul,cul)) );


end dpcorral;









-- define Winning puller corral and the index of its UL corner
procedure dpwcorral(
	r0,c0 : ushort; --puller.pos
	ulkey : out ubyte -- 3rd component of keytype
	) is

	ip: constant ushort := indx(r0,c0);
	ndelta : integer;
	rul,cul,irc,ino,iso,iea,iwe: ushort;
begin

	initwdpcorral;
	myassert( fff(ip)=0, 8888 );
	corral(ip):=true;
	ndelta:=5;

	-- identify the puller-corral...i.e. all coordinates
	-- that can be reached by the puller without moving
	-- any boxes:

	while ndelta>0 loop
		ndelta:=0;

		-- sweep forward
		for row in 2..nrows-1 loop
		for col in 2..ncols-1 loop
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then
			ino:=indx(row-1,col);
			iso:=indx(row+1,col);
			iea:=indx(row,col+1);
			iwe:=indx(row,col-1);
			if cviano(irc) and corral(ino) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaso(irc) and corral(iso) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaea(irc) and corral(iea) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviawe(irc) and corral(iwe) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
		end if;
		end loop;
		end loop; --row


		-- now sweep back
		for row in reverse 2..nrows-1 loop
		for col in reverse 2..ncols-1 loop
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then
			ino:=indx(row-1,col);
			iso:=indx(row+1,col);
			iea:=indx(row,col+1);
			iwe:=indx(row,col-1);
			if cviano(irc) and corral(ino) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaso(irc) and corral(iso) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviaea(irc) and corral(iea) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
			if cviawe(irc) and corral(iwe) and not corral(irc) then
				corral(irc):=true; ndelta:=ndelta+1;
			end if;
		end if;
		end loop;
		end loop; --row

	end loop; --while ndelta

--/////////// bx.cc::517 ////////////////////

	-- for each box configuration, all the corrals are distinct,
	-- and each corral has a distinct upper left [UL] corner...
	-- We are only interested in identifying the corral that 
	-- contains the puller @ (r0,c0):

	rul:=256; cul:=256;
	-- finally, find UL corner of corral
	for row in 1..nrows loop
	if rul>255 then
		for col in 1..ncols loop
		if rul>255 and corral(indx(row,col)) then
			rul:=row; cul:=col; --grab, use first one
		end if;
		end loop; --col
	end if;
	end loop; --row

myassert( ee(indx(rul,cul))<=255, 71717);
	ulkey:=ubyte( ee(indx(rul,cul)) );


end dpwcorral;





procedure initdp is
	ic: ushort;
begin

	for row in 1..nrows loop
	for col in 1..ncols loop
		ic:=indx(row,col);

		if ff(ic)=1 or vf(ic)=1 then fff(ic):=1;
		else                         fff(ic):=0; end if;

		bestcost(ic):=ubinf; --254
		bestpred(ic):=none; --254
		viano(ic):=false;
		viaso(ic):=false;
		viaea(ic):=false;
		viawe(ic):=false;

	end loop;
	end loop;


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ic:=indx(row,col);

		--if ee(ic)<256 then -- valid position
		if pvalid(ic) then

			if fff(ic)=0 and fff(indx(row-1,col))=0 then viano(ic):=true; end if;
			if fff(ic)=0 and fff(indx(row+1,col))=0 then viaso(ic):=true; end if;
			if fff(ic)=0 and fff(indx(row,col+1))=0 then viaea(ic):=true; end if;
			if fff(ic)=0 and fff(indx(row,col-1))=0 then viawe(ic):=true; end if;

		end if;

	end loop;
	end loop;

end initdp;





-- define puller domain using relaxation (flood-fill)
procedure dppathprep(
	r0,c0 : ushort --puller.pos
	) is

	ip: constant ushort := indx(r0,c0);
	ndelta : integer;
	irc,ino,iso,iea,iwe: ushort;
begin

	initdp;
	bestcost(ip):=0;
	ndelta:=5;

	-- we must assume that any reachable position has a
	-- manhattan distance bounded by 254...

	while ndelta>0 loop
		ndelta:=0;

		-- sweep forward
		for row in 2..nrows-1 loop
		for col in 2..ncols-1 loop
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then
			ino:=indx(row-1,col);
			iso:=indx(row+1,col);
			iea:=indx(row,col+1);
			iwe:=indx(row,col-1);
			if viano(irc) and bestcost(irc)>bestcost(ino)+1 then
				bestcost(irc):=bestcost(ino)+1;
				bestpred(irc):=fromno;
				ndelta:=ndelta+1;
			end if;
			if viaso(irc) and bestcost(irc)>bestcost(iso)+1 then
				bestcost(irc):=bestcost(iso)+1;
				bestpred(irc):=fromso;
				ndelta:=ndelta+1;
			end if;
			if viaea(irc) and bestcost(irc)>bestcost(iea)+1 then
				bestcost(irc):=bestcost(iea)+1;
				bestpred(irc):=fromea;
				ndelta:=ndelta+1;
			end if;
			if viawe(irc) and bestcost(irc)>bestcost(iwe)+1 then
				bestcost(irc):=bestcost(iwe)+1;
				bestpred(irc):=fromwe;
				ndelta:=ndelta+1;
			end if;
		end if;
		end loop;
		end loop; --row


		-- now sweep back
		for row in reverse 2..nrows-1 loop
		for col in reverse 2..ncols-1 loop
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then
			ino:=indx(row-1,col);
			iso:=indx(row+1,col);
			iea:=indx(row,col+1);
			iwe:=indx(row,col-1);
			if viano(irc) and bestcost(irc)>bestcost(ino)+1 then
				bestcost(irc):=bestcost(ino)+1;
				bestpred(irc):=fromno;
				ndelta:=ndelta+1;
			end if;
			if viaso(irc) and bestcost(irc)>bestcost(iso)+1 then
				bestcost(irc):=bestcost(iso)+1;
				bestpred(irc):=fromso;
				ndelta:=ndelta+1;
			end if;
			if viaea(irc) and bestcost(irc)>bestcost(iea)+1 then
				bestcost(irc):=bestcost(iea)+1;
				bestpred(irc):=fromea;
				ndelta:=ndelta+1;
			end if;
			if viawe(irc) and bestcost(irc)>bestcost(iwe)+1 then
				bestcost(irc):=bestcost(iwe)+1;
				bestpred(irc):=fromwe;
				ndelta:=ndelta+1;
			end if;
		end if;
		end loop;
		end loop; --row

	end loop; --while ndelta


end dppathprep;



--/////////////////////////////////////////////////







function bsetwinkey( wpkey: ubyte ) return keytype is
	k,ii:ushort:=0;
	eloc : etype;
	key : keytype;
	xee : ushort;
begin
	win_suma:=0;
	win_sumb:=0;
	win_sumc:=0;

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		if ff(ii)=2 then -- goal position = box receptacle
			xee := ee(ii);
			myassert(xee<256, 1234);
			myassert(xee>0, 1235);
			k:=k+1;
			eloc(k):=ubyte(xee);
		end if;
	end loop;
	end loop;
	bitrep(k,eloc,win_suma,win_sumb,win_sumc);
	key.suma:=win_suma;
	key.sumb:=win_sumb;
	key.sumc:=win_sumc;
	key.pulkey:=wpkey;

	return key;

end bsetwinkey;






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

-- these test box-moves


function btestleft(br,bc:ushort) return boolean is
	ii : ushort := indx(br,bc-1);
	i2 : ushort := indx(br,bc-2);
begin

	--if ee(ii)>255 then return false; end if;
	--if not dppathexists(br,bc-1) then return false; end if;

	if (bc-1)<=2 then 
		return false; --edge blocks
	elsif vf(i2)=1 or ff(i2)=1 or ff(ii)=1 or not bvalid(ii) then 
		return false;
	else 
		return true; 
	end if;

end btestleft;

function btestright(br,bc:ushort) return boolean is
	ii : ushort := indx(br,bc+1);
	i2 : ushort := indx(br,bc+2);
begin

	--if ee(ii)>255 then return false; end if;
	--if not dppathexists(br,bc+1) then return false; end if;

	if (bc+1)>=ncols-1 then 
		return false;
	elsif vf(i2)=1 or ff(i2)=1 or ff(ii)=1 or not bvalid(ii) then 
		return false;
	else return true;	end if;

end btestright;

function btestdown(br,bc:ushort) return boolean is
	ii : ushort := indx(br+1,bc);
	i2 : ushort := indx(br+2,bc);
begin

	--if ee(ii)>255 then return false; end if;
	--if not dppathexists(br+1,bc) then return false; end if;

	if (br+1)>=nrows-1 then
		return false;
	elsif vf(i2)=1 or ff(i2)=1 or ff(ii)=1 or not bvalid(ii) then 
		return false;
	else
		return true;
	end if;

end btestdown;

function btestup(br,bc:ushort) return boolean is
	ii : ushort := indx(br-1,bc);
	i2 : ushort := indx(br-2,bc);
begin

	--if ee(ii)>255 then return false; end if;
	--if not dppathexists(br-1,bc) then return false; end if;

	if (br-1)<=2 then
		return false;
	elsif vf(i2)=1 or ff(i2)=1 or ff(ii)=1 or not bvalid(ii) then 
		return false;
	else
		return true;
	end if;

end btestup;









function bwallleft(pr,pc:ushort) return boolean is
begin
	if pc<=2 then
		return true;
	elsif ff(indx(pr,pc-1))=1 then 
		return true;
	else
		return false;
	end if;
end bwallleft;

function bwallright(pr,pc:ushort) return boolean is
begin
	if ushort(pc)>=ncols-1 then
		return true;
	elsif ff(indx(pr,pc+1))=1 then 
		return true;
	else
		return false;
	end if;
end bwallright;

function bwalldown(pr,pc:ushort) return boolean is
begin
	if ushort(pr)>=nrows-1 then
		return true;
	elsif ff(indx(pr+1,pc))=1 then 
		return true;
	else
		return false;
	end if;
end bwalldown;

function bwallup(pr,pc:ushort) return boolean is
begin
	if pr<=2 then
		return true;
	elsif ff(indx(pr-1,pc))=1 then 
		return true;
	else
		return false;
	end if;
end bwallup;











procedure bwinnertest( 
	key: keytype; 
	solutionPath: in out unbounded_string;
	tpulz: ushort
	) is
	nmoves, bmoves: ushort:=0;
begin

if tpulz<minBoxPulls then -- 9sep18 (overwrite if shorter)

	if key=bwin_key then

		winner:=true;
		minBoxPulls:=tpulz; -- 9sep18

		tsec1:=ada.calendar.seconds(ada.calendar.clock);
		set_unbounded_string(solutionPath, "");
		bdocument(solutionPath,key,nmoves,bmoves,true);
	end if; --winner

end if; --not winner
end bwinnertest;












procedure bsaveifnew(
	solutionPath: in out unbounded_string;
	okey: keytype; 
	pmove, boxpulls : ushort;
	pr,pc, br,bc: ushort
	) is

	use mysplay;
	nukey : keytype := (0,0,0,0);
	rec, nurec : hashrectype;
	eloc : etype;
	pk,nk,k,ii : ushort := 0;
	ulkey : ubyte;
	jb: ubyte;
	js: ushort;
	tpulz: ushort;
begin


	dpcorral(pr,pc, ulkey); --define ulkey here


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		if vf(ii)=1 then

			--myassert(ee(ii)<256, 10101);

			k:=k+1;
			eloc(k):=ubyte(ee(ii));
			if ff(ii)=2 then
				nk:=nk+1; --tally goals
			end if;
		end if;
		js:=ee(ii);
		if js<256 then
			jb:=ubyte(js);
			nurec.vfsave(jb):=vf(ii); --used to restore vf config
		end if;
	end loop;
	end loop;

	if bestnk<nk then bestnk:=nk; end if;
	if ulkey=bwin_pulkey then pk:=1; else pk:=0; end if;
	if bestnkp<nk+pk then bestnkp:=nk+pk; end if;

	bitrep(k,eloc,nukey.suma,nukey.sumb,nukey.sumc);
	nukey.pulkey := ulkey;

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

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

	if status=notfound then

		tpulz:=olpulz+boxpulls;

		nurec.prsave:=ubyte(pr);
		nurec.pcsave:=ubyte(pc);
		nurec.boxpull := ubyte(boxpulls);
		nurec.prevmove := ubyte(pmove);
		nurec.prevkey := okey;
		nurec.ngoals := ubyte(nk);
		nurec.totpulz := tpulz;
		mysplay.addnode( nukey, nurec, mytree, status );
		myassert( status=ok, 111, "addnode error" );
		bwinnertest( nukey, solutionPath, tpulz );

	end if; -- not seen


end bsaveifnew;



procedure bsave0 is
	use mysplay;
	irec : hashrectype;
	zkey : constant keytype := (0,0,0,0);
	nukey : keytype;
	eloc : etype;
	k  : ushort := 0;
	ii : ushort;
	jb: ubyte;
	js, kount: ushort;
begin --bsave0

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		if vf(ii)=1 then

myassert(ee(ii)<256, 20202);

			k:=k+1;
			eloc(k) := ubyte( ee(ii) );

		end if;
	end loop;
	end loop; --row

	kount:=0;
	-- save configs for each possible start pos of puller
	-- (end pos of pusher):
	for i in 1..pfmax loop
		irec.prsave:=ubyte(prfinal(i));
		irec.pcsave:=ubyte(pcfinal(i));
		irec.prevkey:=zkey;
		irec.ngoals:=0;
		irec.prevmove:=9; -- valid moves in {0..3}
		irec.boxpull:=0;
		irec.totpulz:=0;

		dpcorral( prfinal(i), pcfinal(i), nukey.pulkey );

		bitrep(k,eloc, nukey.suma, nukey.sumb, nukey.sumc);

		for col in 1..ncols loop
		for row in 1..nrows loop
			ii := indx(row,col);
			js := ee(ii);
			if js<256 then
				jb:=ubyte(js);
				irec.vfsave(jb):=vf(ii);
			end if;
		end loop;
		end loop;

		mysplay.addnode( nukey, irec, mytree, status );
		myassert( status=Ok or status=dupid, 113, "addnode error in bsave0" );
		if status=ok then kount:=kount+1; end if;

	end loop; -- i

	myassert(kount=ushort(length(mytree)), 114, "emutils.bsave0");

end bsave0;















procedure remdead is

	function golat(r,c:ushort) return boolean is
	begin
		return (ovf(indx(r,c))=1);
	end golat;
	function walat(r,c:ushort) return boolean is
	begin
		return (ff(indx(r,c))=1);
	end walat;

	ii, wc, wr,wcp,wcm, wrp,wrm : ushort;

	bacbox,
	escno,escso,escea,escwe,
	escne,escnw,escse,escsw,
	wallno,wallso,wallea,wallwe : boolean;

begin
	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
	ii:=indx(row,col);
	if bvalid(ii) then

-- note that a wall can be escaped if it has an outward break;
-- but it need NOT be escaped if an adjacent [forward] goal exists.

-- remove cell if on inescapable wall with no forGoal=bacBox

		wallno:=walat(row-1,col);
		wallso:=walat(row+1,col);
		wallea:=walat(row,col+1);
		wallwe:=walat(row,col-1);

		if wallno then -- ?is escape possible?
			wr:=row-1; wcp:=col; wcm:=col;

			escne:=true;
			northea:
			loop
				if wcp+1=ncols then
					escne:=false;
					exit northea;
				end if;
				exit northea when not walat(wr,wcp+1);
				if walat(row,wcp+1) then
					escne:=false;
					exit northea;
				end if;
				wcp:=wcp+1;
			end loop northea;
			-- here wcp is wall's largest col when escne=false

			escnw:=true;
			northwe:
			loop
				if wcm-1=1 then
					escnw:=false;
					exit northwe;
				end if;
				exit northwe when not walat(wr,wcm-1);
				if walat(row,wcm-1) then
					escnw:=false;
					exit northwe;
				end if;
				wcm:=wcm-1;
			end loop northwe;
			-- here wcm is wall's smallest col when escnw=false

			escno:=escne or escnw;

			if not escno then --test for forgoal=bacbox
				bacbox:=false;
myassert(1<=wcm and wcm<=wcp and wcp<=ncols, 707, "wallNo");
				for c in wcm..wcp loop
					if golat(row,c) then bacbox:=true; end if;
				end loop;

				if not bacbox then bvalid(ii):=false; end if;

			end if;

		end if; --wallno



		if wallso then -- ?is escape possible?
			wr:=row+1; wcp:=col; wcm:=col;

			escse:=true;
			southea:
			loop
				if wcp+1=ncols then
					escse:=false;
					exit southea;
				end if;
				exit southea when not walat(wr,wcp+1);
				if walat(row,wcp+1) then
					escse:=false;
					exit southea;
				end if;
				wcp:=wcp+1;
			end loop southea;
			-- here wcp is wall's largest col when escse=false

			escsw:=true;
			southwe:
			loop
				if wcm-1=1 then
					escsw:=false;
					exit southwe;
				end if;
				exit southwe when not walat(wr,wcm-1);
				if walat(row,wcm-1) then
					escsw:=false;
					exit southwe;
				end if;
				wcm:=wcm-1;
			end loop southwe;
			-- here wcm is wall's smallest col when escsw=false

			escso := escse or escsw;


			if not escso then --test for forgoal=bacbox
				bacbox:=false;
myassert(1<=wcm and wcm<=wcp and wcp<=ncols, 707, "wallSo");
				for c in wcm..wcp loop
					if golat(row,c) then bacbox:=true; end if;
				end loop;

				if not bacbox then bvalid(ii):=false; end if;

			end if;

		end if; --wallso



		if wallea then -- ?is escape possible?
			wrp:=row; wrm:=row; wc:=col+1;

			escne:=true;
			eastno:
			loop
				if wrm-1=1 then
					escne:=false;
					exit eastno;
				end if;
				exit eastno when not walat(wrm-1,wc);
				if walat(wrm-1,col) then
					escne:=false;
					exit eastno;
				end if;
				wrm:=wrm-1;
			end loop eastno;
			-- here wrm is wall's smallest row when escne=false

			escse:=true;
			eastso:
			loop
				if wrp+1=nrows then
					escse:=false;
					exit eastso;
				end if;
				exit eastso when not walat(wrp+1,wc);
				if walat(wrp+1,col) then
					escse:=false;
					exit eastso;
				end if;
				wrp:=wrp+1;
			end loop eastso;
			-- here wrp is wall's largest row when escse=false

			escea := escne or escse;


			if not escea then --test for forgoal=bacbox
				bacbox:=false;
myassert(1<=wrm and wrm<=wrp and wrp<=nrows, 707, "wallEa");
				for r in wrm..wrp loop
					if golat(r,col) then bacbox:=true; end if;
				end loop;

				if not bacbox then bvalid(ii):=false; end if;

			end if;

		end if; --wallea



		if wallwe then -- ?is escape possible?
			wrp:=row; wrm:=row; wc:=col-1;

			escnw:=true;
			westno:
			loop
				if wrm-1=1 then
					escnw:=false;
					exit westno;
				end if;
				exit westno when not walat(wrm-1,wc);
				if walat(wrm-1,col) then
					escnw:=false;
					exit westno;
				end if;
				wrm:=wrm-1;
			end loop westno;
			-- here wrm is wall's smallest row when escnw=false

			escsw:=true;
			westso:
			loop
				if wrp+1=nrows then
					escsw:=false;
					exit westso;
				end if;
				exit westso when not walat(wrp+1,wc);
				if walat(wrp+1,col) then
					escsw:=false;
					exit westso;
				end if;
				wrp:=wrp+1;
			end loop westso;
			-- here wrp is wall's largest row when escsw=false

			escwe := escnw or escsw;

			if not escwe then --test for forgoal=bacbox
				bacbox:=false;
myassert(1<=wrm and wrm<=wrp and wrp<=nrows, 707, "wallWe");
				for r in wrm..wrp loop
					if golat(r,col) then bacbox:=true; end if;
				end loop;

				if not bacbox then bvalid(ii):=false; end if;

			end if;

		end if; --wallwe


	end if;
	end loop;
	end loop;


	--Finally, remove nonGoal corners
	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
	ii:=indx(row,col);
	if bvalid(ii) and not golat(row,col) then

		wallno:=walat(row-1,col);
		wallso:=walat(row+1,col);
		wallea:=walat(row,col+1);
		wallwe:=walat(row,col-1);

		if 
			(wallno and wallwe) or
			(wallno and wallea) or
			(wallso and wallwe) or
			(wallso and wallea)
		then
			bvalid(ii):=false;
		end if;

	end if;
	end loop;
	end loop;



end remdead;












--prepare to test pull-feasibility
procedure initdpbox is
	use text_io;
	--use myintio;
	ic: ushort;
begin
	hfff := (others=>1);
	for row in 1..nrows loop
	for col in 1..ncols loop
		ic:=indx(row,col);

		hfff(ic):=0;
		if ff(ic)=1  then hfff(ic):=1;  end if;

		hbestcost(ic):=usinf; -- usinf=usmx-1
		hviano(ic):=false;
		hviaso(ic):=false;
		hviaea(ic):=false;
		hviawe(ic):=false;

	end loop;
	end loop;


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ic:=indx(row,col);

		if 
			hfff(ic)=0                  -- no wall @ cell itself
			and hfff(indx(row-1,col))=0 -- no wall @ pred (above)
			and hfff(indx(row+1,col))=0 -- room for puller (below)
		then 
			hviano(ic):=true;
		end if;

		if 
			hfff(ic)=0 
			and hfff(indx(row+1,col))=0 
			and hfff(indx(row-1,col))=0 -- room for puller (above)
		then 
			hviaso(ic):=true; 
		end if;

		if 
			hfff(ic)=0                  -- no wall @ cell itself
			and hfff(indx(row,col+1))=0 -- no wall @ pred (right)
			and hfff(indx(row,col-1))=0 -- room for puller (left)
		then 
			hviaea(ic):=true; 
		end if;

		if 
			hfff(ic)=0 
			and hfff(indx(row,col-1))=0 
			and hfff(indx(row,col+1))=0 -- room for puller (right)
		then 
			hviawe(ic):=true; 
		end if;

	end loop;
	end loop;




end initdpbox;




-- NOTE:  I have now specialized this to box-moves;
--        i.e. I allow extra cell for "puller"...
--			 This heuristic must Underestimate true cost.
-- define box domain using relaxation (flood-fill)
-- This defines pull-feasibility.
procedure dpbox is

	use text_io;

	ndelta : integer;
	ip, cost,irc,ino,iso,iea,iwe: ushort;

begin

	initdpbox;

	for row in 2..nrows-1 loop --downward
	for col in 2..ncols-1 loop --rightward
		ip:=indx(row,col);
		if 
			ff(ip)=2  --bakGoal=forBox
			or
			ovf(ip)=1  --forGoal=bacBox
		then 
			hbestcost(ip):=0;
		end if;
	end loop;
	end loop;


	ndelta:=5;



	-- we must assume that any reachable position has a
	-- manhattan distance bounded by 254...

	while ndelta>0 loop
		ndelta:=0;

		for row in 2..nrows-1 loop --downward

			for col in 2..ncols-1 loop --rightward
				irc:=indx(row,col);
				ino:=indx(row-1,col);
				iso:=indx(row+1,col);
				iea:=indx(row,col+1);
				iwe:=indx(row,col-1);
				if hviano(irc) and hbestcost(irc)>hbestcost(ino)+1 then
					hbestcost(irc):=hbestcost(ino)+1;
					ndelta:=ndelta+1;
				end if;
				if hviaso(irc) and hbestcost(irc)>hbestcost(iso)+1 then
					hbestcost(irc):=hbestcost(iso)+1;
					ndelta:=ndelta+1;
				end if;
				if hviaea(irc) and hbestcost(irc)>hbestcost(iea)+1 then
					hbestcost(irc):=hbestcost(iea)+1;
					ndelta:=ndelta+1;
				end if;
				if hviawe(irc) and hbestcost(irc)>hbestcost(iwe)+1 then
					hbestcost(irc):=hbestcost(iwe)+1;
					ndelta:=ndelta+1;
				end if;
			end loop; --rightward

		end loop; --downward


		for row in reverse 2..nrows-1 loop --upward

			for col in reverse 2..ncols-1 loop --leftward
			irc:=indx(row,col);
				ino:=indx(row-1,col);
				iso:=indx(row+1,col);
				iea:=indx(row,col+1);
				iwe:=indx(row,col-1);
				if hviano(irc) and hbestcost(irc)>hbestcost(ino)+1 then
					hbestcost(irc):=hbestcost(ino)+1;
					ndelta:=ndelta+1;
				end if;
				if hviaso(irc) and hbestcost(irc)>hbestcost(iso)+1 then
					hbestcost(irc):=hbestcost(iso)+1;
					ndelta:=ndelta+1;
				end if;
				if hviaea(irc) and hbestcost(irc)>hbestcost(iea)+1 then
					hbestcost(irc):=hbestcost(iea)+1;
					ndelta:=ndelta+1;
				end if;
				if hviawe(irc) and hbestcost(irc)>hbestcost(iwe)+1 then
					hbestcost(irc):=hbestcost(iwe)+1;
					ndelta:=ndelta+1;
				end if;
			end loop; --leftward

		end loop; --upward


	end loop; --while ndelta

	bvalid:=(others=>false);
	for row in 2..nrows-1 loop
		for col in 2..ncols-1 loop
			irc:=indx(row,col);
			cost:=ushort( hbestcost(irc) );
			if cost<usmx/2  and pvalid(irc) then
				bvalid(irc):=true;
			end if;
		end loop;
	end loop;

	remdead;

end dpbox;











procedure initdppuller is
	--use text_io;
	ic: ushort;
begin
	pfff := (others=>1);
	for row in 1..nrows loop
	for col in 1..ncols loop
		ic:=indx(row,col);

		pfff(ic):=0;
		if ff(ic)=1  then pfff(ic):=1;  end if;

		pbestcost(ic):=usinf; -- usinf=usmx-1
		pviano(ic):=false;
		pviaso(ic):=false;
		pviaea(ic):=false;
		pviawe(ic):=false;

	end loop;
	end loop;


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ic:=indx(row,col);

		if 
			pfff(ic)=0                  -- no wall @ cell itself
			and pfff(indx(row-1,col))=0 -- no wall @ pred (above)
		then 
			pviano(ic):=true;
		end if;

		if 
			pfff(ic)=0 
			and pfff(indx(row+1,col))=0 
		then 
			pviaso(ic):=true; 
		end if;

		if 
			pfff(ic)=0                  -- no wall @ cell itself
			and pfff(indx(row,col+1))=0 -- no wall @ pred (right)
		then 
			pviaea(ic):=true; 
		end if;

		if 
			pfff(ic)=0 
			and pfff(indx(row,col-1))=0 
		then 
			pviawe(ic):=true; 
		end if;

	end loop;
	end loop;




end initdppuller;




procedure dppuller is

	use text_io;

	ip: ushort;
	ndelta : integer;
	cost,irc,ino,iso,iea,iwe: ushort;

begin

	initdppuller;

	for row in 2..nrows-1 loop --downward
	for col in 2..ncols-1 loop --rightward
		ip:=indx(row,col);
		if ff(ip)=2 then --goal
			pbestcost(ip):=0;
		end if;
	end loop;
	end loop;

	ndelta:=5;


	-- we must assume that any reachable position has a
	-- manhattan distance bounded by 254...

	while ndelta>0 loop
		ndelta:=0;

		for row in 2..nrows-1 loop --downward

			for col in 2..ncols-1 loop --rightward
				irc:=indx(row,col);
				ino:=indx(row-1,col);
				iso:=indx(row+1,col);
				iea:=indx(row,col+1);
				iwe:=indx(row,col-1);
				if pviano(irc) and pbestcost(irc)>pbestcost(ino)+1 then
					pbestcost(irc):=pbestcost(ino)+1;
					ndelta:=ndelta+1;
				end if;
				if pviaso(irc) and pbestcost(irc)>pbestcost(iso)+1 then
					pbestcost(irc):=pbestcost(iso)+1;
					ndelta:=ndelta+1;
				end if;
				if pviaea(irc) and pbestcost(irc)>pbestcost(iea)+1 then
					pbestcost(irc):=pbestcost(iea)+1;
					ndelta:=ndelta+1;
				end if;
				if pviawe(irc) and pbestcost(irc)>pbestcost(iwe)+1 then
					pbestcost(irc):=pbestcost(iwe)+1;
					ndelta:=ndelta+1;
				end if;
			end loop; --rightward

		end loop; --downward


		for row in reverse 2..nrows-1 loop --upward

			for col in reverse 2..ncols-1 loop --leftward
			irc:=indx(row,col);
				ino:=indx(row-1,col);
				iso:=indx(row+1,col);
				iea:=indx(row,col+1);
				iwe:=indx(row,col-1);
				if pviano(irc) and pbestcost(irc)>pbestcost(ino)+1 then
					pbestcost(irc):=pbestcost(ino)+1;
					ndelta:=ndelta+1;
				end if;
				if pviaso(irc) and pbestcost(irc)>pbestcost(iso)+1 then
					pbestcost(irc):=pbestcost(iso)+1;
					ndelta:=ndelta+1;
				end if;
				if pviaea(irc) and pbestcost(irc)>pbestcost(iea)+1 then
					pbestcost(irc):=pbestcost(iea)+1;
					ndelta:=ndelta+1;
				end if;
				if pviawe(irc) and pbestcost(irc)>pbestcost(iwe)+1 then
					pbestcost(irc):=pbestcost(iwe)+1;
					ndelta:=ndelta+1;
				end if;
			end loop; --leftward

		end loop; --upward


	end loop; --while ndelta

	pvalid:=(others=>false);
	for row in 2..nrows-1 loop
		for col in 2..ncols-1 loop
			irc:=indx(row,col);
			cost:=pbestcost(irc);
			if cost<usinf/2 then
				pvalid(irc):=true;
			end if;
		end loop;
	end loop;


end dppuller;















procedure dumpvalid is
	ii : ushort;
	goal,wall,val,box: boolean;
begin

if false then
	put_line("  Layout [v=>Pvalid]:");
	for row in 1..nrows loop
	for col in 1..ncols loop

		ii:=indx(row,col);
		goal := (ff(ii)=2);
		wall := (ff(ii)=1);
		box  := (vf(ii)=1);
		val := pvalid(ii);

		if val then put("v");
		elsif wall then put("#");
		else put(" "); end if;

	end loop;
	new_line;
	end loop; --row
	new_line;
end if;


	put_line("  Layout [g/v=>Bvalid; *=Goal+Box+Valid]:");
	for row in 1..nrows loop
	for col in 1..ncols loop

		ii:=indx(row,col);
		goal := (ff(ii)=2);  --backwardGoal=forwardBox
		wall := (ff(ii)=1);
		box  := (ovf(ii)=1); --backward box
		val := bvalid(ii);

		if box and goal then put("*");
		elsif box then put("g"); --forwardGoal=backwardBox
		elsif val then put("v");
		elsif wall then put("#");
		else put(" "); end if;

	end loop;
	new_line;
	end loop; --row
	new_line;


end dumpvalid;









-- NEXUS...
-- Clearly, a search should save state whenever a box
-- reaches a tunnel-intersection to allow a turn.
-- We generalize this notion slightly, and then
-- extend this to include all opencells
-- adjacent to a nexus cell.
--
-- First, identify cells with 3 or 4 approach directions
-- and 3 to 4 corner walls:
--
-- 6aug16:  added Goal cells to definition of nexus cell
--
-- remember:  dont worry about corners;  a reverse solution
--            automatically avoids them!
--
procedure findnexii is
	nap: ubyte;
	irc,ino,iso,iea,iwe,ine,ise,inw,isw: ushort;
	nbor,diag : boolean;
begin
	xtunn:=(others=>false);
	nappch:=(others=>0);

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		irc:=indx(row,col);
		ino:=indx(row-1,col);
		iso:=indx(row+1,col);
		iea:=indx(row,col+1);
		iwe:=indx(row,col-1);

		if ff(irc)/=1 and ff(ino)/=1 then nappch(irc):=nappch(irc)+1; end if;
		if ff(irc)/=1 and ff(iso)/=1 then nappch(irc):=nappch(irc)+1; end if;
		if ff(irc)/=1 and ff(iea)/=1 then nappch(irc):=nappch(irc)+1; end if;
		if ff(irc)/=1 and ff(iwe)/=1 then nappch(irc):=nappch(irc)+1; end if;

	end loop;
	end loop;



	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		irc:=indx(row,col);
		ino:=indx(row-1,col);
		iso:=indx(row+1,col);
		iea:=indx(row,col+1);
		iwe:=indx(row,col-1);
		ise:=indx(row+1,col+1);
		inw:=indx(row-1,col-1);
		ine:=indx(row-1,col+1);
		isw:=indx(row+1,col-1);

		nap:=0;
		if ff(ino)/=1 and nappch(ino)>1 then nap:=nap+1; end if;
		if ff(iso)/=1 and nappch(iso)>1 then nap:=nap+1; end if;
		if ff(iea)/=1 and nappch(iea)>1 then nap:=nap+1; end if;
		if ff(iwe)/=1 and nappch(iwe)>1 then nap:=nap+1; end if;

		if
			ff(ise)=1 and ff(inw)=1 and 
			ff(ine)=1 and ff(isw)=1 and
			nap>=3 and
			--ee(irc)<256
			pvalid(irc)
		then
			-- intersection of 2 tunnels...
			xtunn(irc):=true; --highest strategic value
		end if;



		diag:=false; -- walls diagonally-opposite
		if ff(ise)=1 and ff(inw)=1 then diag:=true; end if;
		if ff(ine)=1 and ff(isw)=1 then diag:=true; end if;

		--1jun18 addendum:  also include single tunnel entrances:
		nbor:=false; -- neighboring walls @ tunnel entrance
		if ff(ine)=1 and ff(inw)=1 then nbor:=true; end if;
		if ff(ise)=1 and ff(isw)=1 then nbor:=true; end if;
		if ff(ine)=1 and ff(ise)=1 then nbor:=true; end if;
		if ff(inw)=1 and ff(isw)=1 then nbor:=true; end if;


		if
			(nap>=4 and diag and pvalid(irc)) --ee(irc)<256)
			or
			(nap>=4 and nbor and pvalid(irc)) --ee(irc)<256)

			or (ff(irc)=2) --goal_cell
			or xtunn(irc)
		then
			nexus(irc):=true; --good strategic value
		end if;

	end loop;
	end loop;

	vtunl := (others=>true);
	htunl := (others=>true);

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		irc:=indx(row,col);
		ino:=indx(row-1,col);
		iso:=indx(row+1,col);
		iea:=indx(row,col+1);
		iwe:=indx(row,col-1);

		if 
			( nexus(ino) or nexus(iso) or --adjacent
			  nexus(iea) or nexus(iwe) or --adjacent
			  nexus(irc) ) --nexus itself
			and ff(irc)/=1                             --not wall
			--and ee(irc)<256                           --valid
			and pvalid(irc)
		then
			--identify ExtendedNexii (adjacent to nexii):
			enexus(irc):=true; --some strategic value
		end if;

		--identify vertical/horizontal tunnels:
		--if ee(irc)<256 then
		if pvalid(irc) then
			vtunl(irc):=bwallright(row,col) and bwallleft(row,col);
			htunl(irc):=bwallup(row,col) and bwalldown(row,col);
		end if;

	end loop;
	end loop;


	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		irc:=indx(row,col);
		bnexus(irc) := bvalid(irc) and enexus(irc);
	end loop;
	end loop;



end findnexii;












end emutils; --package

