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




-- cdd.adb : TerminalBlockSlider = block slider in a terminal window
--


with tput00_h;


with gnat.os_lib;
with ada.characters.handling;

with Interfaces.C;
use type interfaces.c.int;



with Text_IO;
with SysUtils;  use SysUtils;
with ada.directories;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;
with fbfsl;

with GNATCOLL.Terminal;  use GNATCOLL.Terminal;
with realtime_hpp;




procedure cdd is

use Ada.Strings.Unbounded;
use Ada.Strings.Unbounded.Text_IO;
use ada.directories;
use text_io;

	mswin: constant boolean := (gnat.os_lib.directory_separator='\');


	solutionPath : unbounded_string;

	search : search_type;
	directory_entry : directory_entry_type;
	nlevels : integer := 0;



	ch: character;

	--speedup,
	userexit, help, Ok, winner : boolean := false;

	movesrem, nMoves, mxpuz, npuz : integer := 0;
	totgame: constant integer := 12;

	shortname : constant array(1..totgame) of string(1..8)
	:=(
	 "dd01.blk",
	 "dd02.blk",
	 "dd03.blk",
	 "dd04.blk",
	 "dd05.blk",
	 "dd06.blk",
	 "dd07.blk",
	 "dd08.blk",
	 "dd09.blk",
	 "dd10.blk",
	 "dd11.blk",
	 "dd12.blk");


	infilname : unbounded_string;

	objectiveText : string(1..60);
	movesText : string(1..9);

-----------------------------------------------------------------
-- maximum # blocks:
	maxnonblnk: constant integer := 16; -- allow a..p

-- maximum # cars/trucks/blanks
	maxblok: constant integer := 36;

-- car centers:
	rowcen, colcen : array(1..maxblok) of float;
	idchar : array(1..maxblok) of character := (others=>' ');
	bshape : array(1..maxblok) of integer; -- 12,21, 13,31

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

	grow, gcol : array(1..2) of float; -- goal pos
	epsilon : constant float := 0.01;

	dblk, nblk, gblk, selBlock, nrow,ncol: integer:=1;

	ntrail, blank1, blank2 : integer := 0;









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


procedure test4winner is
begin
	winner := true;

	for g in 1..gblk loop -- gblk is 1 or 2
		if
		(abs(rowcen(g)-grow(g)) < epsilon )
		and
		(abs(colcen(g)-gcol(g)) < epsilon )
		then
			null;
		else
			winner:=false;
		end if;
	end loop;

end test4winner;





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






procedure dumpGameState(fnam: string) is
	fileid : text_io.file_type;
begin

   text_io.Create
      (File => FileId,
       Mode => text_io.Out_File,
       Name => fnam);

	put_line(fileid, "move Red car to edge");
	myint_io.put(fileid, nrow);
	new_line(fileid);
	myint_io.put(fileid, ncol);
	new_line(fileid);
	myint_io.put(fileid, dblk);
	new_line(fileid);
	myint_io.put(fileid, gblk);
	new_line(fileid);
	for g in 1..gblk loop
		myfloat_io.put(fileid, grow(g));
		myfloat_io.put(fileid, gcol(g));
	end loop;
	new_line(fileid);

	for i in 1..dblk loop
		myint_io.put(fileid, bshape(i));
		put(fileid," ");
		myfloat_io.put(fileid, rowcen(i));
		put(fileid," ");
		myfloat_io.put(fileid, colcen(i));
		put(fileid," ");
		put_line(fileid, "black");
	end loop;

	myint_io.put(fileid, nblk-dblk);
	new_line(fileid);

	for i in dblk+1..dblk+2 loop
		myint_io.put(fileid, bshape(i));
		put(fileid," ");
		myfloat_io.put(fileid, rowcen(i));
		put(fileid," ");
		myfloat_io.put(fileid, colcen(i));
		put(fileid," ");
		put_line(fileid, "white");
	end loop;

   text_io.Close (File => FileId);

end dumpGameState;



--// note: position of L-shaped blocks reference corner square;
--// note: ul=91, lr=94
--// Here only type ul=91 and lr=94 exist.
procedure init( fname: string ) is
	fileid : text_io.file_type;
	len: natural;
	clrstr: string(1..40);
	bblk : integer;
begin

	text_io.Open
		(File => FileId,
		 Mode => text_io.In_File,
		 Name => fname);


	objectiveText:=(others=>' ');
	text_io.get_line(fileid, objectiveText, len);
	movesText := objectiveText(len-8..len);


	-- (nrow,ncol) = outer dimension
	-- dblk = # non-blank rectangles
	-- nblk = # blanks
	-- gblk = # goal positions that must be attained
	-- (grow,gcol) = goal position[s]
	-- bshape = 11 or 12 or 21 or 22 = block shape

	myint_io.get(fileid, nrow); --5
	myint_io.get(fileid, ncol); --6
	myint_io.get(fileid, dblk); --14
	myint_io.get(fileid, gblk); -- 1

	nblk:=dblk+2;

	myassert( gblk = 1 ); -- this code only handles single object block
	myassert( nblk <= maxblok );
	myassert( dblk <= maxnonblnk ); -- allow labels a..m for vehicles


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


	for i in 1..dblk loop
		myint_io.get(fileid, bshape(i));
		myfloat_io.get(fileid, rowcen(i));
		myfloat_io.get(fileid, colcen(i));
		text_io.get_line(fileid, clrstr, len); --ignore
		idchar(i):=character'val( 96+i ); --a=97...z=122
	end loop;

	myint_io.get(fileid, bblk);
	myassert( bblk = 2 );

	for i in dblk+1..nblk loop
		myint_io.get(fileid, bshape(i));
		myfloat_io.get(fileid, rowcen(i));
		myfloat_io.get(fileid, colcen(i));
		text_io.get_line(fileid, clrstr, len); --ignore
		idchar(i):=character'val( 96+i ); --a=97...z=122
	end loop;


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



   text_io.Close (File => FileId);

	winner:=false;
	nMoves:=0;
	ntrail:=0;

end init;



	erase: boolean := false;

-- Dirty Dozen has L shaped blocks...
-- 91 = UL
-- 94 = LR
-- and exactly 2 blank 1x1 squares

function moveleft return integer is

	ret: integer := 0;

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

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

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

	rcenl,ccenl, rcenb,ccenb: float;

begin

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

		rcenl:=sr+0.5;
		ccenl:=sc+0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(br1-br2) < 1.1 -- 2blanks are 1 row apart (or less)
				and
			abs(rcenb-rcenl)<0.1 -- 2blank rows align w/piece
				and
			abs(bc1-bc2)<0.1 -- 2blanks are in same column
				and
			abs(ccenb-(ccenl-1.5))<0.1 --blanks left of piece
		then
			colcen(selBlock) := sc-1.0;
			if br2>br1 then
			colcen(blank1) := bc1+2.0;
			colcen(blank2) := bc2+1.0;
			else
			colcen(blank1) := bc1+1.0;
			colcen(blank2) := bc2+2.0;
			end if;
		end if;


	elsif( shape=94 ) then -- LR-"L"

		rcenl:=sr-0.5;
		ccenl:=sc-0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(br1-br2) < 1.1 -- 2blanks 1 row apart (or less)
				and

			abs(bc1-bc2) < 1.1 -- 2blanks 1 col apart (or less)
				and

			abs(rcenb-rcenl)<0.1 --2blank rows align w/piece
				and

			abs(ccenb-(ccenl-1.0))<0.1 --2blank cols left of piece

		then
			colcen(selBlock) := sc-1.0;
			if br1>br2 then
			colcen(blank1) := bc1+2.0;
			colcen(blank2) := bc2+1.0;
			else
			colcen(blank1) := bc1+1.0;
			colcen(blank2) := bc2+2.0;
			end if;
		end if;


	elsif( shape=22 ) then

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

	elsif( shape=21 ) then

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

	elsif( shape=12 ) then

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



	elsif( shape=11 ) then

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


	end if;



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


	if( ret > 0 )	
	then
		if winner then erase:=true; end if;
		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;

end moveleft;










function moveright return integer is

	ret: integer := 0;

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

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

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

	rcenl,ccenl, rcenb,ccenb: float;

begin


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

		rcenl:=sr+0.5;
		ccenl:=sc+0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(br1-br2) < 1.1 -- 2blanks are 1 row apart (or less)
				and
			abs(rcenb-rcenl)<0.1 -- 2blank rows align w/piece
				and
			abs(bc1-bc2)<1.1 -- 2blanks are 1 col apart (or less)
				and
			abs(ccenb-(ccenl+1.0))<0.1 --blanks right of piece
		then
			colcen(selBlock) := sc+1.0;
			if br2>br1 then
			colcen(blank1) := bc1-2.0;
			colcen(blank2) := bc2-1.0;
			else
			colcen(blank1) := bc1-1.0;
			colcen(blank2) := bc2-2.0;
			end if;
		end if;


	elsif( shape=94 ) then -- LR-"L"

		rcenl:=sr-0.5;
		ccenl:=sc-0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(br1-br2) < 1.1 -- 2blanks 1 row apart (or less)
				and

			abs(bc1-bc2) < 0.1 -- 2blanks in same col
				and

			abs(rcenb-rcenl)<0.1 --2blank rows align w/piece
				and

			abs(ccenb-(ccenl+1.5))<0.1 --2blank cols right of piece

		then
			colcen(selBlock) := sc+1.0;
			if br1>br2 then
			colcen(blank1) := bc1-2.0;
			colcen(blank2) := bc2-1.0;
			else
			colcen(blank1) := bc1-1.0;
			colcen(blank2) := bc2-2.0;
			end if;
		end if;



	elsif( shape=22 ) then

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

	elsif( shape=21 ) then

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

	elsif( shape=12 ) then

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



	elsif( shape=11 ) then

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


	end if;



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



	if( ret > 0 )
	then
		if winner then erase:=true; end if;
		nMoves:=nMoves+1;
		test4winner;
	end if;


	return ret;


end moveright;








function moveup return integer is

	ret: integer := 0;

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

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

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

	rcenl,ccenl, rcenb,ccenb: float;

begin


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

		rcenl:=sr+0.5;
		ccenl:=sc+0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(bc1-bc2) < 1.1 -- 2blanks are 1 col apart (or less)
				and
			abs(ccenb-ccenl)<0.1 -- 2blank cols align w/piece
				and
			abs(br1-br2)<0.1 -- 2blanks are in same row
				and
			abs(rcenb-(rcenl-1.5))<0.1 --blanks above piece
		then
			rowcen(selBlock) := sr-1.0;
			if bc2>bc1 then
			rowcen(blank1) := br1+2.0;
			rowcen(blank2) := br2+1.0;
			else
			rowcen(blank1) := br1+1.0;
			rowcen(blank2) := br2+2.0;
			end if;
		end if;


	elsif( shape=94 ) then -- LR-"L"

		rcenl:=sr-0.5;
		ccenl:=sc-0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(bc1-bc2) < 1.1 -- 2blanks 1 col apart (or less)
				and

			abs(br1-br2) < 1.1 -- 2blanks 1 row apart (or less)
				and

			abs(ccenb-ccenl)<0.1 --2blank cols align w/piece
				and

			abs(rcenb-(rcenl-1.0))<0.1 --2blank rows above piece

		then
			rowcen(selBlock) := sr-1.0;
			if bc1>bc2 then
			rowcen(blank1) := br1+2.0;
			rowcen(blank2) := br2+1.0;
			else
			rowcen(blank1) := br1+1.0;
			rowcen(blank2) := br2+2.0;
			end if;
		end if;



	elsif( shape=22 ) then

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

	elsif( shape=12 ) then

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


	elsif( shape=21 ) then

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



	elsif( shape=11 ) then

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


	end if;


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



	if( ret > 0 )	
	then
		if winner then erase:=true; end if;
		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;

end moveup;






function movedown return integer is

	ret: integer := 0;

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

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

	sr : float := rowcen(selBlock);
	sc : float := colcen(selBlock);
	shape : integer := bshape(selBlock);
	rcenl,ccenl, rcenb,ccenb: float;

begin


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

		rcenl:=sr+0.5;
		ccenl:=sc+0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(bc1-bc2) < 1.1 -- 2blanks are 1 col apart (or less)
				and

			abs(br1-br2) < 1.1 -- 2blanks are 1 row apart (or less)
				and

			abs(ccenb-ccenl)<0.1 -- 2blank cols align w/piece
				and
			abs(rcenb-(rcenl+1.0))<0.1 --blanks below piece
		then
			rowcen(selBlock) := sr+1.0;
			if bc2>bc1 then
			rowcen(blank1) := br1-2.0;
			rowcen(blank2) := br2-1.0;
			else
			rowcen(blank1) := br1-1.0;
			rowcen(blank2) := br2-2.0;
			end if;
		end if;


	elsif( shape=94 ) then -- LR-"L"

		rcenl:=sr-0.5;
		ccenl:=sc-0.5;
		rcenb:=(br1+br2)*0.5;
		ccenb:=(bc1+bc2)*0.5;
		if
			abs(bc1-bc2) < 1.1 -- 2blanks 1 col apart (or less)
				and

			abs(br1-br2) < 0.1 -- 2blanks in same row
				and

			abs(ccenb-ccenl)<0.1 --2blank cols align w/piece
				and

			abs(rcenb-(rcenl+1.5))<0.1 --2blank rows below piece

		then
			rowcen(selBlock) := sr+1.0;
			if bc1>bc2 then
			rowcen(blank1) := br1-2.0;
			rowcen(blank2) := br2-1.0;
			else
			rowcen(blank1) := br1-1.0;
			rowcen(blank2) := br2-2.0;
			end if;
		end if;





	elsif( shape=22 ) then

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

	elsif( shape=12 ) then

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


	elsif( shape=21 ) then

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



	elsif( shape=11 ) then

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


	end if;


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



	if( ret > 0 )	
	then
		if winner then erase:=true; end if;
		nMoves:=nMoves+1;
		test4winner;
	end if;

	return ret;


end movedown;












procedure Draw is
	info: terminal_info;

	Ok: boolean;
	ch: character;
	rc,cc: float;
	ulr, ulc : integer;
	goalrow, goalcol : array(1..2) of integer;
	-- largest puzzle is 5x6:
	tj : array(1..6,1..6) of character := (others=>(others=>' '));
	ts : array(1..6,1..6) of integer := (others=>(others=>0));
	blankpos : array(1..6,1..6) of boolean := (others=>(others=>false));

	-- m=magenta, y=yellow, r=red, g=grey, 
	-- b=blue, k=black, n=green, c=cyan
	type enum is (m,y,r,g,b,k,n,c,x); -- x => not yet set
	colr : enum := x;
	ret: interfaces.c.int;
begin

	info.init_for_stdout(auto);


if erase then

	if mswin then
		SysUtils.Shell("cls", Ok); -- erase-terminal
	else
		SysUtils.Shell("clear", Ok); -- erase-terminal
	end if;
	erase:=false;

else

	if mswin then
		--SysUtils.Shell("tput00", Ok); -- erase-terminal
		ret:=tput00_h.tput00;
	else
		SysUtils.Shell("tput cup 0 0", Ok); -- erase-terminal
	end if;

end if;


if help then

	put_line(" Terminal-DirtyDozen--help-screen");

	put_line(" q,x => quit");
	put_line(" ?  => toggle-help");
	put_line(" r => restart");
	--put_line(" s => toggle colors for Speed");

	put_line(" The blocks of letters slide.");
	put_line(" The objective block is labelled 'a' and it");
	put_line(" must be moved to the lower right corner.");
	put_line("============================================");
	put_line(" Select a block using keys a..p,");
	put_line(" Then use arrow-keys to move it.");
	put_line(" [There is an auto-select mechanism");
	put_line(" that works when only 1 move is possible]");
	put_line(" Keys: <+>, <-> => next, prev puzzle.");
	put_line("============================================");

else

	put_line(" Terminal-DirtyDozen");
	put_line(" move 'a' block to the lower right corner");
	put_line(" minimum: " & movesText );
	put_line(" q = quit,  ? = toggle-help");
	new_line;

	for i in 1..dblk loop
		ch := idchar(i);
		rc := rowcen(i);
		cc := colcen(i);
		case bshape(i) is

			when 12 => 
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.0+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+0,ulc+1):=ch;

				ts(ulr+0,ulc+0):=12;
				ts(ulr+0,ulc+1):=12;

			when 21 =>
				ulr := integer(float'rounding(+0.0+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+1,ulc+0):=ch;

				ts(ulr+0,ulc+0):=21;
				ts(ulr+1,ulc+0):=21;

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

			when 11 =>
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;
				ts(ulr+0,ulc+0):=11;

			when 22 =>
				ulr := integer(float'rounding(+0.0+rc));
				ulc := integer(float'rounding(+0.0+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+1,ulc+0):=ch;
				tj(ulr+0,ulc+1):=ch;
				tj(ulr+1,ulc+1):=ch;

				ts(ulr+0,ulc+0):=22;
				ts(ulr+1,ulc+0):=22;
				ts(ulr+0,ulc+1):=22;
				ts(ulr+1,ulc+1):=22;


			when 91 =>
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;
				tj(ulr+1,ulc+0):=ch;
				tj(ulr+0,ulc+1):=ch;

				ts(ulr+0,ulc+0):=91;
				ts(ulr+1,ulc+0):=91;
				ts(ulr+0,ulc+1):=91;

			when 94 =>
				ulr := integer(float'rounding(-0.5+rc));
				ulc := integer(float'rounding(-0.5+cc));
				tj(ulr+1,ulc+0):=ch;
				tj(ulr+0,ulc+1):=ch;
				tj(ulr+1,ulc+1):=ch;

				ts(ulr+1,ulc+0):=94;
				ts(ulr+0,ulc+1):=94;
				ts(ulr+1,ulc+1):=94;



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


	for i in dblk+1..dblk+2 loop
		ch := idchar(i);
		rc := rowcen(i);
		cc := colcen(i);
		case bshape(i) is
			when 11 =>
				ulr := integer(float'rounding(+0.5+rc));
				ulc := integer(float'rounding(+0.5+cc));
				tj(ulr+0,ulc+0):=ch;
				blankpos(ulr,ulc):=true;
			when others => null;
		end case;
	end loop;





	if bshape(1)=22 then
		ulr := integer(float'rounding(+0.0+grow(1)));
		ulc := integer(float'rounding(+0.0+gcol(1)));
		goalrow(1):=ulr;
		goalrow(2):=ulr+1;
		goalcol(1):=ulc;
		goalcol(2):=ulc+1;
	end if;






-- begin draw puzzle--------------------

   Info.Set_Color (style=>bright);
	--if speedup then
	--Info.Set_Bg(magenta);
	--Info.Set_Fg(yellow); colr:=y;
	--else
   Info.Set_Color (background=>black);
	info.set_color(foreground=>red); colr:=r;
	--end if;


	put("+");
	for col in 1..ncol loop
		put(" +");
	end loop;
	put_line(" +");

	for row in 1..nrow loop
		put("+");

		for col in 1..ncol loop

			--if not speedup then
			case ts(row,col) is
				when 91 =>
					if colr/=b then
					info.set_color(foreground=>blue); colr:=b;
					end if;
				when 94 =>
					if colr/=m then
					info.set_color(foreground=>magenta); colr:=m;
					end if;
				when 22 => 
					if colr/=r then
					info.set_color(foreground=>red); colr:=r;
					end if;
				when 12 => 
					if colr/=n then
					info.set_color(foreground=>green); colr:=n;
					end if;
				when 21 => 
					if colr/=c then
					info.set_color(foreground=>cyan); colr:=c;
					end if;

				when 11 => 
					if colr/=y then
					info.set_color(foreground=>yellow); colr:=y;
					end if;

				when others => null; 
			end case;
			--end if;


			if blankpos(row,col) then
				put("  "); --blank
			else
				put( ' ' & tj(row,col) );
			end if;
		end loop;

		--if not speedup and colr/=r then
		if colr/=r then
		info.set_color(foreground=>red); colr:=r;
		end if;
		put(" +");
		new_line;
	end loop;

	put("+");
	for col in 1..ncol loop
		put(" +");
	end loop;
	put_line(" +");

-- end draw puzzle----------------------

	put("Press = to solve...");
	if movesrem>0 then
		put_line(integer'image(movesrem)&" steps remain");
	else
		put_line("                  ");
	end if;


	put_line( to_string(infilname) );

   Info.Set_Color (Standard_Output, Style => Reset_All);


	if winner then
		put_line("Correct !");
		put_line("Solved in "&integer'image(nMoves)&" steps");
	end if;

end if;

end Draw;








function goodChar(ch: character) return boolean is
begin
	if ada.characters.handling.is_letter(ch) then
		return true;

	elsif (ch in '1'..'9') then
		return true;

	elsif 
		(ch='?') or (ch='=') or (ch='+') or 
		(ch='-') or (ch='\') or (ch='/') or (ch='.')
	then
		return true;

	else
		return false;

	end if;
end;




procedure handle_key_down( ch: character; puzdir: unbounded_string ) is
	ret : integer;
	idch, ckch, mvch: character;

begin


-- note that arrow keys typically produce chars
-- preceded by 1 or 2 non-printable chars.
--
-- on Linux:		<home>='H'	<end>='F'
--   A		
-- D B C
--
-- or on MSWin:	<home>='G'	<end>='O'
--   H
-- K P M


if goodChar(ch) then


	case ch is

		when '=' =>

		if not winner then

			if movesrem>0 then

				idch := element(solutionPath,1);
				ckch := element(solutionPath,2);
				mvch := element(solutionPath,3);
				myassert(ckch='-');
				delete(solutionPath,1,3);
				movesrem := length(solutionPath)/3;
				selBlock := character'pos(idch) - character'pos('a') + 1;

				if    mvch='u' then ret:=moveup;
				elsif mvch='d' then ret:=movedown;
				elsif mvch='l' then ret:=moveleft;
				elsif mvch='r' then ret:=moveright;
				else raise program_error; end if;

			else -- initiate solver

				dumpGameState("dd.txt");
				fbfsl.bfsl( to_unbounded_string("dd.txt"), solutionPath);
				movesrem := length(solutionPath)/3;

			end if;

		end if; --not winner



		when 'a'..'p' => selBlock:= character'pos(ch) - character'pos('a') + 1;

		when 'x' | 'q' =>	userexit:=true;

		when '?' => help := not help; erase:=true;

		--when 's' => speedup := not speedup;

		when 'r' => 
			movesrem:=0;
			Init( to_string(infilname) );
			erase:=true;

		when 'H'|'A' =>	
			movesrem:=0;
			ret:=moveup;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					ret:=moveup;
					exit when selBlock=dblk;
				end loop;
			end if;

		when 'P'|'B' =>	
			movesrem:=0;
			ret:=movedown;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					ret:=movedown;
					exit when selBlock=dblk;
				end loop;
			end if;


		when 'M'|'C' =>	
			movesrem:=0;
			ret:=moveright;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					ret:=moveright;
					exit when selBlock=dblk;
				end loop;
			end if;


		when 'K'|'D' =>	
			movesrem:=0;
			ret:=moveleft;
			if ret=0 then --try autoselect
				selBlock:=0;
				while ret=0 loop
					selBlock:=selBlock+1;
					ret:=moveleft;
					exit when selBlock=dblk;
				end loop;
			end if;


		when '+' => 
			movesrem:=0;
			npuz:=npuz+1;
			if npuz>totgame then npuz:=1; end if;
			infilname := puzdir & shortname(npuz);
			Init( to_string(infilname) );
			erase:=true;

		when '-' => 
			movesrem:=0;
			npuz:=npuz-1;
			if npuz<1 then npuz:=totgame; end if;
			infilname := puzdir & shortname(npuz);
			Init( to_string(infilname) );
			erase:=true;


		when others => null;

	end case;

end if;
end handle_key_down;











gfil: text_io.file_type;

pzldir : unbounded_string := to_unbounded_string("puzzles/");
up2 : constant string := "../../";



	rtime: interfaces.c.int;


begin --cdd


	if mswin then
		rtime:=realtime_hpp.hiPriority;
		-- note:  this seems necessary because some, 
		-- but not all, windows commandline terminals 
		-- seem to randomly freeze at normal priority.
	else
		rtime:=1;
	end if;





	if not ada.directories.exists( to_string(pzldir) ) then
		pzldir := up2 & pzldir;
	end if;



	npuz:=1; -- default to easiest

	infilname := pzldir & shortname(npuz);

	Init( to_string(infilname) ); --// define puzzle parameters here



	if mswin then
		SysUtils.Shell("cls", Ok); -- erase-terminal
	else
		SysUtils.Shell("clear", Ok); -- erase-terminal
	end if;


-- begin main event loop:

	Draw;
	while not userexit loop
		get_immediate(ch);
		handle_key_down( ch, pzldir );
		Draw;
	end loop;

-- end main event loop:

end cdd;

