with emhungarian;
with splaytree;
with splaylist;
with splaypq;
with text_io;

with interfaces.c;
with ada.strings.fixed;
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 interfaces.c;
	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;






	function citrim( i: interfaces.c.int ) return string is
	begin
		return ada.strings.fixed.trim( 
		interfaces.c.int'image(i), ada.strings.left);
	end citrim;



	function itrim( i: integer ) return string is
	begin
		return ada.strings.fixed.trim( integer'image(i), ada.strings.left);
	end itrim;

	function utrim( i: ushort ) return string is
	begin
		return ada.strings.fixed.trim( ushort'image(i), ada.strings.left);
	end utrim;

	function ubtrim( i: ubyte ) return string is
	begin
		return ada.strings.fixed.trim( ubyte'image(i), ada.strings.left);
	end ubtrim;









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


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
























-- necessary to test for win_key:
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 ">";





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





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





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



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

	ppath:=(others=>' ');

	if 
		np<250 --ubinf
		and np>0
	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 => 
					raise program_error;

			end case;

			if rr<1 or cc<1 then 
				raise program_error;
			elsif rr>nrows or cc>ncols then
				raise program_error;
			end if;

		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;






-- define puller corral and find the index of its upper left
-- corner using relaxation (flood-fill)
-- Assumes VF/FF are current.
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;

	corral, cviano, cviaso, cviaea, cviawe : booltype;
	fff: vftype;

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 pvalid(ic) then --31oct18
			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;



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);
		--1if ee(irc)<256 then
		if pvalid(irc) then --31oct18
			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 --31oct18
			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 --31oct18
			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 --31oct18
			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)) );

--put_line("UL corner of winning puller corral @ ("
--&ushort'image(rul)&","&ushort'image(cul)&"), coded as"
--&ubyte'image(ulkey));

end dpwcorral;






-- This one is used internally by "document":
-- define puller domain using relaxation (flood-fill)
procedure dppathprep(
	vf: vftype;
	r0,c0 : ushort;--puller.pos
	bestcost, bestpred: out vftype
	) is

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

	fff: vftype;
	viano,viaso,viaea,viawe: booltype;



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

			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;



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 --downward
		for col in 2..ncols-1 loop --rightward
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then --31oct18
			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; --col
	end loop; --row


		-- now sweep back
	for row in reverse 2..nrows-1 loop --upward
		for col in reverse 2..ncols-1 loop --leftward
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then --31oct18
			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; --col
	end loop; --row

end loop; --while ndelta


end dppathprep;






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

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


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

			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;



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 --downward
		for col in 2..ncols-1 loop --rightward
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then --31oct18
			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; --col
	end loop; --row


		-- now sweep back
	for row in reverse 2..nrows-1 loop --upward
		for col in reverse 2..ncols-1 loop --leftward
		irc:=indx(row,col);
		--if ee(irc)<256 then
		if pvalid(irc) then --31oct18
			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; --col
	end loop; --row

end loop; --while ndelta


end dppathprep;



--//////////////////////// bx.cc::695 ////////////////////////////


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




kbest, kmax, bestcfg : integer := 0;

function setwinkey( 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;

--put_line("win_key="&ulong'image(win_suma)
--&":"&ulong'image(win_sumb)&":"&ulong'image(win_sumc)
--&":"&ubyte'image(wpkey));

	return key;

end setwinkey;





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

-- these test box-move feasibility


function testleft(br,bc:ushort) return boolean is
	i1 : ushort := indx(br,bc-1); --newboxpos=oldPullerPos
	i2 : ushort := indx(br,bc-2); --newpullerpos
begin
if bc-2>1 and then (bvalid(i1) and pvalid(i2))
then

	if vf(i2)=1 or vf(i1)=1  then 
		return false;

	else 
		return true;
	end if;

else
	return false;
end if;
end testleft;

function testright(br,bc:ushort) return boolean is
	i1 : ushort := indx(br,bc+1); --newboxpos=oldPullerPos
	i2 : ushort := indx(br,bc+2); --newpullerpos
begin
if bc+2<ncols and then (bvalid(i1) and pvalid(i2))
then

	if vf(i2)=1 or vf(i1)=1   then 
		return false;

	else 
		return true;
	end if;

else
	return false;
end if;
end testright;





function testdown(br,bc:ushort) return boolean is
	i1 : ushort := indx(br+1,bc); --newboxpos=oldPullerPos
	i2 : ushort := indx(br+2,bc); --newpullerpos
begin
if br+2<nrows and then (bvalid(i1) and pvalid(i2))
then

	if vf(i2)=1 or vf(i1)=1   then 
		return false;

	else
		return true;
	end if;

else
	return false;
end if;

end testdown;

function testup(br,bc:ushort) return boolean is
	i1 : ushort := indx(br-1,bc); --newboxpos=oldPullerPos
	i2 : ushort := indx(br-2,bc); --newpullerpos
begin
if br-2>1 and then (bvalid(i1) and pvalid(i2))
then

	if vf(i2)=1 or vf(i1)=1   then 
		return false;

	else
		return true;
	end if;

else
	return false;
end if;
end testup;






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


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;










-- NOTE:  I have now specialized this to box-PULLs;
--        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;


	hviano,hviaso,hviaea,hviawe: booltype;
	hfff, hbestcost: vftype;


--prepare to test pull-feasibility
procedure initdpbox is
	use text_io;
	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 off(ic)=1  then hfff(ic):=1;  end if;
		hbestcost(ic):=255; --usinf; -- 9999 (was 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;




begin --dpbox

	initdpbox;

	for row in 2..nrows-1 loop --downward
	for col in 2..ncols-1 loop --rightward
		ip:=indx(row,col);
		if 
			ovf(ip)=1  --original GOAL
		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

	nbvalid:=0;
	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<usinf/2  and pvalid(irc) then --fix 16dec20
				bvalid(irc):=true;
				nbvalid:=nbvalid+1;
			end if;
		end loop;
	end loop;

	remdead; 
	--removes a few more wall-positions from bvalid

-- Note that "bvalid" is NOT a minimal set of locations
-- where boxes reside without deadlock; It is a convenience
-- to define a domain where manhattan distances define 
-- minimal cost of traversal.


end dpbox;











procedure readPuzzle( lvl1: integer ) is

  gfil : file_type;
  l1,l2: natural := 1;
  rcd1, rcd2: string(1..9999);
  lv : integer := 1;
  lc, nrcpt : integer := 0;
	fp : ushort := 0;
	ii: ushort;
	sawleftwall:boolean;
	row,
	lrows, lcols: natural; --Local copies of nrows,ncols
begin



	myassert( lvl1 >= 1, 1001 );


	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(infilname),
			mode=>text_io.in_file);



	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;

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

--new_line;
--put_line(" ReadPuzzle Input Check...");
--put_line(" 1st line @ line#: "&integer'image(lc)); --line # in file

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

		if( l1>lcols ) then lcols:=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(ushort(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;

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

			when '@' =>  --pusher
				gpr:=ushort(row);
				gpc:=col;

			when '+' =>  -- goal+pusher, treat as box+pusher
				vf(ii):=1;
				gpr:=ushort(row);
				gpc:=col;

--NOTE:	for the reversed problem:
--			(gpr,gpc)=final-pos(puller)
--			while VF() represents initial-pos(ruby)
--			and FF() represents goals, walls, spaces


			when '*' =>  -- both goal and barrel
				ff(ii):=2; nboxes:=nboxes+1;
				vf(ii):=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;

myassert(fp<256, 30303, "puzzle too large");

				if fp<=255 then --add to list of valid interior locations
					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 --25
			put_line("nrows="&integer'image(lrows));
			put_line(rcd2(1..l2));
			put_line("####################");
			raise data_error;
		end if;


	end loop;

	nrows:=ushort(lrows);
	ncols:=ushort(lcols);

   text_io.close(gfil);

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


	off:=ff;
	ovf:=vf; --preserve Original BoxPos = pullerGoals
	dppuller; -- defines pvalid
	dpbox; --uses ovf,off
	--generate bvalid, nbvalid, calls remdead
	--remdead; -- removes corner or dead cells from bvalid

-- Note that "bvalid" is NOT a minimal set of locations
-- where boxes reside without deadlock; It is a convenience
-- to define a domain where manhattan distances define 
-- minimal cost of traversal.




	dpwcorral(gpr,gpc, win_pulkey);
	win_key := setwinkey(win_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

		ii:=indx(r,c);

		dppathprep(r,c,bestcost,bestpred); -- needed to use testup,testdown, etc
		-- assuming puller @ (r,c), set bestcost(rr,cc)
		-- for all locations in same corral.


		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) --31oct18

			and --adjacent to pullable box:
		(
			(vf(indx(r-1,c))=1 and testdown(r-1,c)) --box above
			or
			(vf(indx(r+1,c))=1 and testup(r+1,c))   --box below
			or
			(vf(indx(r,c+1))=1 and testleft(r,c+1)) --box@right
			or
			(vf(indx(r,c-1))=1 and testright(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 readPuzzle;









procedure checkForUserFile( 
	ok: out boolean
	) is
begin

	ok:=false;

	-- here we process 2 cmdline args: infilname, flev
   if Ada.Command_Line.Argument_Count =2 then
   
     declare
       lst: natural;
       fstr : string := Ada.Command_Line.Argument(1);--File
       nstr : string := Ada.Command_Line.Argument(2);--# to open 1st
     begin

       infilname := to_unbounded_string(fstr);
       myint_io.get(nstr,level,lst);
		 increment:=1;
		 ok:=true;

     end; --declare


	else

		put_line("2 parameters are expected:");
		put_line("1) filename,");
		put_line("2) # level-to-solve");

   end if;


end checkForUserFile;











procedure checkForUserFile( 
	ok: out boolean; 
	uMaxGb: in out float;
	pushOpt: in out boolean;
	omitHungarian: in out boolean
	) is
	flag: integer;
begin

	ok:=false;

	set_unbounded_string(outfilname,"");

	-- here we process 2 cmdline args: infilname, flev
   if Ada.Command_Line.Argument_Count =2 then
   
     declare
       lst: natural;
       fstr : string := Ada.Command_Line.Argument(1);--File
       nstr : string := Ada.Command_Line.Argument(2);--# to open 1st
     begin

       infilname := to_unbounded_string(fstr);
       myint_io.get(nstr,level,lst);
		 increment:=1;
		 ok:=true;

     end; --declare

	-- process 3 args: infilname, flev, mxGb
	elsif Ada.Command_Line.Argument_Count = 3 then

     declare
       lst: natural;
       fstr : string := Ada.Command_Line.Argument(1);--File
       nstr : string := Ada.Command_Line.Argument(2);--level
       istr : string := Ada.Command_Line.Argument(3);--Gb
     begin

       infilname := to_unbounded_string(fstr);
       myint_io.get(nstr,level,lst);
		 myfloat_io.get(istr,uMaxGb,lst);
		 ok:=true;

     end; --declare



	-- process 4 args: 
	-- 1) infilname, 
	-- 2) flev, 
	-- 3) mxGb, 
	-- 4) optimal(0=no, 1=yes, 2=nonHung)
	elsif Ada.Command_Line.Argument_Count = 4 then

     declare
       lst: natural;
       fstr : string := Ada.Command_Line.Argument(1);--File
       nstr : string := Ada.Command_Line.Argument(2);--level
       istr : string := Ada.Command_Line.Argument(3);--Gb
       pstr : string := Ada.Command_Line.Argument(4);--flag
     begin

       infilname := to_unbounded_string(fstr);
       myint_io.get(nstr,level,lst);
		 myfloat_io.get(istr,uMaxGb,lst);
       myint_io.get(pstr,flag,lst);
		 if flag=0 then pushOpt:=false;
		 elsif flag=1 then pushOpt:=true; 
		 elsif flag=2 then omitHungarian:=true; end if;
		 ok:=true;

     end; --declare





	-- process 5 args: 
	-- 1) infilname, 
	-- 2) flev, 
	-- 3) mxGb, 
	-- 4) optimal(0=no,1=yes,2=nonHung)
	-- 5) outfilname
	elsif Ada.Command_Line.Argument_Count = 5 then

     declare
       lst: natural;
       fstr : string := Ada.Command_Line.Argument(1);--inFile
       nstr : string := Ada.Command_Line.Argument(2);--level
       istr : string := Ada.Command_Line.Argument(3);--Gb
       pstr : string := Ada.Command_Line.Argument(4);--0/1/2 flag

       ostr : string := Ada.Command_Line.Argument(5);--OutFile

     begin

--put_line(ostr);

       infilname := to_unbounded_string(fstr);
       myint_io.get(nstr,level,lst);
		 myfloat_io.get(istr,uMaxGb,lst);
       myint_io.get(pstr,flag,lst);
		 if flag=0 then pushOpt:=false;
		 elsif flag=1 then pushOpt:=true; 
		 elsif flag=2 then omitHungarian:=true; end if;
		 outfilname:= to_unbounded_string(ostr);
		 ok:=true;

--put(integer'image(level)); new_line;
--put(float'image(uMaxGb)); new_line;
--put(integer'image(flag)); new_line;
--put_line( to_string( outfilname ) );

     end; --declare




	else

		put_line("2..5 parameters are expected:");
		put_line("1) filename,");
		put_line("2) # level-to-solve");
		put_line("3) MaxGb memory to use (default=7.5)");

		put_line("4) method [int=0,1,2] ...");
		put_line("   0=>Fastest (default)");
		put_line("   1=>Efficient");
		put_line("   2=>Non-Hungarian");

		put_line("5) outputFileName");

   end if;

end checkForUserFile;









procedure restore2( vf: in out vftype; rec : hashrectype;  pr,pc : out ushort ) is
	ii: ushort;
	js: ushort;
	jb: ubyte;
	k: ushort:=0;
begin

	vf := (others=>0);
	k:=0;
	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop
		ii := indx(row,col);
		js := ee(ii);
		if js<256 then
			jb:=ubyte(js);
			if rec.vfsave(jb)=true then vf(ii):=1; end if;
		end if;
		if vf(ii)=1 then k:=k+1; end if;
	end loop;
	end loop;
	pr := ushort(rec.prsave);
	pc := ushort(rec.pcsave);

end restore2;







-- 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 sdocument(
	solutionPath: in out unbounded_string;
	key : keytype;
	nmoves, bmoves : in out ushort;
	firstcall: boolean
	) is

	use mysplaytype;
	status : mysplaytype.statustype;
	use mypqtype;
	fstatus: mypqtype.statustype;

	rec, prec : hashrectype;
	prkey : keytype;
	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);

	xvf, xbestcost, xbestpred: vftype;
begin --sdocument


	search( key, explored, rec, status ); -- direct accessor

	if not (status=found) then
	mypqtype.search(key, frontier, rec, fstatus);
	myassert( fstatus=found, 101, "docu line 1647");
	status:=found;
	end if;


	dir := rec.prevmove;

	if dir>=0 and dir<=3 then --keep recursing
		prkey := rec.prevkey;
		search( prkey, explored, prec, status );

		if not (status=found) then
		mypqtype.search(prkey, frontier, prec, fstatus);
		myassert( fstatus=found, 103, "docu line 1664");
		status:=found;
		end if;

		myassert(rec.totpulz>=prec.totpulz, 87778, "docu1673");
		pull:=ubyte( integer(rec.totpulz) - integer(prec.totpulz) );

--put("pull="&ubtrim(pull)); new_line;

		myassert(pull>=0, 87678, "docu line 1669");
	myassert(pull<=1, 87679, "docu line 2087"); --no
		bmoves := bmoves+ushort(pull);

		if status=found then

			prnext:=ushort(prec.prsave); -- = prev puller = new box
			pcnext:=ushort(prec.pcsave);
			opr := ushort(rec.prsave);
			opc := ushort(rec.pcsave);
			nstp:= ushort(pull);

			np0:=0;
			if firstcall then
				restore2(xvf,rec,xpr,xpc); 
				dppathprep(xvf,gpr,gpc, xbestcost,xbestpred);


--rdump0(xvf,opr,opc);   -- 5,5 --inPos for upward push
--put(utrim(gpr)&","&utrim(gpc));put("->");
--put(utrim(opr)&","&utrim(opc));new_line;
--put_line("----------------------------------------");



				dppath(opr,opc, np0, xbestcost,xbestpred);
				myassert(np0<ubinf, 89898);
				for k in 1..np0 loop 
					--put(fout, ppath(k));
					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 
					--put(fout,"D"); 
					append(solutionPath,'D');
					prnow:=prnow+1;
					end loop;
				elsif dir=1 then
					for i in 1..pull loop 
					--put(fout,"U"); 
					append(solutionPath,'U');
					prnow:=prnow-1; 
					end loop;
				elsif dir=2 then
					for i in 1..pull loop 
					--put(fout,"L"); 
					append(solutionPath,'L');
					pcnow:=pcnow-1; 
					end loop;
				elsif dir=3 then
					for i in 1..pull loop 
					--put(fout,"R"); 
					append(solutionPath,'R');
					pcnow:=pcnow+1; 
					end loop;
				else
					--put(fout,"X");
					append(solutionPath,'X');
				end if;
			end if;


			restore2(xvf,prec,xpr,xpc); --updates XVF
			myassert( (xpr=prnext) and (xpc=pcnext), 32322,"doc:2194");


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

				dppathprep(xvf,prnow,pcnow, xbestcost,xbestpred);
				dppath(prnext,pcnext, np, xbestcost,xbestpred);


				if np<250 and np>0 then
					for k in 1..np loop 
						--put(fout,ppath(k));
						append(solutionPath, ppath(k) );
					end loop;
					nmoves:=nmoves + ushort(np);
				else
					new_line;
					put_line("problem with puller traversal:");
					put("prnow : pcnow - prnxt : pcnxt => ");
					put(ushort'image(prnow));        --4
					put(":"&ushort'image(pcnow));    --6
					put(" - "&ushort'image(prnext)); --4
					put(":"&ushort'image(pcnext));   --4
					put(", np="&ubyte'image(np));
					new_line;
					myassert(np<ubinf, 98989);
				end if;

			end if;

			nmoves:=nmoves + nstp + ushort(np0);

			sdocument(solutionPath,prkey,nmoves,bmoves,false); --recursion

		end if;

	end if;

end sdocument;













-- 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 swinnertest(
	solutionPath: in out unbounded_string;
	key: keytype;  
	rec: hashrectype
	) is
	nmoves, bmoves: ushort:=0;
begin


	if key=win_key then

		winner:=true;

		tsec1:=ada.calendar.seconds(ada.calendar.clock);
		set_unbounded_string(solutionPath, "");
		sdocument(solutionPath,key,nmoves,bmoves,true);

	end if; --winner

end swinnertest;























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

















--Just for fun, here is the procedure that OMITS the
--Hungarian algorithm estimate to demonstrate its dramatic
--effect and power.
procedure saveifnew4e(
	rec:  hashrectype; 	
	key:  keytype;
	pmove: ushort;
	tboxpulls, tmoves : ushort;
	pr,pc, 			   --new puller pos
	br,bc            --prev puller pos = new box pos
		: ushort ) is

	use mysplaytype;
	use mypqtype;

	fkey : keytype := (0,0,0,0);
	frec,erec : hashrectype;
	eloc : etype;
	nbog,k,ii : ushort := 0;
	jb: ubyte;
	js: ushort;
	estatus: mysplaytype.statustype;
	fstatus: mypqtype.statustype;

	future: ushort;
	nontgt,
	itpul, ibog, nblbox,nblroom,nkoralz: integer;
	hok: boolean;

begin

--myassert(integer(tboxpulls)-integer(rec.totpulz)<=1, 8997,"2574.saveif");
--myassert((pr/=br)or(pc/=bc), 8998,"2467.saveif");
--myassert( vf(indx(br,bc))=1, 8999,"2468.saveif");



	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
				nbog:=nbog+1; --tally boxes on goals
			end if;
		end if;
		js:=ee(ii);
		if js<256 then
			jb:=ubyte(js);
			if vf(ii)=1 then frec.vfsave(jb):=true; end if;
		end if;
	end loop;
	end loop;

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




	--calculate childKEY = fkey

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

	-- uses puller-pos & current VF, FF to define pulkey:
	dpcorral(pr,pc, fkey.pulkey);

	mysplaytype.search( fkey, explored, erec, estatus );

-- go no further if already in {explored}:
if estatus=notfound then

	mypqtype.search( fkey, frontier, frec, fstatus );

	if fstatus=found then
	--note: equal keys => equal cfg => equal future, equal nbog

		if 
			(tboxpulls<frec.totpulz) --o2=16.4
			or ((tmoves<frec.totmovz) and (tboxpulls<=frec.totpulz)) --o2=31
		then
		--redefine frec in {frontier} with lower [more urgent] priority

--this happens a lot!
--put(" F-rev");

			-- note that same config => same calculation of "future"
			frec.totmovz:=tmoves;
			frec.totpulz:=tboxpulls;
			itpul:=integer(tboxpulls);

			frec.prsave:=ubyte(pr);
			frec.pcsave:=ubyte(pc);

		frec.brsave:=ubyte(br);
		frec.bcsave:=ubyte(bc);

			frec.prevmove := ubyte(pmove);
			frec.prevkey := key;

			--new priority changer:
			mypqtype.bumpKey(frontier,fkey,frec,itpul,fstatus);

		end if;
		


	else --nominal case: insert node into {Frontier} in Pri-order



		--generate Hung.Alg. pairing
		emhungarian.setboxes(vf);
		future:=emhungarian.evalpairings(nOnTgt,hok);

		ibog := integer(nboxes) - nOnTgt;

		itpul := integer(tboxpulls); -- + integer(future);



		if skip3 then
			nkoralz:=0;
			nblroom:=0;
			nblbox :=0;
		else
			nkoralz := fcountCorrals(vf) - 1;
			nblroom := fcountRoomBlocks; --Forward
			nblbox  := fcountBlockedBoxes;
		end if;



		if itpul<700 and hok then


			frec.brsave:=ubyte(br);
			frec.bcsave:=ubyte(bc);

			frec.prsave:=ubyte(pr);
			frec.pcsave:=ubyte(pc);

			frec.prevmove := ubyte(pmove);
			frec.prevkey := key;
			frec.totpulz := tboxpulls;
			frec.totmovz := tmoves;


			mypqtype.addnode(fkey,frec,
				ibog, nkoralz, nblroom, nblbox,
				itpul,frontier,fstatus );



			--key:=fkey; -- update in DFS
			--rec:=frec;

		end if; --hok


	end if; -- not seen

end if; --estatus=notFound


end saveifnew4e;








procedure hsaveifnew4e(
	rec:  hashrectype; 	
	key:  keytype;
	pmove: ushort;
	tboxpulls, tmoves : ushort;
	pr,pc, 			   --new puller pos
	br,bc            --prev puller pos = new box pos
		: ushort ) is

	use mysplaytype;
	use mypqtype;

	fkey : keytype := (0,0,0,0);
	frec,erec : hashrectype;
	eloc : etype;
	nbog,k,ii : ushort := 0;
	jb: ubyte;
	js: ushort;
	estatus: mysplaytype.statustype;
	fstatus: mypqtype.statustype;

	future: ushort;
	nontgt,
	itpul, ibog, nblbox,nblroom,nkoralz: integer;
	hok: boolean;

begin

--myassert(integer(tboxpulls)-integer(rec.totpulz)<=1, 8997,"2574.saveif");
--myassert((pr/=br)or(pc/=bc), 8998,"2467.saveif");
--myassert( vf(indx(br,bc))=1, 8999,"2468.saveif");



	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
				nbog:=nbog+1; --tally boxes on goals
			end if;
		end if;
		js:=ee(ii);
		if js<256 then
			jb:=ubyte(js);
			if vf(ii)=1 then frec.vfsave(jb):=true; end if;
		end if;
	end loop;
	end loop;

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




	--calculate childKEY = fkey

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

	-- uses puller-pos & current VF, FF to define pulkey:
	dpcorral(pr,pc, fkey.pulkey);

	mysplaytype.search( fkey, explored, erec, estatus );

-- go no further if already in {explored}:
if estatus=notfound then

	mypqtype.search( fkey, frontier, frec, fstatus );

	if fstatus=found then
	--note: equal keys => equal cfg => equal future, equal nbog

		if 
			(tboxpulls<frec.totpulz) --o2=16.4
			or ((tmoves<frec.totmovz) and (tboxpulls<=frec.totpulz)) --o2=31
		then
		--redefine frec in {frontier} with lower [more urgent] priority

--this happens a lot!
--put(" F-rev");

			-- note that same config => same calculation of "future"
			frec.totmovz:=tmoves;
			frec.totpulz:=tboxpulls;
			itpul:=integer(tboxpulls);

			frec.prsave:=ubyte(pr);
			frec.pcsave:=ubyte(pc);

		frec.brsave:=ubyte(br);
		frec.bcsave:=ubyte(bc);

			frec.prevmove := ubyte(pmove);
			frec.prevkey := key;

			--new priority changer:
			mypqtype.bumpKey(frontier,fkey,frec,itpul,fstatus);

		end if;
		


	else --nominal case: insert node into {Frontier} in Pri-order



		--generate Hung.Alg. pairing
		emhungarian.setboxes(vf);
		future:=emhungarian.evalpairings(nOnTgt,hok);

		ibog := integer(nboxes) - nOnTgt;

		itpul := integer(tboxpulls) + integer(future);



		if skip3 then
			nkoralz:=0;
			nblroom:=0;
			nblbox :=0;
		else
			nkoralz := fcountCorrals(vf) - 1;
			nblroom := fcountRoomBlocks; --Forward
			nblbox  := fcountBlockedBoxes;
		end if;



		if itpul<700 and hok then


			frec.brsave:=ubyte(br);
			frec.bcsave:=ubyte(bc);

			frec.prsave:=ubyte(pr);
			frec.pcsave:=ubyte(pc);

			frec.prevmove := ubyte(pmove);
			frec.prevkey := key;
			frec.totpulz := tboxpulls;
			frec.totmovz := tmoves;


			mypqtype.addnode(fkey,frec,
				ibog, nkoralz, nblroom, nblbox,
				itpul,frontier,fstatus );



			--key:=fkey; -- update in DFS
			--rec:=frec;

		end if; --hok


	end if; -- not seen

end if; --estatus=notFound


end hsaveifnew4e;







procedure hsaveifnew4(
	rec:  hashrectype; 	
	key:  keytype;
	pmove: ushort;
	tboxpulls, tmoves : ushort;
	pr,pc, 			   --new puller pos
	br,bc            --prev puller pos = new box pos
		: ushort ) is

	use mysplaytype;
	use mypqtype;

	fkey : keytype := (0,0,0,0);
	frec,erec : hashrectype;
	eloc : etype;
	nbog,k,ii : ushort := 0;
	jb: ubyte;
	js: ushort;
	estatus: mysplaytype.statustype;
	fstatus: mypqtype.statustype;

	future: ushort;
	nontgt,
	itpul, ibog, nblbox,nblroom,nkoralz: integer;
	hok: boolean;

begin

--myassert(integer(tboxpulls)-integer(rec.totpulz)<=1, 8997,"2574.saveif");
--myassert((pr/=br)or(pc/=bc), 8998,"2467.saveif");
--myassert( vf(indx(br,bc))=1, 8999,"2468.saveif");



	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
				nbog:=nbog+1; --tally boxes on goals
			end if;
		end if;
		js:=ee(ii);
		if js<256 then
			jb:=ubyte(js);
			if vf(ii)=1 then frec.vfsave(jb):=true; end if;
		end if;
	end loop;
	end loop;

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




	--calculate childKEY = fkey

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

	-- uses puller-pos & current VF, FF to define pulkey:
	dpcorral(pr,pc, fkey.pulkey);

	mysplaytype.search( fkey, explored, erec, estatus );

-- go no further if already in {explored}:
if estatus=notfound then

	mypqtype.search( fkey, frontier, frec, fstatus );

	if fstatus=found then
	--note: equal keys => equal cfg => equal future, equal nbog

		if 
			(tboxpulls<frec.totpulz) --o2=16.4
			--or ((tmoves<frec.totmovz) and (tboxpulls<=frec.totpulz)) --o2=31
		then
		--redefine frec in {frontier} with lower [more urgent] priority

--this happens a lot!
--put(" F-rev");

			-- note that same config => same calculation of "future"
			frec.totmovz:=tmoves;
			frec.totpulz:=tboxpulls;
			itpul:=integer(tboxpulls);

			frec.prsave:=ubyte(pr);
			frec.pcsave:=ubyte(pc);

		frec.brsave:=ubyte(br);
		frec.bcsave:=ubyte(bc);

			frec.prevmove := ubyte(pmove);
			frec.prevkey := key;

			--new priority changer:
			mypqtype.bumpKey(frontier,fkey,frec,itpul,fstatus);

		end if;
		


	else --nominal case: insert node into {Frontier} in Pri-order



		--generate Hung.Alg. pairing
		emhungarian.setboxes(vf);
		future:=emhungarian.evalpairings(nOnTgt,hok);

		ibog := integer(nboxes) - nOnTgt;

		itpul := integer(tboxpulls) + integer(future);



		if skip3 then
			nkoralz:=0;
			nblroom:=0;
			nblbox :=0;
		else
			nkoralz := fcountCorrals(vf) - 1;
			nblroom := fcountRoomBlocks; --Forward
			nblbox  := fcountBlockedBoxes;
		end if;



		if itpul<700 and hok then


			frec.brsave:=ubyte(br);
			frec.bcsave:=ubyte(bc);

			frec.prsave:=ubyte(pr);
			frec.pcsave:=ubyte(pc);

			frec.prevmove := ubyte(pmove);
			frec.prevkey := key;
			frec.totpulz := tboxpulls;
			frec.totmovz := tmoves;


			mypqtype.addnode(fkey,frec,
				ibog, nkoralz, nblroom, nblbox,
				itpul,frontier,fstatus );



			--key:=fkey; -- update in DFS
			--rec:=frec;

		end if; --hok


	end if; -- not seen

end if; --estatus=notFound


end hsaveifnew4;














































procedure sort is --just bubble

	procedure swap(i,j: boxrng) is
		s: boxrng;
	begin
		s:=permute(i); permute(i):=permute(j); permute(j):=s;
	end swap;

	swapped: boolean;
	n: ushort;

begin

	n:=nboxes;

	for i in 1..n loop --init permutation array
		permute(i):=i;
	end loop;

	main:
	loop
		swapped:=false;
		for i in 2..n loop
			if dist2goal(permute(i-1))>dist2goal(permute(i)) then
				swap(i-1,i); swapped:=true;
			end if;
		end loop;
		n:=n-1;
		exit main when n<2;
		exit main when not swapped;
	end loop main;


end sort;


function manhattan(r1,c1,r2,c2: integer) return integer is
begin
	return abs(c2-c1)+abs(r2-r1);
end manhattan;











-- defines pvalid
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; -- usmx-1 = 65535-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;




-- defines pvalid
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 or vf(ip)=1 then --goal/box=>"interior"
			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;






--removes a few more wall-positions from bvalid
procedure remdead is

	function golat(r,c:ushort) return boolean is
	begin
		return (ovf(indx(r,c))=1);
		--return (off(indx(r,c))=2); --24jan21 fail @ t7
	end golat;
	function walat(r,c:ushort) return boolean is
	begin
		return (off(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 (eg b10)
	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;









function wallleft(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 wallleft;

function wallright(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 wallright;

function walldown(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 walldown;

function wallup(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 wallup;









-- 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):=wallright(row,col) and wallleft(row,col);
			htunl(irc):=wallup(row,col) and walldown(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;





procedure dumpnex is
	ii : ushort;
	wall: boolean;
begin

	put_line("         Enexus Cells");
	for row in 1..nrows loop
	for col in 1..ncols loop

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

		if nexus(ii) then put(" n");
		--elsif enexus(ii) then put(" e");
		elsif bnexus(ii) then put(" b");
		elsif wall then put(" #");
		--elsif pvalid(ii) then put("v");
		else put("  "); end if;

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

end dumpnex;





procedure hsave0(
vf,ff:vftype; 
nrows,ncols: ushort;
ee:vustype; pvalid:booltype;
omitHung: boolean
) is
	use mypqtype;
	irec : hashrectype;
	zkey : constant keytype := (0,0,0,0);
	nukey : keytype:=(0,0,0,0);
	eloc : etype;
	k  : ushort := 0;
	ii : ushort;
	jb: ubyte;
	future, js: ushort;
	hok: boolean;
	itpul,nOnTgt,
	ibog,nkoralz,
	nblroom,nblbox,
	ilf1: integer;
	pqstatus: mypqtype.statustype;
	estatus: mysplaytype.statustype;
	xbestcost, xbestpred: vftype;
begin --save0

	nOnTgt:=0;
	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) );
			if ff(ii)=2 then nOnTgt:=nOnTgt+1; end if;
		end if;
	end loop;
	end loop; --row
	myassert(nboxes=k, 81818, "hsave0::3518");

	-- first 3 fields in nukey are same for all CFGs:
	bitrep(k,eloc, nukey.suma, nukey.sumb, nukey.sumc);

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




	-- added 12dec20 @ 3:00 pm
	mysplaytype.make_empty(explored,estatus);
	mypqtype.make_empty(frontier,pqstatus);

	emhungarian.setboxes(vf);
	future:=emhungarian.evalpairings(nOnTgt, hok);
myassert(hok, 81818,"hsave0::3398");

	if omitHung then
		itpul:=0;
	else
		itpul := integer(future);
	end if;

--put("itpul0=");
--put(itrim(itpul)); put(" ?<= ");
--put(itrim(utiltypes.maxpri0)); 
--new_line; --617forMP21

myassert(itpul<=utiltypes.maxpri0, 
	81810,"hsave0::3408, Hun.future>maxpri0");

	ibog := integer(nboxes) - nOnTgt;

	nkoralz := fcountCorrals(vf) - 1;
	nblroom := fcountRoomBlocks; --Forward
	nblbox  := fcountBlockedBoxes;
	--irec.vfsave is defined above
	irec.prevkey:=zkey;
	irec.prevmove:=9;
	irec.totpulz:=0;
	irec.totmovz:=0;

	dppathprep(gpr,gpc,xbestcost,xbestpred);

	-- save configs for each possible start pos of puller
	-- (end pos of pusher):
	for i in 1..pfmax loop

		-- here, define the 2 remaining fields in irec, 
		-- and the 4th component "pulkey" of key:

		irec.prsave:=ubyte(prfinal(i));
		irec.pcsave:=ubyte(pcfinal(i));

		irec.totmovz:=dppathexists(prfinal(i),pcfinal(i),xbestcost);

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

		-- k = #boxes - #boxesOnGoal
		mypqtype.addnode( nukey, irec, 
			ibog, nkoralz, nblroom, nblbox,
			itpul, frontier, pqstatus);

		myassert((pqstatus=ok)or(pqstatus=dupid),113,"PQaddnode error" );

	end loop; -- i

	ilf1:=mypqtype.length(frontier);


--put("hsave0: ilf1="&itrim(ilf1));
--new_line;


end hsave0;










-- Count adverse blockages of a box. The name
-- may be imprecise but it allows a quicker algorithm.
-- The measure seems to be effective whatever it does:
function fcountBlockedBoxes return integer is
	oldk, k,g, ns: integer:=0;
	rc,no,so,ea,we: ushort;
	bno,bso,bea,bwe: boolean;
begin

for row in 2..nrows-1 loop
for col in 2..ncols-1 loop
	rc:=indx(row,col);
	no:=indx(row-1,col);
	so:=indx(row+1,col);
	ea:=indx(row,col+1);
	we:=indx(row,col-1);

	oldk:=k;
---------------------------------------------------------
-- note that this uses
--			ff()=2 to indicate a GOAL
--       vf()=1 to indicate BOX
---------------------------------------------------------

--as of 22jan21 we discount boxes on goals:

	if vf(rc)=1 then --this is a box
	--if vf(rc)=1 and ff(rc)=0 then --this is a box NOT on goal
		ns:=0; bno:=false; bso:=false; bea:=false; bwe:=false;
		if vf(we)=1 or ff(we)=1 then ns:=ns+1; bwe:=true; end if;
		if vf(ea)=1 or ff(ea)=1 then ns:=ns+1; bea:=true; end if;
		if vf(no)=1 or ff(no)=1 then ns:=ns+1; bno:=true; end if;
		if vf(so)=1 or ff(so)=1 then ns:=ns+1; bso:=true; end if;

		-- if blocked on 3 sides OR 2-adjacent sides => blocked
		if 
			ns>2 or
			(bno and bea) or
			(bea and bso) or
			(bso and bwe) or
			(bwe and bno)
		then
			k:=k+1;
			if ff(rc)=2 then g:=g+1; end if;
		end if; --this is a blocked box

	end if; --box

	--if k>oldk then put_line(utrim(row)&","&utrim(col)); end if;

end loop;
end loop;

k:=k - g/2; -- discount 50%

return k;

end fcountBlockedBoxes;





-- Count adverse blockages of openings. The name
-- may be imprecise but it allows a quicker algorithm.
-- The measure seems to be effective whatever it does:
function fcountRoomBlocks return integer is
	oldk, g,k: integer:=0;
	rc,no,so,ea,we,nw,ne,se,sw: ushort;
	fno,fso,fea,fwe,fne,fse,fsw,fnw: boolean;
begin

---------------------------------------------------------
-- note that this uses
--			ff()=2 to indicate a GOAL
--       vf()=1 to indicate BOX
---------------------------------------------------------
for row in 2..nrows-1 loop
for col in 2..ncols-1 loop
rc:=indx(row,col);
if vf(rc)=1 then
--as of 22jan21 we discount boxes on goals by 50%:
--if vf(rc)=1 and ff(rc)=0 then --box NOT on a goal
	no:=indx(row-1,col);
	so:=indx(row+1,col);
	ea:=indx(row,col+1);
	we:=indx(row,col-1);
	nw:=indx(row-1,col-1);
	se:=indx(row+1,col+1);
	ne:=indx(row-1,col+1);
	sw:=indx(row+1,col-1);
	fno:=ff(no)=1;
	fso:=ff(so)=1;
	fea:=ff(ea)=1;
	fwe:=ff(we)=1;
	fne:=ff(ne)=1;
	fse:=ff(se)=1;
	fsw:=ff(sw)=1;
	fnw:=ff(nw)=1;
	oldk:=k;
---------------------------------------------------------------------

	if    fnw and fne and not fno then k:=k+1;
	elsif fsw and fse and not fso then k:=k+1; --box blocks vertical doorway

	elsif fnw and fsw and not fwe then k:=k+1;
	elsif fne and fse and not fea then k:=k+1; --box blocks horizontal doorway
-----------------------------------------------------------------------------
	elsif fwe and fea then k:=k+1;             --box blocks vert door

	elsif fsw and fea and not fso then k:=k+1;
	elsif fnw and fea and not fno then k:=k+1; --box blocks vert door

	elsif fwe and fne and not fno then k:=k+1;
	elsif fwe and fse and not fso then k:=k+1; --box blocks vert door
------------------------------------------------------------------------------
	elsif fno and fso then k:=k+1;             --box blocks horizontal doorway

	elsif fno and fsw and not fwe then k:=k+1;
	elsif fno and fse and not fea then k:=k+1; --box blocks horz door

	elsif fnw and fso and not fwe then k:=k+1;
	elsif fne and fso and not fea then k:=k+1; --box blocks horz door

	end if;
---------------------------------------------------------------------
	if k>oldk and then ff(rc)=2 then g:=g+1; end if; -- count 1 box on goal


end if;
end loop;
end loop;

k := k - g/2; --discount 50%

return k;

end fcountRoomBlocks;









-- uses updated oFF:
function fcountCorrals( vf: vftype ) return integer is
	k: integer:=0;
	irc: ushort;

	corral, cviano, cviaso, cviaea, cviawe : booltype;
	fff: vftype;
	nco: vftype;
	

procedure initdpcorral is
	ic: ushort;
begin

---------------------------------------------------------
-- note that this uses
--			ff()=2 to indicate a GOAL
--       vf()=1 to indicate BOX
---------------------------------------------------------

	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; --wall or box becomes wall
		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 pvalid(ic) then --31oct18
			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 2ndary corrals
procedure dpcorral2(
	r0,c0 : ushort; --puller.pos
	uj: ubyte
	) is

	ip: constant ushort := indx(r0,c0);
	ndelta : integer;
	irc,ino,iso,iea,iwe: ushort;
begin
	--myassert( corral(ip)=false, 88, "dpcorral2 error");
	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
			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
			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

	for r in 2..nrows-1 loop
	for c in 2..ncols-1 loop
	irc:=indx(r,c);
	if corral(irc) and nco(indx(r,c))=0 then
		nco(indx(r,c)):=uj;
	end if;
	end loop;
	end loop;

end dpcorral2;



begin

---------------------------------------------------------
-- note that this uses
--			ff()=2 to indicate a GOAL
--       vf()=1 to indicate BOX
---------------------------------------------------------

	--assuming the box layout to be evaluated has been restored...
	initdpcorral;

	nco:=(others=>0);

	for row in 2..nrows-1 loop
	for col in 2..ncols-1 loop

		irc:=indx(row,col);
		if not corral(irc) and pvalid(irc) and vf(irc)/=1 then
			dpcorral2(row,col, ubyte(k+1) );
			k:=k+1;
		end if;

	end loop;
	end loop;

--if true then --debug ON
if false then --debug OFF
put("corrals:"); new_line;
for r in 1..nrows loop
for c in 1..ncols loop
	put(ubtrim( nco(indx(r,c)) ) );
end loop;
new_line;
end loop;
end if;

	return k;

end fcountCorrals;










procedure rdump0(vf: vftype; pr,pc: ushort) is
	ii : ushort;
	push,goal,wall,box: boolean;
begin

	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);
		push := (row=pr and col=pc);

		if goal and push then put("+");
		elsif goal and box then put("*");
		elsif push and box then put("X");
		elsif push and wall then put("Z");
		elsif wall then put("#");
		elsif box then put("b");
		elsif goal then put("g");
		elsif push then put("@");
		else put(" "); end if;

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

end rdump0;








-- addendum 2jan21:
-- note that this proc assumes we have swapped
-- goals & boxes in order to work on the
-- reverse puzzle. That's why we switch back.
procedure dump2arr(
	nrows, ncols: ushort;
	--ivf,iff: vftype;
	ipr,ipc: ubyte;
	puzz: out puzarray;
	switch : boolean := true
	) is
	use text_io;
	ii : ushort;
	goal,pusher,wall,box: boolean;
	ch: character;
begin
	puzz:=( others=> (others=> 'x') );
	for row in 1..nrows loop
	for col in 1..ncols loop
		ii:=indx(row,col);
		pusher:=(row=ushort(ipr) and col=ushort(ipc));
		wall:=(ff(ii)=1);
		if switch then
			goal:=(vf(ii)=1);
			box :=(ff(ii)=2);
		else
			box :=(vf(ii)=1);
			goal:=(ff(ii)=2);
		end if;

		if goal and pusher then ch:='+';
		elsif goal and box then ch:='*';
		elsif goal then ch:='.';
		elsif box then ch:='$';
		elsif pusher then ch:='@';
		elsif wall then ch:='#';
		else ch:=' ';
		end if;
		puzz(row,col):=ch;
	end loop;
	end loop; --row
--note:
--last row<=20 with puzz(row,1)/='x' is nrows
--last col<=25 with puzz(1,col)/='x' is ncols
end dump2arr;







--reads an array containing single puzzle description:
procedure readArr( 
puzz: puzarray) is --input description of puzzle
--vf,ff:  out vftype;
--ee: out vustype;
--bvalid, pvalid: out booltype ) is

  nbx,lc, nrcpt : integer := 0;
  pr,pc,
  --row : ushort;
	fp : ushort := 0;
	ii: ushort;
	--save:savetype;
begin


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

	--set nrows,ncols:
	for r in 1..maxrows loop
		if puzz(r,1) /= 'x' then nrows:=r; end if;
	end loop;
	for c in 1..maxcols loop
		if puzz(1,c) /= 'x' then ncols:=c; end if;
	end loop;


	for row in 1..nrows loop

		savefp:=fp; -- exclude final row

		for col in 1..ncols loop

			ii:=indx(row,col);

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

			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 box
				ff(ii):=2;
				vf(ii):=1; nbx:=nbx+1;

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

			end case;

			if 
				ff(ii)/=1
			then
				fp := fp+1;
				if fp<=255 then
					ee(ii) := fp;
				end if;
			end if;

		end loop; --col

	end loop; --row





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



	nboxes:=ushort(nbx);

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

	gpr:=pr;
	gpc:=pc;


	dpwcorral(gpr,gpc, win_pulkey);
	win_key := setwinkey(win_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);



--put("WinKey: ");
--put(ulong'image(win_key.suma)); put(":");
--put(ulong'image(win_key.sumb)); put(":");
--put(ulong'image(win_key.sumc)); put(":");
--put(ubyte'image(win_key.pulkey)); new_line;


-- 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,bestcost,bestpred);

		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 testdown(r-1,c)) --box above
			or
			(vf(indx(r+1,c))=1 and testup(r+1,c))   --box below
			or
			(vf(indx(r,c+1))=1 and testleft(r,c+1)) --box@right
			or
			(vf(indx(r,c-1))=1 and testright(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 readArr;








function ptestleft(pr,pc: ushort) return boolean is
	ii : ushort := indx(pr,pc-1);
begin
	--if pc<=2 then
	if not pvalid(ii) 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(pr,pc: ushort) return boolean is
	ii : ushort := indx(pr,pc+1);
begin
	--if ushort(pc)>=ncols-1 then
	if not pvalid(ii) 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(pr,pc: ushort) return boolean is
	ii : ushort := indx(pr+1,pc);
begin
	--if ushort(pr)>=nrows-1 then
	if not pvalid(ii) 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(pr,pc: ushort) return boolean is
	ii : ushort := indx(pr-1,pc);
begin
	--if pr<=2 then
	if not pvalid(ii) 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;









procedure psaveifnew( 
	okey: keytype; 
	pmove,
	pr,pc,
	olp, olm,
	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 : constant ushort := olp+boxpulls;
	totm : constant ushort := olm+moves;
	use mysplaylist;
	status: mysplaylist.statustype;
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);
			if vf(ii)=1 then nurec.vfsave(jb):=true; end if;
		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 := ubyte(ee(indx(pr,pc)));

	mysplaylist.search( nukey, exploring, rec, status );

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

	if status=notfound then

		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;
		mysplaylist.addnode( nukey, nurec, exploring, status );
		--myassert( status=ok, 111, "addnode error" );

--------------- begin new insert ---------------------------------
	elsif status=found then

		if 
			totp<nurec.totpulz or 
			(totp=nurec.totpulz and totm<nurec.totmovz)
		then

			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;

			mysplaylist.modifyNode( nukey, nurec, exploring, status );

		end if;



	end if; -- not seen

end psaveifnew;



procedure psave0 is
	use mysplaylist;
	irec : hashrectype;
	zkey : constant keytype := (0,0,0,0);
	nukey : keytype := (0,0,0,0);
	eloc : etype;
	k  : ushort := 0;
	nk : ubyte := 0;
	ii,js : ushort;
	jb: ubyte:=0;
	status: mysplaylist.statustype;
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
myassert(ee(ii)<256, 20202);
			k:=k+1;
			eloc(k) := ubyte(ee(ii));

			if ff(ii)=2 then
				nk:=nk+1; --tally goals
			end if;

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

	-- prepare all the fixed fields:
	bitrep(k,eloc, nukey.suma, nukey.sumb, nukey.sumc);
	irec.prevkey:=zkey;
	irec.ngoals:=nk;
	irec.prevmove:=9; -- valid moves in {0..3}
	irec.boxpull:=0;
	irec.totmovz:=0;
	irec.totpulz:=0;
	--irec.xlevel:=0;

	--irec.vfsave := (others=>false); now automatic
	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);
			if vf(ii)=1 then irec.vfsave(jb):=true; end if;
		end if;
	end loop;
	end loop;


	mysplaylist.make_empty(exploring,status); -- 2dec20
	myassert(status=empty or status=ok, 99988, "puller make_empty");
	myassert( mysplaylist.length(exploring) = 0, 99999, "initialSplay(puller)" );


	-- now prepare the fields that depend upon puller pos:

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

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

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

	end loop; -- i

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

--debug
--new_line;
--put_line("Psave0...pfmax="&ushort'image(pfmax));
--put_line("Psave0...len(tree)="&integer'image(length(explored)));

end psave0;













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

	vf := (others=>0);
	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);
			if rec.vfsave(jb)=true then vf(ii):=1; end if;
		end if;
	end loop;
	end loop;
	--pr := ushort(rec.prsave);
	--pc := ushort(rec.pcsave);

end prestore;









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

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

	search( key, exploring, 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, exploring, 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;






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 key=pwin_key then
		winner:=true;
		tsec1:=ada.calendar.seconds(ada.calendar.clock);
		set_unbounded_string(solutionPath, "");
		pdocument(solutionPath,key,nmoves,bmoves);
	end if; --winner

end pwinnertest;






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;








procedure bsaveifnew(
	okey: keytype;
	pmove, 
	olpulz,
	boxpulls, olmovz : ushort;
	pr,pc, br,bc: ushort
	) is

	use mysplaylist;
	nukey : keytype := (0,0,0,0);
	rec, nurec : hashrectype;
	eloc : etype;
	pk,nk,k,ii : ushort := 0;
	ulkey : ubyte;
	jb: ubyte;
	js: ushort;
	tpulz: constant ushort := olpulz+boxpulls;
	tmovz: constant ushort := olmovz+boxpulls;
	status: mysplaylist.statustype;
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
			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);
			if vf(ii)=1 then nurec.vfsave(jb):=true; end if;
		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;

	mysplaylist.search( nukey, exploring, rec, status );

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

	if status=notfound then

		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;
		nurec.totmovz := tmovz;
		mysplaylist.addnode( nukey, nurec, exploring, status );
		--myassert( status=ok, 111, "addnode error" );


--------------- begin new insert ---------------------------------
	elsif status=found then

--Note: since keys are equal => puller is in same corral!

		if 
			tpulz<rec.totpulz or 
			(tpulz=rec.totpulz and tmovz<rec.totmovz)
		then

			rec.prsave:=ubyte(pr);
			rec.pcsave:=ubyte(pc);
			rec.boxpull := ubyte(boxpulls);
			rec.prevmove := ubyte(pmove);
			rec.prevkey := okey;
			rec.ngoals := ubyte(nk);
			rec.totpulz := tpulz;
			rec.totmovz := tmovz;

			mysplaylist.modifyNode( nukey, rec, exploring, status );

		end if;




	end if; -- not seen


end bsaveifnew;



procedure bsave0 is
	use mysplaylist;
	irec : hashrectype;
	zkey : constant keytype := (0,0,0,0);
	nukey : keytype:=(0,0,0,0);
	eloc : etype;
	k  : ushort := 0;
	nk : ubyte := 0;
	ii : ushort;
	jb: ubyte;
	js, kount: ushort;
	status: mysplaylist.statustype;
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) );

			if ff(ii)=2 then
				nk:=nk+1; --tally goals
			end if;

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


	-- prep all fields independent of puller pos:

	bitrep(k,eloc, nukey.suma, nukey.sumb, nukey.sumc);
	irec.prevkey:=zkey;
	irec.ngoals:=nk;
	irec.prevmove:=9; -- valid moves in {0..3}
	irec.boxpull:=0;
	irec.totpulz:=0;
	--irec.xlevel:=0;

	--irec.vfsave:=(others=>false); --now automatic

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


	mysplaylist.make_empty(exploring,status); -- 2dec20
	myassert(status=empty or status=ok, 99988, "ibox make_empty");
	myassert( mysplaylist.length(exploring) = 0, 99999, "initialSplay" );



	-- define fields dependent on puller pos...

	-- Note that multiple pulkeys might be equal
	-- if pullers are in same corral, but
	-- mysplay rejects duplicates.



	-- define fields dependent on puller pos:

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

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

		mysplaylist.addnode( nukey, irec, exploring, 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(exploring)), 114, "emutils.bsave0");

--debug
--new_line;
--put_line("Bsave0:pfmax="&ushort'image(pfmax));
--put_line("Bsave0:kount="&ushort'image(kount));
--new_line;

end bsave0;













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

	vf := (others=>0);
	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);
			if rec.vfsave(jb)=true then vf(ii):=1; end if;
		end if;
	end loop;
	end loop;
	pr := ushort(rec.prsave);
	pc := ushort(rec.pcsave);

end brestore;








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

	bestcost,bestpred: vftype;

	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, exploring, 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, exploring, 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
				brestore(rec,xpr,xpc); --6dec20
				dppathprep(gpr,gpc,bestcost,bestpred);
				dppath(opr,opc, np0,bestcost,bestpred);
				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,bestcost,bestpred);
				dppath(prnext,pcnext, np, bestcost, bestpred);
				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;














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

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

end bwinnertest;




end emutils; --package

