

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






-- caz.adb
-- 24jun16
--
-- retro-text version of flatAZ intended to run in a terminal
-- window using Ada to facilitate character input from keyboard.
--
-- Build instructions for all platforms:
-- Manually install GNAT GPL from libre.adacore.com/download/.
-- then type "gnatmake caz"

with snd4ada;
with tput00_h;


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

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


with ada.directories;
with Ada.Text_IO; use Ada.Text_IO;
--with ada.numerics.generic_elementary_functions;
--with Ada.Command_Line;
with SysUtils;  use SysUtils;
with Ada.Numerics.Float_Random;

with GNATCOLL.Terminal;  use GNATCOLL.Terminal;
with realtime;



procedure caz is

	G : Ada.Numerics.Float_Random.Generator;

	ch: character;


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


changed,
userexit : boolean := false;


dimen : constant integer := 3;
ncubes  : constant integer := dimen*dimen*dimen;

subtype rngs is integer range 1..dimen;
subtype rngm is integer range 1..ncubes;
type permtype is array(rngs,rngs,rngs) of rngm;

perm : permtype;
brow, bcol, blay : rngs := 3;
winner, help, playedonce : boolean := false;
fanfare: interfaces.c.int;


subtype str1 is string(1..1);
symbol : constant array(1..ncubes) of str1
     := ( "A", "B", "C",   "D", "E", "F",   "G", "H", "I",
          "J", "K", "L",   "M", "N", "O",   "P", "Q", "R", 
			 "S", "T", "U",   "V", "W", "X",   "Y", "Z", " " );





function indx(row,col,lay:rngs) return rngm is
begin
	return (lay-1)*dimen*dimen + (row-1)*dimen + col;
end indx;





procedure test4winner is
	k : integer := 1;
begin
	winner := (brow=dimen) and (bcol=dimen) and (blay=dimen);
	for lay in rngS loop
	for row in rngS loop
	for col in rngS loop
		winner := winner and (perm(row,col,lay) = k);
		k:=k+1;
	end loop;
	end loop;
	end loop;
end test4winner;







	erase: boolean := false;








   procedure movenear is
   -- move space away (to a bigger layer#)
   begin
     if blay<dimen then

	  	 changed:=true;

       perm(brow,bcol,blay):=perm(brow,bcol,blay+1);
       blay:=blay+1;
       perm(brow,bcol,blay):=ncubes;
		 test4winner;

     end if;
   end movenear;

   procedure moveaway is
   -- move space closer (to a smaller layer#)
   begin
     if blay>1 then

	  	 changed:=true;

       perm(brow,bcol,blay):=perm(brow,bcol,blay-1);
       blay:=blay-1;
       perm(brow,bcol,blay):=ncubes;
		 test4winner;

     end if;
   end moveaway;





   procedure moveleft is
   --move space to a bigger col#
   begin
     if bcol<dimen then

	  	 changed:=true;

       perm(brow,bcol,blay):=perm(brow,bcol+1,blay);
       bcol:=bcol+1;
       perm(brow,bcol,blay):=ncubes;
		 test4winner;

     end if;
   end moveleft;

   procedure moveright is
   --move space to a smaller col#
   begin
     if bcol>1 then

	  	 changed:=true;

       perm(brow,bcol,blay):=perm(brow,bcol-1,blay);
       bcol:=bcol-1;
       perm(brow,bcol,blay):=ncubes;
		 test4winner;

     end if;
   end moveright;










   procedure movedown is
   --move space to a smaller row#
   begin
     if brow>1 then

	  	 changed:=true;

       perm(brow,bcol,blay):=perm(brow-1,bcol,blay);
       brow:=brow-1;
       perm(brow,bcol,blay):=ncubes;
		 test4winner;

     end if;
   end movedown;

   procedure moveup is
   --move space to a bigger row#
   begin
     if brow<dimen then

	  	 changed:=true;

       perm(brow,bcol,blay):=perm(brow+1,bcol,blay);
       brow:=brow+1;
       perm(brow,bcol,blay):=ncubes;
		 test4winner;

     end if;
   end moveup;















up : constant str1 := "u";
dn : constant str1 := "d";
lt : constant str1 := "l";
rt : constant str1 := "r";
nr : constant str1 := "n";
aw : constant str1 := "a";
sol : array(1..100_000) of str1;
nsol : integer := 0;






   procedure shuffle( level: in integer ) is

	  r : Ada.Numerics.Float_Random.Uniformly_Distributed;

     n : integer;
	  br1,br2,bc1,bc2,bl1,bl2: integer;
	  prev : str1 := "z";
   begin

		winner:=false; erase:=true;
     for row in rngS loop
       for col in rngS loop
         for lay in rngS loop
           perm(row,col,lay) := indx(row,col,lay);
	 		end loop;
       end loop;
     end loop;
     brow:=dimen;
     bcol:=dimen;
     blay:=dimen;

     case level is
     when 0 => n:=0;
     when 1 => n:=10;
     when 2 => n:=100;
     when 3 => n:=1000;
     when 4 => n:=10_000;
     when 5 => n:=100_000;
     when others => n:=0;
     end case;


-- here we use a "stack" of letters {l,r,u,d,n,a} to 
-- store solution for possible playback
-- WARNING:  for large n, stored solution is 
--           likely very far from optimal!

	  nsol:=0;
     for i in 1..n loop

		 r := Ada.Numerics.Float_Random.Random(G);


       if r<0.16 and prev /= rt then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         moveleft;                                --attempted move
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then --attempt succeeded
				prev:=lt;
				nsol:=nsol+1; sol(nsol):=rt;          --store move
			end if;
       elsif r<0.33 and prev /= lt then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         moveright;											--attempt
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then  --success
				prev:=rt;
				nsol:=nsol+1; sol(nsol):=lt;           --store
			end if;
       elsif r<0.49 and prev /= dn then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         moveup;
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then
				prev:=up;
				nsol:=nsol+1; sol(nsol):=dn;
			end if;
       elsif r<0.66 and prev /= up then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         movedown;
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then
				prev:=dn;
				nsol:=nsol+1; sol(nsol):=up;
			end if;
       elsif r<0.82 and prev /= aw then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         movenear;
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then
				prev:=nr;
				nsol:=nsol+1; sol(nsol):=aw;
			end if;
       elsif prev /= nr then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         moveaway;
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then
				prev:=aw;
				nsol:=nsol+1; sol(nsol):=nr;
			end if;
       end if;

     end loop;
   end shuffle;








procedure initperm is
begin

   for row in rngS loop
     for col in rngS loop
       for lay in rngS loop
           perm(row,col,lay) := indx(row,col,lay);
       end loop;
     end loop;
   end loop;
	brow:=dimen;
	bcol:=dimen;
	blay:=dimen;
	if perm(brow,bcol,blay) /= ncubes then
		raise program_error;
	end if;
end initperm;










procedure Draw is
	Ok: boolean;
	s : str1;

	info: terminal_info;

begin
if changed or erase then

	changed:=false;

	info.init_for_stdout(auto);


if erase then

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

else

	if mswin then
		--SysUtils.Shell("cls", Ok); -- erase-terminal
		tput00_h.cursorHome;
	else
		SysUtils.bShell("tput cup 0 0", Ok); -- erase-terminal
	end if;

end if;


if help then

	put_line(" ?=toggle-help,  key-map:");
	put_line("=====================================");
	put_line(" layer up = LU:");
	put_line(" <u>, <.>, <\>, <home>, <->");
	new_line;
	put_line(" layer down = LD:");
	put_line("  <o>, </>, <end>, <+>");
	put_line("=====================================");
	put_line(" old-school controls:");
	put_line(" u=LU   i=no   o=LD");
	put_line(" j=we   k=so   l=ea");
	put_line("=====================================");
	put_line(" modern controls:");
	put_line(" use arrow keys within a layer,");
	put_line(" (+), (-) keys move between layers.");
	put_line("=====================================");

else

	put_line(" 3D Alphabet Slider...Scramble then restore ordering");
	put_line(" q=quit,  ?=toggle-help,  1..5 to scramble");
	new_line;

-- colors available:
-- black,red,green,yellow,blue,magenta,cyan,grey
   --Info.Set_Color (style=>bright);--may upset colors
   Info.Set_Color (background=>black);

	info.set_color(foreground=>magenta);


	for lay in 1..dimen loop


		if lay=blay then
		   Info.Set_Color (background=>grey); --blue);
		else
		   Info.Set_Color (background=>black);
		end if;
		if lay=2 then
			info.set_color(foreground=>green);
		elsif lay=3 then
			info.set_color(foreground=>cyan);
		end if;

		put_line(" ------- ");

		for row in 1..dimen loop
			put("|");
			for col in 1..dimen loop
				s := symbol( perm(row,col,lay) );
				put(' '&s);
			end loop;
			--new_line;
			put_line(" |");
		end loop;

	end loop;

	put_line(" ------- ");

   Info.Set_Color (Standard_Output, Style => Reset_All);
	if winner then
	   --Info.Set_Color (background=>black);
		info.set_color(foreground=>yellow);
		put_line(" Correct !");
		if not playedonce then
			snd4ada.playSnd(fanfare);
			playedonce:=true;
		end if;
	else
		playedonce:=false;
		put_line("          ");
	end if;

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

end if;
end if; --changed
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 ) is
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 '1' => shuffle(1);
		when '2' => shuffle(2);
		when '3' => shuffle(3);
		when '4' => shuffle(4);
		when '5' => shuffle(5);

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

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

		when 'A' | 'i' | 'w' =>	moveup;

		when 'B' | 'k' | 's' =>	movedown;

		when 'C' | 'l' | 'd' =>	moveright;

		when 'D' | 'j' | 'a' =>	moveleft;

		-- layer-down
		when 'F' | 'o' | '/' | '+' => moveaway;

		-- layer-up <home>=>'H'
		when 'H' | 'u' | '.' | '\' | '-' => movenear;

		when others => changed:=false;

	end case;

end if;
end handle_key_down;




procedure mswin_key_down( ch: character ) is
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 '1' => shuffle(1);
		when '2' => shuffle(2);
		when '3' => shuffle(3);
		when '4' => shuffle(4);
		when '5' => shuffle(5);

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

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

		when 'H' | 'i' | 'w' =>	moveup;

		when 'P' | 'k' | 's' =>	movedown;

		when 'M' | 'l' | 'd' =>	moveright;

		when 'K' | 'j' | 'a' =>	moveleft;

		-- layer-down
		when 'O' | 'o' | '/' | '+' => moveaway;

		-- layer-up <home>=>'H'
		when 'G' | 'u' | '.' | '\' | '-' => movenear;

		when others => changed:=false;

	end case;

end if;
end mswin_key_down;











Ok : boolean := false;




	rtime: interfaces.c.int;


procedure initsounds( path: string ) is
begin

	snd4ada.initSnds;
	fanfare := snd4ada.initSnd(
		Interfaces.C.Strings.New_String(path&"applause.wav"));
	if fanfare<0 then
		put_line("snd4ada.initSnd ERROR fanfare");
		raise program_error;
	end if;

end initsounds;

	path0 : constant string(1..7)  := "sounds/";
	path1 : constant string(1..13) := "../../sounds/";



begin --caz


	if mswin then
		rtime:=realtime.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;




---------------- begin sound addendum --------------------------

	if ada.directories.Exists(path0) then
		initsounds(path0);
	else
		initsounds(path1);
	end if;

---------------- end sound addendum --------------------------




	InitPerm;
	Ada.Numerics.Float_Random.Reset(G); --randomize (time-dependent)

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

	changed:=true;
	Draw;

	while not userexit loop
		get_immediate(ch);
		if mswin then
		mswin_key_down(ch);
		else
		handle_key_down(ch);
		end if;
		Draw;
	end loop;


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

	snd4ada.termSnds;


end caz;






