
--
-- Copyright (C) 2017  <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/>.
--

with fbfs26;
with ada.directories;

with gl, gl.binding, gl.pointers;
with glu, glu.binding, glu.pointers;
with glext, glext.binding, glext.pointers;

with glfw3;

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

with System;
with Interfaces.C;
use  type interfaces.c.unsigned;
with Interfaces.C.Pointers;
with interfaces.c.strings;

with ada.numerics.generic_elementary_functions;
with Ada.Numerics.Float_Random;
with Ada.Command_Line;
with text_io;
with unchecked_deallocation;
with ada.strings.unbounded;
----------------------------------------------------------------

with stex;
with zoomwheel;
with snd4ada;
with pngloader;
with gametypes;
with matutils;

with shader;  use shader;

with dumpgl;
----------------------------------------------------------------



procedure cube is

	G : Ada.Numerics.Float_Random.Generator;


	prep_error : exception;
	cube_error : exception;

	--use bfs26;
	use glfw3;
	use dumpgl;

	use text_io;
	use gametypes;
	use pngloader;
	use matutils;
	use gametypes.fmath;

	use interfaces.c;
	use interfaces.c.strings;
	use glext;
	use glext.pointers;
	use glext.binding;
	use gl;
	use gl.binding;
	use gl.pointers;

	use ada.strings.unbounded;

	-- mm = modelmatrix,
	-- vm = viewmatrix,
	-- pm = perspectivematrix,
	--
	mv, vm, mvp, pm, mm : mat44 := identity;



	otitle : string := "RufasCube";
	rtitle : string := "RgbCube";
	ititle : string := "iQube";

	mainWin : access GLFWwindow;








procedure updateMVP( wid,hit : float) is
	eye : float := float(zoomwheel.zdist);
begin

	perspective(pm, 45.0, wid/hit,  0.1, 100.0);

	--            eye             cen           up
	lookat(vm, 0.0,0.0,eye,  0.0,0.0,0.0,  0.0,1.0,0.0 );

	degRevRotate(mm, rotx, roty, rotz ); --updates mm
	rotx:=0.0; roty:=0.0; rotz:=0.0;

	mvp:=mm;
	matXmat(mvp,vm);
	matXmat(mvp,pm);

end updateMVP;












procedure amyassert( condition : boolean; code:integer:=0 ) is
begin
  if condition=false then
  		text_io.put_line("Assertion Failed #"&integer'image(code));
  		raise program_error;
  end if;
end amyassert;





procedure InitGLFW( 
	wid, hit : in glint; 
	fwd,fht : out glint; 
	name: string ) is

	use system;

	title : interfaces.c.strings.chars_ptr := new_string(name&ascii.nul);

	maj,min,rev : aliased glint;

	axs, ays : aliased float;
	awwid,awhit, afwid, afhit : aliased glint;


begin

	put_line("...using fastrgv's Ada Binding to GLFW3...");

	GlfwGetVersion(maj'access,min'access,rev'access); --naturals
	put("GLFW ver: ");
	put(glint'image(maj));
	put(":"&glint'image(min));
	put(":"&glint'image(rev));
	New_Line;



	if GlfwInit /= gl_true then
		new_line;
		put_line("glfwInit failed");
		raise program_error;
	end if;

	-- use version here that your graphics card would support:
	GlfwWindowHint( glfw_context_version_major, 3);
	GlfwWindowHint( glfw_context_version_minor, 3);
	GlfwWindowHint( glfw_opengl_forward_compat, gl_true);
	GlfwWindowHint( glfw_opengl_profile, glfw_opengl_core_profile);

	GlfwWindowHint( glfw_samples, 4);
	GlfwWindowHint( glfw_client_api, glfw_opengl_api);

	-- this seems unnecessary...
	-- MacBook shows this app @ HiDpi by default!
	--GlfwWindowHint( glfw_cocoa_retina_framebuffer, glfw_true );



	mainWin := glfwcreatewindow(
		wid, hit,	title, 
		null, null );
		

	if mainWin = null then
		new_line;
		put_line("glfwCreateWindow failed");
		raise program_error;
	end if;

	glfwmakecontextcurrent( mainWin );


--HiDpi queries:
	glfwGetWindowSize(mainWin, awwid'access, awhit'access);
	glfwGetFramebufferSize(mainWin, afwid'access,afhit'access);
	glfwGetWindowContentScale(mainWin, axs'access,ays'access);

	fwd:=afwid;
	fht:=afhit;

	put_line("HighDpi Queries:");
	put_line("WI: "&glint'image(awwid)&","&glint'image(awhit));
	put_line("FB: "&glint'image(afwid)&","&glint'image(afhit));
	put_line("Sc: "&float'image(axs)&","&float'image(ays));


end InitGLFW;


cskin, -- 16jan20 new rufascube flag
gskin, yskin, rskin : boolean := false;
rgbskin: boolean := true;

rundirstr : string := ada.directories.current_directory;


procedure first_prep is -- main program setup
begin

	snd4ada.initSnds;

	fanfare := snd4ada.initSnd(
		--Interfaces.C.Strings.New_String("data/fanfare.wav"),90);
		--Interfaces.C.Strings.New_String(rundirstr&"/"&"data/fanfare.wav"),90);
		Interfaces.C.Strings.New_String(rundirstr&"/"&"data/applause.wav"));

	whoosh := snd4ada.initSnd(
		--Interfaces.C.Strings.New_String("data/whoosh_4th.wav"),90);
		Interfaces.C.Strings.New_String(rundirstr&"/"&"data/whoosh_4th.wav"));

	if fanfare<0 or whoosh<0 then
		put_line("snd4ada.initSnds ERROR");
		raise program_error;
	end if;




------- begin GLFW prep ---------------------------------------------------


	winwidth  := 600;
	winheight := 600;

	if gskin or yskin or rskin then
		InitGLFW( winwidth, winheight, Fwid,Fhit, ititle);
	else
		cskin:=true;
		InitGLFW( winwidth, winheight, Fwid,Fhit, otitle);
	end if;

	zoomwheel.enable(mainWin);

	glViewport(0,0,fwid,fhit);


	glgenvertexarrays(1, vertexarrayid'address );
	glbindvertexarray(vertexarrayid);

	glactivetexture(gl_texture0); -- moved here 5nov14 (outside main loop)

	glgenbuffers(1, vertexbuff'address);
	glgenbuffers(1, colorbuff'address);



	glenable(gl_depth_test);
	gldepthfunc( gl_lequal );
	glenable( gl_cull_face );


	--if dumpGLerrorQueue("first_prep")>0 and then dump_debug then
	--	raise prep_error;
	--end if;



	-- reduces aliasing:
	glEnable(GL_MULTISAMPLE);
	glHint(GL_LINE_SMOOTH_HINT, GL_NICEST);
	glHint(GL_POLYGON_SMOOTH_HINT, GL_NICEST);



	glClearColor(0.7,0.7,0.7,1.0); -- light bkgd for black lettering
	--glClearColor(0.3,0.3,0.3,1.0); -- new bkgd per Kcube, black lettering

end first_prep;















------- begin game specific code (from lumen ver.) -------------------



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 := 2;

mute,
winner, hint, help, show_axes, details : boolean := false;

xxx,yyy,zzz : array(rngm) of float;

red,grn,blu : array(1..ncubes*6) of float; -- for Rufas cube colors
red27,grn27,blu27 : array(1..ncubes) of float; -- for RGB skin colors

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

lymbol : 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" );




ntri  : constant integer := 12*(ncubes-1);
ncorners : constant integer := 3*ntri;
nvert: constant integer := 3*ncorners;

type varray is array(1..nvert) of aliased float;
type vap is access varray;

vertices, colors : vap;
-- these are initialized/reset in "cubic"



procedure vfree is new unchecked_deallocation(varray,vap);





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










-- Solution to IQube:
-- red layout to match iqube1.gif:
--
-- row3:
--c1 c2 c3
--19 22 25	rux
--   20 23 26	svy
--      21 24 27	twz
--
-- row2:
--c1 c2 c3
--10 13 16	jmo
--   11 14 17	k p
--      12 15 18	lnq
--
-- row1:
--c1 c2 c3
-- 1  4  7	adg	lay=1
--    2  5  8	beh	lay=2
--       3  6  9	cfi	lay=3

--// this shuffle generates yellow iQube w/green dots
--// solution:  exterior = red
--indx(row,col,lay) = (row-1)*3*3 + (col-1)*3 + lay
--// yellow + green dots
procedure jaapsetyellowG is
begin
	brow:=2; bcol:=2; blay:=2;
	perm(2,3,3):=indx(1,1,1); -- q/a
	perm(2,3,1):=indx(1,1,2); -- o/b
	perm(2,3,2):=indx(1,1,3); -- p/c

	perm(3,3,3):=indx(1,2,1); -- z/d
	perm(3,3,1):=indx(1,2,2); -- x/e
	perm(3,1,1):=indx(1,2,3); -- r/f

	perm(3,2,2):=indx(1,3,1); -- v/g
	perm(3,1,3):=indx(1,3,2); -- t/h
	perm(2,2,1):=indx(1,3,3); -- m/i

	perm(1,2,3):=indx(2,1,1); -- f/j
	perm(1,3,3):=indx(2,1,2); -- i/k
	perm(3,3,2):=indx(2,1,3); -- y/l

	perm(1,1,2):=indx(2,2,1); -- b/m
	perm(2,2,2):=indx(2,2,2); -- central blank
	perm(1,3,1):=indx(2,2,3); -- g/n

	perm(3,1,2):=indx(2,3,1); -- s/o
	perm(3,2,3):=indx(2,3,2); -- w/p
	perm(3,2,1):=indx(2,3,3); -- u/q

	perm(2,2,3):=indx(3,1,1); -- n/r
	perm(1,2,1):=indx(3,1,2); -- d/s
	perm(1,2,2):=indx(3,1,3); -- e/t

	perm(2,1,3):=indx(3,2,1); -- l/u
	perm(1,1,3):=indx(3,2,2); -- c/v
	perm(1,3,2):=indx(3,2,3); -- h/w

	perm(2,1,2):=indx(3,3,1); -- k/x
	perm(1,1,1):=indx(3,3,2); -- a/y
	perm(2,1,1):=indx(3,3,3); -- j/z
end jaapsetyellowG;


--// yellow + red dots
procedure jaapsetyellowR is
begin
	brow:=2; bcol:=2; blay:=2;
	perm(2,3,3):=indx(1,1,1); -- q/a
	perm(2,3,1):=indx(1,1,2); -- o/b
	perm(2,2,3):=indx(1,1,3); -- n/c

	perm(3,3,3):=indx(1,2,1); -- z/d
	perm(3,3,1):=indx(1,2,2); -- x/e
	perm(3,1,1):=indx(1,2,3); -- r/f

	perm(1,2,2):=indx(1,3,1); -- e/g
	perm(3,1,3):=indx(1,3,2); -- t/h
	perm(2,3,2):=indx(1,3,3); -- p/i

	perm(1,2,3):=indx(2,1,1); -- f/j
	perm(1,3,3):=indx(2,1,2); -- i/k
	perm(3,3,2):=indx(2,1,3); -- y/l

	perm(1,1,2):=indx(2,2,1); -- b/m
	perm(2,2,2):=indx(2,2,2); -- central blank
	perm(1,3,1):=indx(2,2,3); -- g/n

	perm(3,1,2):=indx(2,3,1); -- s/o
	perm(3,2,3):=indx(2,3,2); -- w/p
	perm(3,2,1):=indx(2,3,3); -- u/q

	perm(2,2,1):=indx(3,1,1); -- m/r
	perm(1,2,1):=indx(3,1,2); -- d/s
	perm(2,1,2):=indx(3,1,3); -- k/t

	perm(2,1,3):=indx(3,2,1); -- l/u
	perm(1,1,3):=indx(3,2,2); -- c/v
	perm(1,3,2):=indx(3,2,3); -- h/w

	perm(3,2,2):=indx(3,3,1); -- v/x
	perm(1,1,1):=indx(3,3,2); -- a/y
	perm(2,1,1):=indx(3,3,3); -- j/z
end jaapsetyellowR;


procedure jaapsetgreen is
begin
	brow:=2; bcol:=2; blay:=2;

	perm(3,2,2):=indx(1,1,1); -- v
	perm(3,2,3):=indx(1,1,2); -- w
	perm(3,3,1):=indx(1,1,3); -- x

	perm(2,1,2):=indx(1,2,1); -- k
	perm(2,1,3):=indx(1,2,2); -- l
	perm(2,3,2):=indx(1,2,3); -- p

	perm(3,1,3):=indx(1,3,1); -- t
	perm(2,2,1):=indx(1,3,2); -- m
	perm(3,1,1):=indx(1,3,3); -- r

	perm(3,3,2):=indx(2,1,1); -- y
	perm(3,2,1):=indx(2,1,2); -- u
	perm(1,2,1):=indx(2,1,3); -- d

	perm(3,3,3):=indx(2,2,1); -- z
	perm(2,2,2):=indx(2,2,2); -- central blank
	perm(3,1,2):=indx(2,2,3); -- s

	perm(1,2,3):=indx(2,3,1); -- f
	perm(1,1,1):=indx(2,3,2); -- a
	perm(1,1,2):=indx(2,3,3); -- b

	perm(1,3,3):=indx(3,1,1); -- i
	perm(2,3,3):=indx(3,1,2); -- q
	perm(1,3,1):=indx(3,1,3); -- g

	perm(1,3,2):=indx(3,2,1); -- h
	perm(2,3,1):=indx(3,2,2); -- o
	perm(2,1,1):=indx(3,2,3); -- j

	perm(1,1,3):=indx(3,3,1); -- c
	perm(2,2,3):=indx(3,3,2); -- n
	perm(1,2,2):=indx(3,3,3); -- e

end jaapsetgreen;









firstcallcubic : boolean := true;

	-- this is where the vertex,color data is loaded:
procedure cubic( 
	rr : float;  
	perm : permtype
	) is separate;


xold,yold : aliased gldouble;




--WARNING:  this test is too simplistic.  We need to handle
--the cases where "A" is not in its original location
--and orientation.  There are other valid solutions.
function xtest4winner return boolean is
	localwinner: boolean := (brow=2) and (bcol=2) and (blay=2);
begin
	for row in rngS loop
	for col in rngS loop
	for lay in rngS loop
		localwinner := localwinner and 
			(perm(row,col,lay) = indx(row,col,lay));
	end loop;
	end loop;
	end loop;
	return localwinner;
end xtest4winner;


function manhattan( row1,col1,lay1, row2,col2,lay2 : integer ) return integer is
begin
	return abs(row1-row2)+abs(col1-col2)+abs(lay1-lay2);
end manhattan;

procedure test4winner is
	r,c,l : array(1..27) of integer; -- ordered coords of blocks
	oldwin : boolean := xtest4winner;
	n : integer;
begin

	if not rgbskin then 
	-- these options have only 1 winning config because each
	-- cubelet has uniquely colored faces

		winner := xtest4winner;

	else 
	-- the rgbskin option has multiple winning configs because each
	-- cubelet has a uniform color on all faces


		for row in rngS loop
		for col in rngS loop
		for lay in rngS loop
			n:=perm(row,col,lay);
			r(n):=row;
			c(n):=col;
			l(n):=lay;
		end loop;
		end loop;
		end loop;

		winner :=

		-- test lower layer carefully
		( 1 = manhattan(r(1),c(1),l(1), r(2),c(2),l(2)) ) and
		( 2 = manhattan(r(1),c(1),l(1), r(3),c(3),l(3)) ) and
		( 1 = manhattan(r(1),c(1),l(1), r(4),c(4),l(4)) ) and
		( 2 = manhattan(r(1),c(1),l(1), r(5),c(5),l(5)) ) and
		( 3 = manhattan(r(1),c(1),l(1), r(6),c(6),l(6)) ) and
		( 2 = manhattan(r(1),c(1),l(1), r(7),c(7),l(7)) ) and
		( 3 = manhattan(r(1),c(1),l(1), r(8),c(8),l(8)) ) and
		( 4 = manhattan(r(1),c(1),l(1), r(9),c(9),l(9)) ) and

		-- test nearest neighbors in 2 lower layers
		( 1 = manhattan(r(1),c(1),l(1), r(10),c(10),l(10)) ) and
		( 1 = manhattan(r(2),c(2),l(2), r(11),c(11),l(11)) ) and
		( 1 = manhattan(r(3),c(3),l(3), r(12),c(12),l(12)) ) and
		( 1 = manhattan(r(4),c(4),l(4), r(13),c(13),l(13)) ) and
		( 1 = manhattan(r(5),c(5),l(5), r(14),c(14),l(14)) ) and
		( 1 = manhattan(r(6),c(6),l(6), r(15),c(15),l(15)) ) and
		( 1 = manhattan(r(7),c(7),l(7), r(16),c(16),l(16)) ) and
		( 1 = manhattan(r(8),c(8),l(8), r(17),c(17),l(17)) ) and
		( 1 = manhattan(r(9),c(9),l(9), r(18),c(18),l(18)) ) and

		-- test nearest neighbors in 2 upper layers
		( 1 = manhattan(r(19),c(19),l(19), r(10),c(10),l(10)) ) and
		( 1 = manhattan(r(20),c(20),l(20), r(11),c(11),l(11)) ) and
		( 1 = manhattan(r(21),c(21),l(21), r(12),c(12),l(12)) ) and
		( 1 = manhattan(r(22),c(22),l(22), r(13),c(13),l(13)) ) and
		( 1 = manhattan(r(23),c(23),l(23), r(14),c(14),l(14)) ) and
		( 1 = manhattan(r(24),c(24),l(24), r(15),c(15),l(15)) ) and
		( 1 = manhattan(r(25),c(25),l(25), r(16),c(16),l(16)) ) and
		( 1 = manhattan(r(26),c(26),l(26), r(17),c(17),l(17)) ) and
		( 1 = manhattan(r(27),c(27),l(27), r(18),c(18),l(18)) ) and


		-- test opposite corners
		( 6 = manhattan(r(1),c(1),l(1), r(27),c(27),l(27)) ) and --A/Z
		( 6 = manhattan(r(3),c(3),l(3), r(25),c(25),l(25)) ) and --C/X
		( 6 = manhattan(r(7),c(7),l(7), r(21),c(21),l(21)) ) and --G/T
		( 6 = manhattan(r(9),c(9),l(9), r(19),c(19),l(19)) ) and --I/R

		(brow=2) and (bcol=2) and (blay=2);


		if not winner and oldwin then
			put_line("winner test alert:  new fails, old passes");
		elsif winner and not oldwin then
			put_line("winner test alert:  old fails, new passes");
		end if;


		-- In case there are other winning configs [RGBskin mode] that are not recognized,
		-- or bogus configs that are deemed winners, the (x)-key will toggle this dump
		-- so that we may refine the test criteria.  I believe the black "A" cube may
		-- occupy 4 out of 8 corner positions, and that there are 3 out of 6 RGB permutations
		-- for each, i.e. 4*3=12 valid layouts for red(3), grn(7), blu(19).
		if details then -- if this config should be a winner, add it!
			put("  red(C):"&integer'image(r(3))&","&integer'image(c(3))&","&integer'image(l(3)));
			put("  grn(G):"&integer'image(r(7))&","&integer'image(c(7))&","&integer'image(l(7)));
			put("  blu(R):"&integer'image(r(19))&","&integer'image(c(19))&","&integer'image(l(19)));
			new_line;
		end if;



	end if; --rgbskin

end test4winner;





   procedure moveZm is
   -- move space away (to a bigger layer#)
   begin
     if blay<dimen then
       perm(brow,bcol,blay):=perm(brow,bcol,blay+1);
       blay:=blay+1;
       perm(brow,bcol,blay):=14;
		 test4winner;

		 if not mute then snd4ada.playSnd(whoosh); end if;

     end if;
   end moveZm;

   procedure moveZp is
   -- move space closer (to a smaller layer#)
   begin
     if blay>1 then
       perm(brow,bcol,blay):=perm(brow,bcol,blay-1);
       blay:=blay-1;
       perm(brow,bcol,blay):=14;
		 test4winner;

		 if not mute then snd4ada.playSnd(whoosh); end if;

     end if;
   end moveZp;

   procedure moveXm is
   --move space to a bigger col#
   begin
     if bcol<dimen then
       perm(brow,bcol,blay):=perm(brow,bcol+1,blay);
       bcol:=bcol+1;
       perm(brow,bcol,blay):=14;
		 test4winner;

		 if not mute then snd4ada.playSnd(whoosh); end if;

     end if;
   end moveXm;

   procedure moveXp is
   --move space to a smaller col#
   begin
     if bcol>1 then
       perm(brow,bcol,blay):=perm(brow,bcol-1,blay);
       bcol:=bcol-1;
       perm(brow,bcol,blay):=14;
		 test4winner;

		 if not mute then snd4ada.playSnd(whoosh); end if;

     end if;
   end moveXp;

   procedure moveYp is
   --move space to a smaller row#
   begin
     if brow>1 then
       perm(brow,bcol,blay):=perm(brow-1,bcol,blay);
       brow:=brow-1;
       perm(brow,bcol,blay):=14;
		 test4winner;

		 if not mute then snd4ada.playSnd(whoosh); end if;

     end if;
   end moveYp;

   procedure moveYm is
   --move space to a bigger row#
   begin
     if brow<dimen then
       perm(brow,bcol,blay):=perm(brow+1,bcol,blay);
       brow:=brow+1;
       perm(brow,bcol,blay):=14;
		 test4winner;

		 if not mute then snd4ada.playSnd(whoosh); end if;

     end if;
   end moveYm;

	--NOTE:  X=invCol, Y=invRow, Z=invLay


	procedure restart 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:=2;
     bcol:=2;
     blay:=2;

	end restart;


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

	haveSolution: integer := 0;
	solutionPath: unbounded_string;


   procedure shuffle( level: in integer ) is

	  r : Ada.Numerics.Float_Random.Uniformly_Distributed;

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

		haveSolution:=0;

		mute:=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:=2;
     bcol:=2;
     blay:=2;

     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;
         moveXm;                      --attempted move
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then --attempt succeeded
				prev:=lf;
				nsol:=nsol+1;
				sol(nsol):=rt;
			end if;
       elsif r<0.33 and prev /= lf then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         moveXp;
		 	br2:=brow; bc2:=bcol; bl2:=blay;
			if br2/=br1 or bc2/=bc1 or bl2/=bl1 then
				prev:=rt;
				nsol:=nsol+1;
				sol(nsol):=lf;
			end if;
       elsif r<0.49 and prev /= dn then
		 	br1:=brow; bc1:=bcol; bl1:=blay;
         moveYm;
		 	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;
         moveYp;
		 	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;
         moveZm;
		 	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;
         moveZp;
		 	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;
	  mute:=msave;

put("#moves in shuffle:");
put(integer'image(nsol));
new_line;


   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:=2;
		bcol:=2;
		blay:=2;
		if perm(brow,bcol,blay) /= 14 then
			raise program_error;
		end if;
	end initperm;






















procedure draw( pid: gluint;  mid, uid : glint ) is
begin

	glUseProgram( pid );
	gluniformmatrix4fv( mid, 1, gl_false, mvp(1,1)'address );
	gluniform1i(uid,0);

	-- 0th attribute:  vertices
	glBindBuffer(gl_array_buffer, vertexbuff);
	glBufferData(gl_array_buffer, glsizeiptr(4*nvert), vertices(1)'address, gl_static_draw);
	glEnableVertexAttribArray(0);
	glVertexAttribPointer(0,3,gl_float,gl_false,0, system.null_address);

	--if dumpGLerrorQueue("draw0")>0 then
		--raise program_error;
		null;
	--end if;


	-- 1st attribute:  color
	glBindBuffer(gl_array_buffer, colorbuff); -- ??? invalid op ???

	--if dumpGLerrorQueue("draw1")>0 then
		--raise program_error;
		null;
	--end if;

	glBufferData(gl_array_buffer, glsizeiptr(4*nvert), colors(1)'address, gl_static_draw);
	glEnableVertexAttribArray(1);
	glVertexAttribPointer(1,3,gl_float,gl_true,0, system.null_address);


	glDrawArrays( gl_triangles, 0, glint(nvert) );


	glDisableVertexAttribArray(0);
	glDisableVertexAttribArray(1);

end draw;



procedure permdump(fname: string) is -- 27feb21 experiment
	i,r,c,l: integer;
	row,col,lev: array(1..27) of integer;
	fout: text_io.file_type;
begin

	for r in 1..3 loop
	for c in 1..3 loop
	for l in 1..3 loop
		i:=perm(r,c,l);
		row(i):=r;
		col(i):=c;
		lev(i):=l;
	end loop;
	end loop;
	end loop;

	text_io.create(fout, out_file, fname);

	for i in 1..27 loop
	if i/=14 then
		r:=row(i); c:=col(i); l:=lev(i);
		put(fout,integer'image(r));
		put(fout,integer'image(c));
		put(fout,integer'image(l));
		new_line(fout);
	end if;
	end loop;

	r:=row(14); c:=col(14); l:=lev(14);
	put(fout,integer'image(r));
	put(fout,integer'image(c));
	put(fout,integer'image(l));
	new_line(fout);

	text_io.close(fout);

end permdump;




	to_init, playedonce : boolean := false;
	to_time,wintime,currentTime : gldouble;

	Mzndc: float;
	v4, vcc : vec4;

	ii,pp : integer;



	major,minor,rev : aliased int;

	exestr : string := ada.command_line.command_name;
	--ok: boolean;


	--fPM_id,
	--ftex_id,
	--fcol_id: glint;
	--fprog_id: gluint;
	--fontcol: constant vec4 := (0.0,0.0,0.0,1.0);
	--fontPM: mat44;

	fontcol: constant vec4 := (0.0,0.0,0.0,1.0); --black

	sz: float;




	btndlay: constant gldouble := 0.25; --mouseclick
	keydlay: constant gldouble := 0.20; --keybd
	oldTimeMs, --mousebtn
	oldTimeKb --keybd
		: gldouble := 0.0;
	--prevTime : gldouble := 0.0; --mouseclick
	timedout, configChanged, dragging, userexit: boolean := false;

procedure clickRight(msx,msy, Wwid, Whit : gldouble ) is separate;

procedure getMouseInputs( mainWin: access GLFWwindow; Wwid,Whit: gldouble ) is separate;
procedure getKeyInputs( mainWin : access GLFWwindow ) is separate;








	hc: boolean := true;

----------------- main program begin ===================================
begin --cube

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

	rgbskin:=true;
	gskin:=false;
	yskin:=false;
	rskin:=false;

--put_line(exestr);
put_line(ada.directories.current_directory);

	-- here we process cmdline arg
   if Ada.Command_Line.Argument_Count > 0 then

     declare
       badparms : boolean := false;
       pstr : string := Ada.Command_Line.Argument(1);--r,g,yg,yr
		 lp : natural := pstr'length;
     begin

		if pstr(1)='r' then
			rgbskin:=true;
		elsif pstr(1)='g' then
			gskin:=true;
		elsif pstr(1)='y' and then lp>1 then
		
			if pstr(2)='g' then
				yskin:=true;
			elsif pstr(2)='r' then
				rskin:=true;
			else
				badparms:=true;
			end if;

		else
			badparms:=true;
		end if;

		if badparms then
			new_line;
			put_line("If the optional single command line parameter");
			put_line("is given, it must be one of the following:");
			put_line("  r  => RGB skin");
			put_line("  g  => iQube with Green outer skin");
			put_line("  yg => iQube with Yellow outer skin w/Green dots");
			put_line("  yr => iQube with Yellow outer skin w/Red dots");
			raise program_error;
		end if;

     end; --declare
   
   end if;



	new_line;

	vertices := new varray;
	colors := new varray;


	first_prep;  -- main program setup


--put("MAIN:  calling playSnd @ 1086");
--	snd4ada.playSnd(fanfare);
--put("...returned from playSnd @ 1087");
--new_line;



	glfwGetVersion(major'access, minor'access, rev'access);
	put_line("GLFW version: "&int'image(major)&"."&int'image(minor));

	glgetintegerv(gl_major_version, major'address);
	glgetintegerv(gl_minor_version, minor'address);
	put_line("openGL version: "&int'image(major)&"."&int'image(minor));


	glGetIntegerv(GL_CONTEXT_PROFILE_MASK, profile'address);
	if( profile = GL_CONTEXT_CORE_PROFILE_BIT ) then
		put_line("ogl-query:  Core Profile");
	end if;

	-- OSX currently requires the forward_compatible flag!
	glGetIntegerv(GL_CONTEXT_FLAGS, flags'address);
	if( flags = GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT ) then
		put_line("ogl-query:  Forward-Compatible bit is set");
	end if;



	programid := 
		loadshaders(
			rundirstr&"/"&"data/vertshader330.glsl", 
			rundirstr&"/"&"data/fragshader330.glsl");
	matrixid  := glgetuniformlocation(programid, pmvp);
	uniftex   := glgetuniformlocation(programid, pmyts);


	initperm;

	cubic(1.0,perm);

	if gskin then
		jaapsetgreen;
	elsif yskin then
		jaapsetyellowG;
	elsif rskin then
		jaapsetyellowR;
	end if;


	-- rotate into preferred initial orientation:
	degrotate( mm, -120.0, 0.0, 0.0, 1.0 ); -- about Zaxis
	degrotate( mm,  +90.0, 0.0, 1.0, 0.0 ); -- about Yaxis




	-- note:  only mm changes:
	updateMVP( float(winwidth), float(winheight) );






	--if dumpGLerrorQueue("00")>0 then
	--	raise cube_error;
	--end if;



	-- prepare font -------------
	stex.InitFont ( "data/NotoSans-Regular.ttf" );
	stex.setColor( fontcol );
	stex.reSize(winwidth,winheight);








	--if dumpGLerrorQueue("beforemainloop")>0 and then dump_debug then
	--	raise cube_error;
	--end if;


	--if dumpGLerrorQueue("beforemainloop")>0 then
		--raise cube_error;
	--	put_line("ERROR prior to main event loop");
	--end if;







	-- main event loop begin: ------------------------------------------
   while not userexit loop

------- begin response to keys ------------------------------------------

		currentTime := glfwGetTime;

		GlfwPollEvents;
		--GlfwWaitEvents;

		getKeyInputs(mainWin);
		exit when userexit;
		getMouseInputs(mainWin,gldouble(winwidth),gldouble(winheight));
		exit when glfwWindowShouldClose(mainWin) /= 0; --14may21 addendum


		cubic( 1.0, perm );


-------- here we should handle resized window ----------------------


		glfwGetWindowSize( mainWin, Nwid'access, Nhit'access );
		if( (Nwid /= winwidth) or (Nhit /= winheight) ) then
			winwidth:=Nwid;  winheight:=Nhit;

			glfwGetFramebufferSize(mainwin, fwid'access, fhit'access);
			glViewport(0,0,Fwid,Fhit);

		end if;

		updateMVP( float(winwidth), float(winheight) );



--------- begin drawing ===============================================

		glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);



------ draw here ----------------------

		--if dumpGLerrorQueue("mainloopX")>0 and then dump_debug then
		--	raise cube_error;
		--end if;

		-------------------------------------
		-- main display function
		-------------------------------------
		draw(programid,matrixid,uniftex);

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


		--if dumpGLerrorQueue("mainloopZ")>0 and then dump_debug then
		--	raise cube_error;
		--end if;





		-- fixed 2d location text:
		stex.print2d("<esc>=exit", 
			0.02, 0.95, 0.5);

		stex.print2d("<spc>=alpha", 
			0.70, 0.95, 0.5);


		stex.print2d("<1-5>=shuffle", 
			0.02, 0.02, 0.5);

		stex.print2d("<h>=help", 
			0.75, 0.02, 0.5);

		if haveSolution>0 then

			declare
				lstr: string := integer'image(haveSolution);
			begin
				stex.print2d("press = again to solve"&lstr, 0.30, 0.94, 0.3);
			end;

		end if;

		if nsol>0 then
			stex.print2d("="&integer'image(nsol), 0.45, 0.02, 0.5);
		end if;


		if help then

			sz:=0.4; --0.53;

			stex.print2d("Restore order of cubelets",         0.02, 0.85, sz, hc);
			stex.print2d("based on color or alpha-hints;",    0.02, 0.80, sz, hc);
			stex.print2d("Note empty space in center.",       0.02, 0.75, sz, hc);
			stex.print2d("1-5 keys shuffle cubelets;",        0.02, 0.70, sz, hc);
			stex.print2d("Left mouse drag rotates puzzle,",    0.02, 0.65, sz, hc);
			stex.print2d("Right mouse btn picks cubelet",     0.02, 0.60, sz, hc);
			stex.print2d("to slide into empty space.",        0.02, 0.55, sz, hc);


			stex.print2d("Laptop users: place cursor on cubelet", 0.02, 0.50, sz, hc);
			stex.print2d("then hit <enter>-key to select & move", 0.02, 0.45, sz, hc);


			stex.print2d("<m>-key Mutes moves",     0.02, 0.40, sz, hc);

			stex.print2d("<=>-key steps towards solution,",     0.02, 0.35, sz, hc);
			stex.print2d("<u>-key undoes shuffle,",             0.02, 0.30, sz, hc);

			-- here are some unexplained options:
			--stex.print2d("<f>=+Z   <Up>=+Y   <Lf>=-X",        0.02, 0.26, sz, hc);
			--stex.print2d("<b>=-Z   <Dn>=-Y   <Rt>=+X",        0.02, 0.23, sz, hc);

			--stex.print2d("<t>=toggleRGB  <c>=cycleAltSkins  <s>=Solve",  0.02, 0.20, sz, hc);
			stex.print2d("<t>=toggleRGB  <c>=cycleAltSkins  <a>=toggleAxes",  0.02, 0.20, sz, hc);

			stex.print2d("<i>=zoomIn  <o>=zoomOut  <r>=Restart", 0.02, 0.15, sz, hc);
			stex.print2d("mouse wheel zooms, too",            0.02, 0.10, sz, hc);

		end if;



		currentTime := glfwGetTime;
		if winner then
			stex.print2d("Correct!", 0.19, 0.83, 1.0 );
			if not playedonce then
		 		snd4ada.playSnd(fanfare); --fanfare
				playedonce:=true;
				wintime:=currentTime;
			end if;
			if( currentTime-wintime > 8.0 ) then --show for 8 sec
				winner:=false;
			end if;
		else
			playedonce:=false;
		end if;

		currentTime := glfwGetTime;
		if timedout then
			stex.print2d("Timed Soln NOT found",0.3,0.94,0.3);
			if not to_init then
				to_init:=true;
				to_time:=currentTime;
			end if;
			if ((currentTime-to_time)>4.0) then --show only for 4 sec
				timedout:=false;
				to_init:=false;
				--put_line(" T O unset");
			end if;
		end if;




		-- 3D text showing XYZ axes:
		if show_axes then

			v4 := (+1.1, -1.1, -1.1, 1.0);
			matXvec(mvp, v4, vcc);
			stex.print3d("+X", vcc(1), vcc(2), vcc(3), vcc(4), 1.0, 0.9);

			v4 := (-1.1, +1.1, -1.1, 1.0);
			matXvec(mvp, v4, vcc);
			stex.print3d("+Y", vcc(1), vcc(2), vcc(3), vcc(4), 1.0, 0.9);

			v4 := (-1.1, -1.1, +1.1, 1.0);
			matXvec(mvp, v4, vcc);
			stex.print3d("+Z", vcc(1), vcc(2), vcc(3), vcc(4), 1.0, 0.9);

		end if;


		-- 3D text showing cubelet letters:
		if hint then

			-- find median Z (to hide posterior text):
			ii := indx(2,2,2); --center cubelet
			v4 := (xxx(ii), yyy(ii), zzz(ii), 1.0);
			matXvec(mvp,v4,vcc);
			Mzndc := 1.0021*vcc(3)/vcc(4); --median Z (Normalized Device Coords)
			--4mar21 adjustment factor: to see letter of depressed center cubelet

			for row in rngs loop
			for col in rngs loop
			for lay in rngs loop
			if row /= brow or col /= bcol or lay /= blay then

				ii := indx(row,col,lay);
				pp := perm(row,col,lay);
				v4 := ( xxx(ii), yyy(ii), zzz(ii), 1.0 );
				matXvec(mvp, v4, vcc);
				stex.print3d(symbol(pp), 
					vcc(1), vcc(2), vcc(3), vcc(4), 
					Mzndc, 2.5/float(zoomwheel.zdist));
				--stex.print3d(symbol(pp), vcc(1), vcc(2), vcc(3), vcc(4), Mzndc, 0.9);

			end if;
			end loop;
			end loop;
			end loop;



------ 2D textual layout diagram in upper right corner of window ---------------

			sz:=0.4;

			--row1 layout:
			stex.print2d( lymbol( perm(1,1,1) ), 0.88,0.90, sz );
			stex.print2d( lymbol( perm(1,1,2) ), 0.92,0.90, sz );
			stex.print2d( lymbol( perm(1,1,3) ), 0.96,0.90, sz );

			stex.print2d( lymbol( perm(1,2,1) ), 0.88,0.86, sz );
			stex.print2d( lymbol( perm(1,2,2) ), 0.92,0.86, sz );
			stex.print2d( lymbol( perm(1,2,3) ), 0.96,0.86, sz );

			stex.print2d( lymbol( perm(1,3,1) ), 0.88,0.82, sz );
			stex.print2d( lymbol( perm(1,3,2) ), 0.92,0.82, sz );
			stex.print2d( lymbol( perm(1,3,3) ), 0.96,0.82, sz );

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

			--row2 layout:
			stex.print2d( lymbol( perm(2,1,1) ), 0.88,0.74, sz );
			stex.print2d( lymbol( perm(2,1,2) ), 0.92,0.74, sz );
			stex.print2d( lymbol( perm(2,1,3) ), 0.96,0.74, sz );

			stex.print2d( lymbol( perm(2,2,1) ), 0.88,0.70, sz );
			stex.print2d( lymbol( perm(2,2,2) ), 0.92,0.70, sz );
			stex.print2d( lymbol( perm(2,2,3) ), 0.96,0.70, sz );

			stex.print2d( lymbol( perm(2,3,1) ), 0.88,0.66, sz );
			stex.print2d( lymbol( perm(2,3,2) ), 0.92,0.66, sz );
			stex.print2d( lymbol( perm(2,3,3) ), 0.96,0.66, sz );

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

			--row3 layout:
			stex.print2d( lymbol( perm(3,1,1) ), 0.88,0.58, sz );
			stex.print2d( lymbol( perm(3,1,2) ), 0.92,0.58, sz );
			stex.print2d( lymbol( perm(3,1,3) ), 0.96,0.58, sz );

			stex.print2d( lymbol( perm(3,2,1) ), 0.88,0.54, sz );
			stex.print2d( lymbol( perm(3,2,2) ), 0.92,0.54, sz );
			stex.print2d( lymbol( perm(3,2,3) ), 0.96,0.54, sz );

			stex.print2d( lymbol( perm(3,3,1) ), 0.88,0.50, sz );
			stex.print2d( lymbol( perm(3,3,2) ), 0.92,0.50, sz );
			stex.print2d( lymbol( perm(3,3,3) ), 0.96,0.50, sz );


------ 2D layout ---------------------------------------



		end if;





--------- end drawing =================================================


		if dumpGLerrorQueue("mainloopend")>0 and then dump_debug then
			raise cube_error;
		end if;



		glflush;
		glfwSwapBuffers( mainWin );


   end loop; ---------------- main event loop end -----------------------



	snd4ada.termSnds;

	stex.CloseFont;


	glext.binding.glDeleteProgram(programid);
	glext.binding.glDeleteBuffers(1, vertexbuff'address);
	glext.binding.glDeleteBuffers(1, colorbuff'address);
	glext.binding.glDeleteVertexArrays(1, vertexarrayid'address);


	vfree( vertices );
	vfree( colors );


	glfwdestroywindow(mainWin);
	glfwTerminate;



end cube;


