

--
-- Copyright (C) 2020  <fastrgv@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You may read the full text of the GNU General Public License
-- at <http://www.gnu.org/licenses/>.
--


-- Sokoban Reverse-BFS solver : 
-- a brute-force breadth-first-search in reverse
--
-- ibox1 ... simpler logic versus ibox. After first solution
-- is found, the longer search tree branches are skipped.  
-- Now exits only after entire queue is searched.

-- IBOX=Inertial Box-centric version.
--
-- Algorithm:
-- choose a box, then a direction;  move it as far as possible
-- in that same direction, while saving critical intermediate 
-- positions. Ignores exact puller position but saves puller-corral.
--
-- An article by Frank Takes shows clear advantages to working from
-- a solved position backwards to the start position, which prevents
-- deadlocked positions from taking up much space in the search tree.
-- Puller-deadlocks are still possible, but they are less problematic 
-- because they self-terminate fairly quickly in a BFS.
--
-- This version attempts to detect tunnels
-- and avoids placing configs onto the priority queue that represent
-- partial traversals thru them.  The only exceptions are a) if pulling
-- and the box lands on a box-target;  b) if the puller lands on a
-- puller-target = initial pusher position.
--
-- Uses a splaytree, to test whether a given config was seen before.  
-- Extremely fast access, but can only solve relatively small puzzles
-- due to memory constraints.
--
-- Uses a fullproof Key-type, for which we must define
-- operators "<" and ">".
--
-- Note that solutions are push-optimal but NOT move-optimal
-- since the extent of the pusher movement is completely ignored.








with splaylist;
with text_io;

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

with ada.command_line;
with ada.calendar;

with emutils;


package body solver is


-- currently, this is Secondary Solver:
function iboxu( timeout_sec: float;
	infilname: unbounded_string;
	ilevel, imaxlevel : integer;
	solutionPath : in out unbounded_string
	) return boolean is

	failure: boolean := false;

	-- put a time limit on this embedded version:
	interactive_timeout : ada.calendar.day_duration := 10.0; --seconds


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

	use text_io;

	use emutils;
	use mysplay;










procedure pullup(
	okey: keytype;  olp,xr,xc : ushort; changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br-1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin --pullup
	changed:=false;
	if dppathexists(pr,pc) and then btestup(br,bc) then
		changed:=true;
		loop
			vf(indx(pr+1,pc)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pr:=pr-1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestup(br,bc);
			exit when careful and nexus(brc);
			exit when careful and nexus(prc);
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when desperate and not vtunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,0,olp,boxmoves, pr,pc, br,bc);

	end if;
end pullup;






procedure pulldown(
	okey: keytype;  olp,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br+1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin
	changed:=false;
	if  dppathexists(pr,pc) and then btestdown(br,bc) then
		changed:=true;
		loop
			vf(indx(pr-1,pc)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pr:=pr+1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestdown(br,bc);
			exit when careful and nexus(brc);
			exit when careful and nexus(prc);
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when desperate and not vtunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,1,olp,boxmoves, pr,pc, br,bc);

	end if;
end pulldown;






procedure pullleft(
	okey: keytype;  olp,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc-1;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin
	changed:=false;
	if  dppathexists(pr,pc) and then btestleft(br,bc) then
		changed:=true;
		loop
			vf(indx(pr,pc+1)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pc:=pc-1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestleft(br,bc);
			exit when careful and nexus(brc);
			exit when careful and nexus(prc);
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when desperate and not htunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,3,olp,boxmoves, pr,pc, br,bc);

	end if;
end pullleft;






procedure pullright(
	okey: keytype;  olp,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc+1;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin
	changed:=false;
	if  dppathexists(pr,pc) and then btestright(br,bc) then
		changed:=true;
		loop
			vf(indx(pr,pc-1)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pc:=pc+1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestright(br,bc);
			exit when careful and nexus(brc);
			exit when careful and nexus(prc);
			exit when urgent and bnexus(brc);
			--exit when urgent and enexus(prc);
			exit when desperate and not htunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,2,olp,boxmoves, pr,pc, br,bc);

	end if;
end pullright;

















relenting: ushort := 0;
urgency: ubyte := 0; --increases as needed

procedure trymove is
	odiff,diff, newstop, oldstop, avg2: integer := 0;
	okey: keytype;
	orec: hashrectype;
	olp,opr, opc, ii : ushort;
	difference : boolean;
	status: mysplay.statustype;

use ada.calendar;

	et,tsec1: ada.calendar.day_duration;
	tsec0: ada.calendar.day_duration 
		:= ada.calendar.seconds(ada.calendar.clock);

begin --trymove



	newstop:=0;

	outer:
	loop

		oldstop:=newstop;
		newstop:=mysplay.length(mytree);
		diff := newstop-oldstop;
		exit outer when diff=0;


		for it in 1 .. diff loop


tsec1:=ada.calendar.seconds(ada.calendar.clock);
et:=tsec1-tsec0;
if et>interactive_timeout then failure:=true; end if;
exit outer when failure;



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


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



		if 
			(orec.xlevel<urgency)
			and (orec.ngoals>=ubyte(bestnk/relenting)) 
		then -- improved soln possible

			--to avoid redoing nodes
			orec.xlevel:=urgency;
			mysplay.modifynode(okey,orec,mytree,status);

			brestore(orec, opr,opc);
			dppathprep(opr,opc);

			olp:=orec.totpulz;


			-- do a lexicographic search for boxes,
			-- then try to move it in 4 directions:
			for br in 2..nrows-1 loop
			for bc in 2..ncols-1 loop


				ii:=indx(br,bc);

				if vf(ii)=1 and ee(ii)<=255 then --process this box

					pullright(okey,olp,br,bc,difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pullleft(okey,olp,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pullup(okey,olp,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pulldown(okey,olp,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


				end if;

				exit outer when winner;

			end loop; --bc
			end loop; --br

		end if;

		end loop; -- for it


	end loop outer;



end trymove;






	status: mysplay.statustype;

begin -- iboxu

	interactive_timeout := ada.calendar.day_duration(timeout_sec);

	level:=ilevel;
	maxlevel:=imaxlevel;

	winner:=false;

	readPuzzle(infilname,level);


	if failure then return false; end if;

	set_unbounded_string(solutionPath, "");


	mysplay.make_empty(mytree,status); ----------------------

	myassert(status=empty or status=ok, 99988, "iboxu make_empty");
	myassert( mysplay.length(mytree) = 0, 99999, "initialSplay" );
	myassert( length(solutionPath)=0, 98989, "initialSol" );


	bsave0; --ebutils

	--reset counter, flags:
	bestnk:=0;
	careful:=false;
	urgent:=false;
	desperate:=false;
	dying:=false;

	findnexii;


		relenting:=2;
		urgency:=1;
		trymove;

		if not winner then
			careful:=true;
			urgency:=2;
			trymove;
		end if;

		if not winner then
			urgent:=true;
			urgency:=3;
			trymove;
		end if;

		if not winner then
			desperate:=true;
			urgency:=4;
			trymove; 
		end if;

		while not winner loop
			relenting:=relenting*2;
			exit when relenting>gngoals*4;
			trymove;
		end loop;

		if not winner then 
			dying:=true; 
			urgency:=5;
			trymove; 
		end if;



	return winner;

exception
	when others => return false;

end iboxu;









-- currently, this is Secondary Solver:
function ibox( timeout_sec: float;
	infilname: unbounded_string;
	ilevel, imaxlevel : integer;
	solutionPath : in out unbounded_string
	) return boolean is

	failure: boolean := false;

	-- put a time limit on this embedded version:
	interactive_timeout : ada.calendar.day_duration := 10.0; --seconds


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

	use text_io;

	use emutils;
	use mysplay;











procedure pullup(
	okey: keytype;  olp,xr,xc : ushort; changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br-1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin --pullup
	changed:=false;
	if dppathexists(pr,pc) and then btestup(br,bc) then
		changed:=true;
		loop
			vf(indx(pr+1,pc)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pr:=pr-1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestup(br,bc);
			exit when bnexus(brc);
			--exit when enexus(prc);

			exit when not vtunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,0,olp,boxmoves, pr,pc, br,bc);

	end if;
end pullup;






procedure pulldown(
	okey: keytype;  olp,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br+1;
	pc: ushort := bc;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin
	changed:=false;
	if  dppathexists(pr,pc) and then btestdown(br,bc) then
		changed:=true;
		loop
			vf(indx(pr-1,pc)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pr:=pr+1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestdown(br,bc);
			exit when bnexus(brc);
			--exit when enexus(prc);

			exit when not vtunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,1,olp,boxmoves, pr,pc, br,bc);

	end if;
end pulldown;






procedure pullleft(
	okey: keytype;  olp,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc-1;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin
	changed:=false;
	if  dppathexists(pr,pc) and then btestleft(br,bc) then
		changed:=true;
		loop
			vf(indx(pr,pc+1)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pc:=pc-1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestleft(br,bc);
			exit when bnexus(brc);
			--exit when enexus(prc);

			exit when not htunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,3,olp,boxmoves, pr,pc, br,bc);

	end if;
end pullleft;






procedure pullright(
	okey: keytype;  olp,xr,xc : ushort;	changed: out boolean ) is

	br: ushort := xr;
	bc: ushort := xc;
	pr: ushort := br;
	pc: ushort := bc+1;
	boxmoves: ushort := 0;
	prc,brc: ushort;

begin
	changed:=false;
	if  dppathexists(pr,pc) and then btestright(br,bc) then
		changed:=true;
		loop
			vf(indx(pr,pc-1)):=0;
			vf(indx(pr,pc)):=1;
			br:=pr; bc:=pc;
			pc:=pc+1;
			boxmoves:=boxmoves+1;
			brc := indx(br,bc);
			prc := indx(pr,pc);

			exit when not btestright(br,bc);
			exit when bnexus(brc);
			--exit when enexus(prc);

			exit when not htunl(prc);

		end loop;
		bsaveifnew(solutionPath,okey,2,olp,boxmoves, pr,pc, br,bc);

	end if;
end pullright;



















relenting: ushort := 0;

procedure trymove is
	odiff,diff, newstop, oldstop, avg2: integer := 0;
	okey: keytype;
	orec: hashrectype;
	olp,opr, opc, ii : ushort;
	--bxfrac : float;
	difference : boolean;
	use mysplay;

	status: mysplay.statustype;

	et,tsec1: ada.calendar.day_duration;
	tsec0: ada.calendar.day_duration 
		:= ada.calendar.seconds(ada.calendar.clock);

begin --trymove



	newstop:=0;

	outer:
	loop

		oldstop:=newstop;
		newstop:=mysplay.length(mytree);
		diff := newstop-oldstop;
		exit outer when diff=0;


		for it in 1 .. diff loop


tsec1:=ada.calendar.seconds(ada.calendar.clock);
et:=tsec1-tsec0;
if et>interactive_timeout then failure:=true; end if;
exit outer when failure;



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


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



		if 
			(orec.xlevel<1)
			and (orec.ngoals>=ubyte(bestnk/relenting)) 
		then -- improved soln possible

			--to avoid redoing nodes
			orec.xlevel:=1;
			mysplay.modifynode(okey,orec,mytree,status);

			brestore(orec, opr,opc);
			dppathprep(opr,opc);

			olp:=orec.totpulz;


			-- do a lexicographic search for boxes,
			-- then try to move it in 4 directions:
			for br in 2..nrows-1 loop
			for bc in 2..ncols-1 loop


				ii:=indx(br,bc);

				if vf(ii)=1 and ee(ii)<=255 then --process this box

					pullright(okey,olp,br,bc,difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pullleft(okey,olp,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pullup(okey,olp,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


					pulldown(okey,olp,br,bc, difference);
					if difference then
						brestore(orec,opr,opc);
					end if;


				end if;

			end loop; --bc
			end loop; --br

		end if;

		end loop; -- for it


	end loop outer;




end trymove;




	status: mysplay.statustype;

begin -- ibox

	interactive_timeout := ada.calendar.day_duration(timeout_sec);

	level:=ilevel;
	maxlevel:=imaxlevel;

	winner:=false;

	readPuzzle(infilname,level);

	if failure then return false; end if;

	set_unbounded_string(solutionPath, "");


	mysplay.make_empty(mytree,status); ----------------------------

	myassert(status=empty or status=ok, 99988, "ibox make_empty");
	myassert( mysplay.length(mytree) = 0, 99999, "initialSplay" );
	myassert( length(solutionPath)=0, 98989, "initialSol" );


	bsave0; --ebutils
	bestnk:=0;
	findnexii;



		relenting:=2;
		trymove;
		while not winner loop
			relenting:=relenting*2;
			exit when relenting>gngoals*4;
			trymove;
		end loop;



	return winner;

exception
	when others => return false;

end ibox;







-- currently, this is the Primary Solver:
function puller( timeout_sec: float;
	infilname: unbounded_string;
	ilevel, imaxlevel : integer;
	solutionPath : in out unbounded_string
	) return boolean is

	failure: boolean := false;

	-- put a time limit on this embedded version:
	interactive_timeout : ada.calendar.day_duration := 10.0; --seconds



-- puller1...simpler logic versus puller, now taking single steps 
-- when not pulling seems to produced a queue ordering that finds 
-- better solutions.  After first solution is found, the longer
-- search tree branches are skipped.  Now exits only after entire
-- queue is searched.
-- 
--
-- Sokoban Reverse-BFS solver : 
-- a brute-force breadth-first-search in reverse
--
-- Puller-centric version... (good for small,dense puzzles)
-- chooses puller direction {no,so,ea,we} to try
-- and then whether or not to pull any adjacent box.
--
-- An article by Frank Takes shows clear advantages to working from
-- a solved position backwards to the start position, which prevents
-- deadlocked positions from taking up space in the search tree.
-- I am aware that puller-deadlocks are still possible, but they are
-- less problematic because they self-terminate fairly quickly in a BFS.
--
-- This version attempts to detect tunnels
-- and avoids placing configs onto the priority queue that represent
-- partial traversals thru them.  The only exceptions are a) if pulling
-- and the box lands on a box-target;  b) if the puller lands on a
-- puller-target = initial pusher position.
--
-- Uses a splaytree, to test whether a given config was seen before.  
-- Extremely fast access, but can only solve relatively small puzzles
-- due to memory constraints.
--
-- Uses a fullproof Key-type, for which we must define
-- operators "<" and ">".











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

	use text_io;
	use emutils;
	use mysplay;






procedure moveup(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pr:=pr-1;
	moves:=1;
	while 
		ptestup(pr,pc) and 
		not ptestright(pr,pc) and 
		not ptestleft(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pr:=pr-1; 
		moves:=moves+1;
	end loop;
	psaveifnew(solutionPath,okey,0,pr,pc,olp,olm,0,moves);
end moveup;


-- only called if testup=true
procedure pullup(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr+1,pc))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr+1,pc)):=0;
			vf(indx(pr,pc)):=1;
			pr:=pr-1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr+1,pc); --box index
			ip:=indx(pr,pc);

			exit when not ptestup(pr,pc);        --puller blocked
			exit when pr=gpr and pc=gpc; --puller on puller goal

			exit when bnexus(ib); -- Bvalid+Enexus
			--exit when enexus( ip ); --key puller pos

			exit when not vtunl(ip);

		end loop;
		psaveifnew(solutionPath,okey,0,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pullup;






procedure movedown(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pr:=pr+1;
	moves:=1;
	while 
		ptestdown(pr,pc) and 
		not ptestright(pr,pc) and 
		not ptestleft(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pr:=pr+1; 
		moves:=moves+1;
	end loop;
	psaveifnew(solutionPath,okey,1,pr,pc,olp,olm,0,moves);
end movedown;


-- only called if testdown=true
procedure pulldown(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr-1,pc))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr-1,pc)):=0;
			vf(indx(pr,pc)):=1;
			pr:=pr+1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr-1,pc); --box index
			ip:=indx(pr,pc);

			exit when not ptestdown(pr,pc);
			exit when pr=gpr and pc=gpc;

			exit when bnexus(ib); -- 
			--exit when enexus( ip ); --key puller pos

			exit when not vtunl(ip);

		end loop;
		psaveifnew(solutionPath,okey,1,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pulldown;







procedure moveleft(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pc:=pc-1;
	moves:=1;
	while 
		ptestleft(pr,pc) and 
		not ptestup(pr,pc) and 
		not ptestdown(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pc:=pc-1; 
		moves:=moves+1;
	end loop;
	psaveifnew(solutionPath,okey,3,pr,pc,olp,olm,0,moves);
end moveleft;


-- only called when testleft=true
procedure pullleft(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr,pc+1))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr,pc+1)):=0;
			vf(indx(pr,pc)):=1;
			pc:=pc-1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr,pc+1); --box index
			ip:=indx(pr,pc);

			exit when not ptestleft(pr,pc);
			exit when pr=gpr and pc=gpc;

			exit when bnexus(ib); -- slower
			--exit when enexus( ip ); --key puller pos

			exit when not htunl(ip);

		end loop;
		psaveifnew(solutionPath,okey,3,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pullleft;






procedure moveright(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort) is -- without pulling
	moves,boxmoves: ushort := 0;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	pc:=pc+1;
	moves:=1;
	while 
		ptestright(pr,pc) and 
		not ptestup(pr,pc) and 
		not ptestdown(pr,pc) and
		(pr/=gpr or pc/=gpc) 
	loop 
		pc:=pc+1; 
		moves:=moves+1;
	end loop;
	psaveifnew(solutionPath,okey,2,pr,pc,olp,olm,0,moves);
end moveright;



-- only called when testright=true
procedure pullright(
	okey: keytype; 
	opr,opc,
	olp,olm: ushort;  
	changed: out boolean) is
	boxmoves: ushort := 0;
	ip,ib: ushort;
	pr: ushort := opr;
	pc: ushort := opc;
begin
	changed:=false;
	if vf(indx(pr,pc-1))=1 then -- box to pull
		changed:=true;
		loop
			vf(indx(pr,pc-1)):=0;
			vf(indx(pr,pc)):=1;
			pc:=pc+1;
			boxmoves:=boxmoves+1;
			ib:=indx(pr,pc-1); --box index
			ip:=indx(pr,pc);

			exit when not ptestright(pr,pc);
			exit when pr=gpr and pc=gpc;

			exit when bnexus(ib); -- 
			--exit when enexus( ip ); --key puller pos

			exit when not htunl(ip);

		end loop;
		psaveifnew(solutionPath,okey,2,pr,pc,olp,olm,boxmoves,boxmoves);
	end if;
end pullright;

















relenting : ushort := 0;


procedure trymove is

	iet,
	diff, newstop, oldstop: integer := 0;
	okey: keytype;
	orec: hashrectype;
	prev, bp : ubyte;
	olm,olp,
	opr, opc : ushort;
	pch: character;
	lbox, rbox, ubox, dbox, changed : boolean;
	use mysplay;

	status: mysplay.statustype;

	et,tsec1: ada.calendar.day_duration;
	tsec0: ada.calendar.day_duration 
		:= ada.calendar.seconds(ada.calendar.clock);


begin --trymove


	newstop:=0;

	outer:
	loop

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

		exit outer when diff=0;




		for it in 1 .. diff loop

tsec1:=ada.calendar.seconds(ada.calendar.clock);
et:=tsec1-tsec0;
if et>interactive_timeout then failure:=true; end if;
exit outer when failure;


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


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

			prestore(orec);





		if
			(orec.xlevel<1)
			and (orec.ngoals>=ubyte(bestnk/relenting))
		then

			--to avoid redoing nodes
			orec.xlevel:=1;
			mysplay.modifynode(okey,orec,mytree,status);


			prev:= orec.prevmove;
			bp:= orec.boxpull; -- # [straight-line] pulls of this box
			olm:=ushort(prev);
			olp:=ushort(bp);



			if bp>0 then -- was a pull

				case prev is
					when 0 => pch:='D';
					when 1 => pch:='U';
					when 2 => pch:='L';
					when 3 => pch:='R';
					when others => pch:='X';
				end case;

			else -- was a move with no pull

				case prev is
					when 0 => pch:='d';
					when 1 => pch:='u';
					when 2 => pch:='l';
					when 3 => pch:='r';
					when others => pch:='x';
				end case;

			end if;


			opr:=ushort(orec.prsave);
			opc:=ushort(orec.pcsave);
			lbox:=(vf(indx(opr,opc-1))=1);
			rbox:=(vf(indx(opr,opc+1))=1);
			ubox:=(vf(indx(opr-1,opc))=1);
			dbox:=(vf(indx(opr+1,opc))=1);

			if ptestright(opr,opc) then
				if pch/='r' then
					moveright(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if lbox then pullright(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


			if ptestleft(opr,opc) then
				if pch/='l' then
					moveleft(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if rbox then pullleft(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


			if ptestup(opr,opc) then
				if pch/='u' then
					moveup(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if dbox then pullup(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


			if ptestdown(opr,opc) then
				if pch/='d' then
					movedown(okey,opr,opc,olp,olm);
					prestore(orec);
				end if;
				changed:=false;
				if ubox then pulldown(okey,opr,opc,olp,olm,changed); end if;
				if changed then prestore(orec); end if;
			end if;


		end if;

		exit outer when winner;

		end loop; -- inner for it


	end loop outer; -- outer


end trymove;












	status: mysplay.statustype;
	--et: integer;

begin -- puller


	myassert( not failure, 99987, "enter puller");

	interactive_timeout := ada.calendar.day_duration(timeout_sec);

	level:=ilevel;
	maxlevel:=imaxlevel;

	winner:=false;

	readPuzzle(infilname, level);

	if failure then return false; end if;

	set_unbounded_string(solutionPath, "");

	mysplay.make_empty(mytree,status); ------------------------------

	myassert(status=empty or status=ok, 99988, "puller make_empty");
	myassert( mysplay.length(mytree) = 0, 99999, "initialSplay(puller)" );



	psave0;

	bestnk:=0;
	findnexii;


		relenting:=2;
		trymove;
		while not winner loop
			relenting:=relenting*2;
			exit when relenting>gngoals*4;
			trymove;
		end loop;


	return winner;

exception
	when others => return false;

end puller;





end solver;
