

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


-- World Cup Sokerban

-- Soccer-themed Sokoban, GLFW3 version;  Retina compatible.


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

with ada.directories;

with snd4ada;

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

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

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

with glfw3;		use glfw3;
with zoomwheel; use zoomwheel;

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

with matutils;
with gtex;

with ada.unchecked_conversion;
with unchecked_deallocation;
with Ada.Command_Line;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;
with ada.numerics.generic_elementary_functions;
with ada.characters.handling;

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


with shader;  use shader;

with roomobj;
with rectobj;
with pictobj;
with cyl2obj;



with text_io;
with ada.integer_text_io;
with ada.float_text_io;
with pngloader;
with matutils;

with ada.calendar;

with ada.strings.fixed;
with emhungarian;
with emutils;
with emsolver;

----------------------------------------------------------------
with gametypes;


procedure sokerban is

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



use text_io;
use pngloader;
use matutils;

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


	package wtex is new gtex; --white lettering

	timeout : float := 10.0; --Seconds to Wait for interactive AutoSolve


	package fmath is new
			Ada.Numerics.generic_elementary_functions( float );
	use fmath;



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






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;






--used for debugging:
function dumpGLerrorQueue(id: string) return integer is
	use gl.binding;
	errno: interfaces.c.unsigned;
	isAnError: boolean;
	ercount: integer := 0;
begin
	isAnError:=false;
	loop
		errno:=glGetError;
		exit when errno=gl_no_error;
		ercount:=ercount+1;
		isAnError:=true;
		put("GLerror=");
		put(interfaces.c.unsigned'image(errno));
		new_line;
	end loop;
	if isAnError then
		put_line("...@ id="&id);
	end if;
	return ercount;
end dumpGLerrorQueue;
--
-- 16#0#   =    0 = no_error
-- 16#500# = 1280 = invalid_enum
-- 16#501# = 1281 = invalid_value
-- 16#502# = 1282 = invalid_operation ?reusing uniformID?
-- 16#503# = 1283 = stack_overflow
-- 16#504# = 1284 = stack_underflow
-- 16#505# = 1285 = out_of_memory
--










procedure InitGLFW( 
	wid, hit : out 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 );


	wid:=800;
	hit:=800;

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

	wid:=awwid;
	hit:=awhit;

	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;









procedure first_prep is -- main program setup
      FileId : text_io.File_Type;
		xfmax : integer;
		linestr: string(1..9);
		last,last2: natural;
		xtimeout: float;
		nerr: integer := 0;
begin


	snd4ada.initSnds;

	goal := snd4ada.initSnd(
		Interfaces.C.Strings.New_String("data/andresCantor.wav"));
	
	kick := snd4ada.initSnd(
		Interfaces.C.Strings.New_String("data/kik.wav"));
	

	if goal<0 or kick<0 then
		put_line("snd4ada.initSnd ERROR");
		raise program_error;
	end if;


	playSecs := float(glfwGetTime);


	for i in 1..maxfmax loop
		mylev(i):=1;
	end loop;

	fnum:=1;
	flev:=1;

	if ada.directories.Exists(savename) then -- takes precedence over defaults
		put_line("Resume file found");
		text_io.open(fileId, in_file, savename);

		--10jul19 addendum:
		linestr:=(others=>' ');
		text_io.get_line(fileId,linestr,last);
		ada.float_text_io.get(linestr(1..last), xtimeout, last2);
		if xtimeout>5.0 and xtimeout<100.0 then
			timeout:=xtimeout;
		end if;


		-- consistency check
		linestr := (others=>' ');
		text_io.get_line(fileId,linestr,last);
		ada.integer_text_io.get(linestr(1..last), xfmax, last2); --57

		if xfmax=fmax then
			--myint_io.get(fileId,fnum); -- this overrides default
			linestr := (others=>' ');
			text_io.get_line(fileId,linestr,last);
			ada.integer_text_io.get(linestr(1..last), fnum, last2);

--put_line(linestr);
--put("fmax="&integer'image(fmax)); --57
--put("  xfmax="&integer'image(xfmax)); --57
--put("  fnum="&integer'image(fnum)); --77

			myassert( fnum>=1 );  myassert( fnum<=fmax );

			--skip blank line
			text_io.get_line(fileId,linestr,last);

			-- if all the above checks pass, 
			-- we can define the mylev array:
			for i in 1..fmax loop
				--myint_io.get(fileId, mylev(i));
				linestr := (others=>' ');
				text_io.get_line(fileId,linestr,last);
				ada.integer_text_io.get(linestr(1..last), mylev(i), last2);
				myassert( mylev(i) <= mxlev(i), 666);
			end loop;

			flev := mylev(fnum);
			myassert( flev>=1, 667 );  myassert( flev<=mxlev(fnum), 668 );

--put("  flev="&integer'image(flev)); -- 1
--put("  mxlev="&integer'image( mxlev(fnum) )); -- 1
--new_line;


		else
			put_line("Old resume file has different # files...ignoring");
		end if;

		text_io.close(fileId);
	else
		put_line("No resume file found");
	end if;








	InitGlfw(wwid,whit,fwid,fhit,"World Cup Sokerban");

	wtex.inittext2d("data/notow.png",integer(Wwid),integer(Whit));--white
	put_line( "Window: wid-X-hit :" 
		& interfaces.c.int'image(Wwid)&" X "
		& interfaces.c.int'image(Whit) );


	glViewport(0,0,Fwid,Fhit);

	put_line( "Drawable: Fwid-X-Fhit : "
		&interfaces.c.int'image(Fwid)&" X "
		& interfaces.c.int'image(Fhit) );



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

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


	glgenbuffers(1, vertbuff'address);
	glgenbuffers(1, rgbbuff'address);
	glgenbuffers(1, uvbuff'address);
	glgenbuffers(1, elembuff'address);



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


	glEnable(GL_MULTISAMPLE);
	glHint(GL_LINE_SMOOTH_HINT, GL_NICEST);
	glHint(GL_POLYGON_SMOOTH_HINT, GL_NICEST);

	glClearColor(0.5,0.5,0.5,1.0);

end first_prep;





procedure restoreSetPoint is
	row,col : integer;
begin
	for r in 1..maxrow loop
	for c in 1..maxcol loop
		barptr(r,c):=-1;
		barl(r,c):=false;
	end loop;
	end loop;

	for i in 1..nbarrels loop
		row:=barrowset(i);
		col:=barcolset(i);
		barrow(i):=row;
		barcol(i):=col;
		barl(row,col):=true;
		barptr(row,col):=i;
	end loop;
	pr := prset;
	pc := pcset;
	oldpr := pr;
	oldpc := pc;
end restoreSetPoint;

procedure setpoint is
begin
	for i in 1..nbarrels loop
		barrowset(i):=barrow(i);
		barcolset(i):=barcol(i);
	end loop;
	prset:=pr;
	pcset:=pc;
	pointset:=true;
	put_line("SetPoint Saved!");
end setpoint;

procedure save( nstep : integer ) is
	row,col : integer;
begin
	myassert( nstep<maxmoves );
	for i in 1..nbarrels loop
		row:=barrow(i);
		col:=barcol(i);
		barrowsave(i,nstep):=row;
		barcolsave(i,nstep):=col;
		myassert( barl(row,col)=true, 9414 );
		myassert( barptr(row,col)=i, 9415 );
	end loop;
	prsave(nstep):=pr;
	pcsave(nstep):=pc;
end save;

procedure restore( nstep : integer ) is
	row,col : integer;
begin
if nstep>=1 then
	for r in 1..maxrow loop
	for c in 1..maxcol loop
		barptr(r,c):=-1;
		barl(r,c):=false;
	end loop;
	end loop;

	for i in 1..nbarrels loop
		row:=barrowsave(i,nstep);
		col:=barcolsave(i,nstep);
		barrow(i):=row;
		barcol(i):=col;
		barl(row,col):=true;
		barptr(row,col):=i;
	end loop;
	pr := prsave(nstep);
	pc := pcsave(nstep);
	oldpr := pr;
	oldpc := pc;
end if;
end restore;




-- Warning:  this logic might not yet be fully generalized...
--
--           On the other hand, Ada length function omits
--           confusing control characters at EOL, so we 
--           don't need to distinguish DOS from Unix files.
--

function ignore_this_line( line : string; len:integer ) return boolean is
	token: character;
	nb: integer := 0;

	-- I believe both methods work, 
	-- so this boolean can be set either way!
	test: constant boolean := true;

begin

	if len<2 then return true; end if;

	myassert( len>0, 0);
	myassert( line'first=1, 8);
	myassert( line'last>=len, 9);

	if line( line'first )=':' and line( line'first+1 )=':' then 
		return true; 
	end if;

if test then -- simplest strategy:

	for i in 1..len loop
	  	if( line(i) = '#' ) then --only blanks preceded this token 
	  		return false;         --thus, assume valid line
			
		elsif( line(i) /= ' ' ) then --nonblank precedes first "#"
			return true;              --so assume invalid line

		end if;
	end loop;

	return true; --only blanks this line, so skip it

else -- alternative strategy:

	nb:=0;
	for i in 1..len loop
	token:=line(i);
	if 
		token='@' or token='#' or token='$' or
		token='*' or token='.' or token='+' or token=' '

	then             -- valid puzzle character
		if token/=' ' then
			nb:=nb+1;
		end if;

	elsif i<len then -- invalid...part of commentary
		return true;

	end if;

	end loop;

	if nb>0 then
		return false; -- no invalid tokens in this line...
	else
		return true; -- all blanks so ignore this
	end if;


end if;


end ignore_this_line;


-- this version seems close to c++ ftn, yet does NOT work:
function test_blank( line : string; len:integer ) return boolean is
	p: natural;
begin

	if( len < 1 ) then return true; end if;

	if line( line'first )=':' and line( line'first+1 )=':' then 
		return true; 
	end if;

	p:=ada.strings.fixed.index(line,"#");
	if p>len or p<1 then return true; end if;

	-- ensure only blanks precede "#"
	for i in 1..p loop
		if line(i) /= ' ' then
			return true;
		end if;
	end loop;

	if p<len then 
		return false;
	else
		return true;
	end if;

end test_blank;


procedure readPuzzle is
  gfil : file_type;
  l1,l2: natural := 1;
  rcd1, rcd2: string(1..maxcol); --50
  lvl0 : integer := flev-1;
  lv : integer := 0;
  nrcpt : integer := 0;
  row : integer;
begin


	myassert( flev >= 1, 1001 );
	myassert( flev <= mxlev(fnum), 1002 );

	for b in 1..mxbarrels loop
		barrow(b):=-1;
		barcol(b):=-1;
	end loop;

	for r in 1..maxrow loop
	for c in 1..maxcol loop
		wall(r,c):=false;
		barl(r,c):=false;
		rcpt(r,c):=false;
		barptr(r,c):= -1;
	end loop;
	end loop;
	nbarrels:=0;
	nrcpt:=0;


if normalMode then
   text_io.open( 
		file=> gfil, 
		name=> to_string( gamefiles(fnum) ), 
		mode=>text_io.in_file);
else
   text_io.open( 
		file=> gfil, 
		name=> to_string(infilname),
		mode=>text_io.in_file);
end if;

--put_line("flev="&integer'image(flev));

	while( lv < lvl0 ) loop

		 rcd2:=(others=>' ');
     text_io.get_line(gfil, rcd2, l2); 

		--get 1st nonblank into rcd2
     while( ignore_this_line(rcd2,l2) ) loop
	    rcd1:=rcd2;  l1:=l2;  
		 rcd2:=(others=>' ');
       text_io.get_line(gfil, rcd2, l2); 
     end loop;
	  -- rcd2 is 1st nonblank

	--go to end of data block:
	  while( not ignore_this_line(rcd2,l2) ) loop
	  	 rcd1:=rcd2; l1:=l2;
		 rcd2:=(others=>' ');
       text_io.get_line(gfil, rcd2, l2);
	 end loop;
	 lv := lv+1; -- 1-based block count

	end loop;


	 rcd2:=(others=>' ');
    text_io.get_line(gfil, rcd2, l2); 

	--get 1st nonblank into rcd2
    while( ignore_this_line(rcd2,l2) ) loop 
	    rcd1:=rcd2;  l1:=l2;
		 rcd2:=(others=>' ');
       text_io.get_line(gfil, rcd2, l2); 
    end loop;
	-- rcd2 is 1st nonblank


-- we should now be in the right place with rcd2 holding 1st pattern

		if 
			--rcd(l2) /= ' ' and
			rcd2(l2) /= '#' and
			rcd2(l2) /= '$' and
			rcd2(l2) /= '.' and
			rcd2(l2) /= '+' and
			rcd2(l2) /= '*' and
			rcd2(l2) /= '@' 
		then
			l2:=l2-1;
		end if;
		--elliminate cr,lf 11jan16

--put_line(" 1st line: |"&rcd2(1..l2)&"| len="&natural'image(l2));

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

		if( l1>ncols ) then ncols:=l1; end if;
		for col in 1..l1 loop
			case rcd1(col) is
			when '#' =>  --wall
				wall(row,col):=true;

			when ' ' => --space
				wall(row,col):=false;
				null;

			when '.' =>  --goal
				rcpt(row,col):=true;
				nrcpt:=nrcpt+1;
				recrow(nrcpt):=row;
				reccol(nrcpt):=col;

			when '$' =>  --box
				barl(row,col):=true;
				nbarrels:=nbarrels+1;
				barrow(nbarrels):=row;
				barcol(nbarrels):=col;
				barptr(row,col):=nbarrels;

			when '@' =>  --pusher
				pr:=row;
				pc:=col;
				oldpr:=pr; oldpc:=pc;

			when '+' =>  -- goal + pusher
				rcpt(row,col):=true;
				nrcpt:=nrcpt+1;
				recrow(nrcpt):=row;
				reccol(nrcpt):=col;
				pr:=row;
				pc:=col;
				oldpr:=pr; oldpc:=pc;

			when '*' =>  -- both goal and barrel
				rcpt(row,col):=true;
				nrcpt:=nrcpt+1;
				recrow(nrcpt):=row;
				reccol(nrcpt):=col;
				barl(row,col):=true;
				nbarrels:=nbarrels+1;
				barrow(nbarrels):=row;
				barcol(nbarrels):=col;
				barptr(row,col):=nbarrels;

			when others => -- treat as space
				wall(row,col):=false;
				null;

			end case;

		end loop; --col

		exit when end_of_file(gfil); -- 26feb15 critical addendum
		 rcd2:=(others=>' ');
		text_io.get_line(gfil, rcd2, l2); --l2 includes control char...

		exit when ignore_this_line(rcd2,l2);
		--exit when test_blank(rcd2,l2);

		if 
			--rcd(l2) /= ' ' and
			rcd2(l2) /= '#' and
			rcd2(l2) /= '$' and
			rcd2(l2) /= '.' and
			rcd2(l2) /= '+' and
			rcd2(l2) /= '*' and
			rcd2(l2) /= '@' 
		then
			l2:=l2-1;
		end if;
		--elliminate cr,lf 11jan16

--put_line("next line: |"&rcd2(1..l2)&"| len="&natural'image(l2));

	end loop;

--put_line("=================EOF==============");

   text_io.close(gfil);

	--step:=1;
	--save(step); now done inside restart


	myassert( nbarrels = nrcpt, 1005 );
	myassert( nbarrels <= mxbarrels, 1006 );
	myassert( nrows <= maxrow, 1007 );
	myassert( ncols < maxcol, 1008 ); -- need 1 extra char for EOL

	-- set the centroid adjustment for short, wide puzzles
	ddzz:=0.0;
	ddxx:=0.0;
	if ncols > nrows then
		ddzz := 0.5*float(ncols-nrows);
	elsif nrows > ncols then
		ddxx := 0.5*float(nrows-ncols);
	end if;

--------------addendum to highlight feasible box moves----------------
declare
subtype ushort is emutils.ushort;
ii: ushort;
begin

	emutils.nrows:=ushort(nrows);
	emutils.ncols:=ushort(ncols);

	--setup to use of Hungarian costs.
	emutils.off:=(others=>0);
	emutils.ovf:=(others=>0);
	emutils.ff:=(others=>0);
	emutils.vf:=(others=>0);

	-- warning: dpbox assumes reversed game and checks puller-
	-- feasibility, so we must set ovf=1 ONLY where ff=2
	for r in  1..nrows loop
	for c in  1..ncols loop
		ii:=emutils.indx(ushort(r),ushort(c));
		if wall(r,c) then 
			emutils.ff(ii):=1;
			emutils.off(ii):=1;
		elsif barl(r,c) then 
			emutils.vf(ii):=1;
			emutils.off(ii):=2; --off: swap roles of goals/boxes
		elsif rcpt(r,c) then 
			emutils.ff(ii):=2;
			emutils.ovf(ii):=1; --ovf: swap roles of goals/boxes
		end if;
	end loop;
	end loop;

	emutils.dppuller; --generate pvalid
	emutils.dpbox; --(ovf,off)-->remdead-->bvalid

	emhungarian.inithun(
		emutils.vf,emutils.ff,
		emutils.bvalid,ushort(nrows),ushort(ncols));

end; --declare
--------------addendum to highlight feasible box moves----------------



end readPuzzle;




---------- global time related params: -----------------------------

	btndlay: constant float := 0.25; --mouseBtnclick

	secPerRoll : constant float := 0.25;
	keydlay: constant float := secPerRoll; --keybd

	oldTimeMs, --mousebtn
	oldTimeKb --keybd
		: float := 0.0;
	xold,yold : interfaces.c.double := 0.0;
	dragging, userexit: boolean := false;

	timeofroll, timeofmove : float := 0.0;

	rollDir : integer := 0;
	stillRolling : boolean := false;

---------- END global time related params: -----------------------------



procedure restart is
	maxrc, row,col : integer;
	xx,yy,zz, j1,j2,j3,j4,j5,j6 : float;
	tstr : string := to_string(shortname(fnum))&", #"&integer'image(flev);
	cptr : chars_ptr := 
		new_string("Sokerban:  "&tstr&"   type <h> for Help");
begin

	if normalMode then
		put_line("File: "&shortname(fnum)
			&", fnum="&integer'image(fnum)
			&", flev "&integer'image(flev));
		glfwsetwindowtitle(mainwin, cptr);
	else
		put_line("File: "&infilname
			&", flev "&integer'image(flev));
		glfwsetwindowtitle(mainwin, 
			new_string(
				to_string(infilname)&" #"&integer'image(flev)
			));
	end if;


	if pointset then
		restoresetpoint;
	else
		readpuzzle;
	end if;

	put_line("rows="&integer'image(nrows)&", cols="&integer'image(ncols));

	--pt:=0;
	if ncols>nrows then
		maxrc:=ncols;
	else
		maxrc:=nrows;
	end if;
	dx := 1.0/float(maxrc); -- based on [0..+1]
	dz := dx;
	barrad := 2.0*dx/onepi; -- 180 deg roll => dx based on [-1..+1]


	-- define the goal-nets:
	for i in 1..nbarrels loop
		row:=recrow(i);
		col:=reccol(i);
		xx:=(-0.5+ddxx+float(col))*dx; -- in [0..1]
		zz:=(-0.5+ddzz+float(row))*dz; -- in [0..1]
		yy:=-0.99;
		pictobj.setRect( barloc(i),
			+1.0-2.0*xx, yy, +1.0-2.0*zz,
			0.8*dx, 0.001, 0.8*dz,
			j1,j2,j3,j4,j5,j6);

	end loop;

	for r in 1..nrows loop
	for c in 1..ncols loop
		xx:=(-0.5+ddxx+float(c))*dx; -- in [0..1]
		zz:=(-0.5+ddzz+float(r))*dz; -- in [0..1]
		yy:=-0.95;
		pictobj.setRect( celloc(r,c),
			+1.0-2.0*xx, yy, +1.0-2.0*zz,
			0.9*dx, 0.001, 0.9*dz,
			j1,j2,j3,j4,j5,j6);
	end loop;
	end loop;


	-- define the sokerban-balls:
	for i in 1..nbarrels loop
		row:=barrow(i);
		col:=barcol(i);
		xx:=(-0.5+ddxx+float(col))*dx;
		zz:=(-0.5+ddzz+float(row))*dz;
		yy:= -1.0+barrad;

		-- reducing draw-radius of barrel is
		-- physically imperfect but still believable...
		-- and smaller size looks more like soccerball:
		cyl2obj.setCyl2( barrel(i),
			+1.0-2.0*xx, yy, +1.0-2.0*zz, barrad*smallball );

	end loop;


	playedonce:=false;
	winner:=false;
	npush:=0;

	step:=1;
	save(step); --fix 31mar21: do this here, not in readpuz

end restart;


procedure test4win is
begin
  winner:=true;
  for r in 1..nrows loop
  for c in 1..ncols loop
  if rcpt(r,c) and not barl(r,c)  then 
  		winner:=false; 
  end if;
  end loop;
  end loop;

  if winner then
    put_line(" Winner ! " );
	 put_line("  #steps="&integer'image(step));
	 put_line(" #pushes="&integer'image(npush));
  end if;
  
end test4win;


function testup return boolean is
begin

	if pr=1 then return false; -- edge blocks pusher

	elsif pr=2 then

		if barl(pr-1,pc) or wall(pr-1,pc) then
			return false; -- barrel or wall blocks pusher
		else
			return true;
		end if;

	else -- pr>2

		if wall(pr-1,pc) then return false; -- wall blocks pusher

		elsif barl(pr-1,pc) and wall(pr-2,pc) then return false; --wall blocks barrel

		elsif barl(pr-1,pc) and barl(pr-2,pc) then return false; --2 barrels block

		else return true;

		end if;

	end if;

end testup;

function testdown return boolean is
begin

	if pr=nrows then return false; -- edge blocks pusher

	elsif pr=nrows-1 then

		if barl(pr+1,pc) or wall(pr+1,pc) then
			return false; -- barrel or wall blocks pusher
		else
			return true;
		end if;

	else -- pr<=nrows-2

		if wall(pr+1,pc) then return false; -- wall blocks pusher

		elsif barl(pr+1,pc) and wall(pr+2,pc) then return false; --wall blocks barrel

		elsif barl(pr+1,pc) and barl(pr+2,pc) then return false; --2 barrels block

		else return true;

		end if;

	end if;

end testdown;













function testleft return boolean is
begin

	if pc=1 then return false; -- edge blocks pusher

	elsif pc=2 then

		if barl(pr,pc-1) or wall(pr,pc-1) then
			return false; -- barrel or wall blocks pusher
		else
			return true;
		end if;

	else -- pc>2

		if wall(pr,pc-1) then return false; -- wall blocks pusher

		elsif barl(pr,pc-1) and wall(pr,pc-2) then return false; --wall blocks barrel

		elsif barl(pr,pc-1) and barl(pr,pc-2) then return false; --2 barrels block

		else return true;

		end if;

	end if;

end testleft;

function testright return boolean is
begin

	if pc=ncols then return false; -- edge blocks pusher

	elsif pc=ncols-1 then

		if barl(pr,pc+1) or wall(pr,pc+1) then
			return false; -- barrel or wall blocks pusher
		else
			return true;
		end if;

	else -- pc<=ncols-2

		if wall(pr,pc+1) then return false; -- wall blocks pusher

		elsif barl(pr,pc+1) and wall(pr,pc+2) then return false; --wall blocks barrel

		elsif barl(pr,pc+1) and barl(pr,pc+2) then return false; --2 barrels block

		else return true;

		end if;

	end if;

end testright;



kickdir : character := 'u';

procedure moveup is
	b: integer;
begin
if testup then
	kickdir:='u';
	oldpr:=pr;
	oldpc:=pc;
	if pr>1 and barl(pr-1,pc) then --ball is being pushed
		snd4ada.playSnd(kick); --kick
	--delay 0.05;
	timeofmove:=float(glfwGetTime);
		npush:=npush+1;
		barl(pr-1,pc):=false;
		barl(pr-2,pc):=true;
		oldbr:=pr-1;  oldbc:=pc;
		newbr:=pr-2;  newbc:=pc;
		b:=barptr(pr-1,pc); -- index of barrel @ old pos
		barrow(b):=newbr;
		barcol(b):=newbc;
		barptr(pr-2,pc):=b; -- [same] index of barrel, but @ new pos
		barptr(pr-1,pc):=-1;
		rolling(b):=true;
		timeofroll:=timeofmove;
	end if;
	pr:=pr-1;
	step:=step+1;
	save(step);
	--pt := pt+1;
	test4win;
end if;
end moveup;

procedure movedown is
	b: integer;
begin
if testdown then
	kickdir:='d';
	oldpr:=pr;
	oldpc:=pc;
	if pr<nrows and barl(pr+1,pc) then --ball is being pushed
		snd4ada.playSnd(kick); --kick
	--delay 0.05;
	timeofmove:=float(glfwGetTime);
		npush:=npush+1;
		barl(pr+1,pc):=false;
		barl(pr+2,pc):=true;
		oldbr:=pr+1;  oldbc:=pc;
		newbr:=pr+2;  newbc:=pc;
		b:=barptr(pr+1,pc); -- index of barrel @ old pos
		barrow(b):=newbr;
		barcol(b):=newbc;
		barptr(pr+2,pc):=b; -- [same] index of barrel, but @ new pos
		barptr(pr+1,pc):=-1;
		rolling(b):=true;
		timeofroll:=timeofmove;
	end if;
	pr:=pr+1;
	step:=step+1;
	save(step);
	--pt := pt+1;
	test4win;
end if;
end movedown;

procedure moveleft is
	b: integer;
begin
if testleft then
	kickdir:='r';
	oldpr:=pr;
	oldpc:=pc;
	if pc>1 and barl(pr,pc-1) then --ball is being pushed
		snd4ada.playSnd(kick); --kick
	--delay 0.05;
	timeofmove:=float(glfwGetTime);
		npush:=npush+1;
		barl(pr,pc-1):=false;
		barl(pr,pc-2):=true;
		oldbr:=pr;  oldbc:=pc-1;
		newbr:=pr;  newbc:=pc-2;
		b:=barptr(pr,pc-1); -- index of barrel @ old pos
		barrow(b):=newbr;
		barcol(b):=newbc;
		barptr(pr,pc-2):=b; -- [same] index of barrel, but @ new pos
		barptr(pr,pc-1):=-1;
		rolling(b):=true;
		timeofroll:=timeofmove;
	end if;
	pc:=pc-1;
	step:=step+1;
	save(step);
	--pt := pt+1;
	test4win;
end if;
end moveleft;

procedure moveright is
	b: integer;
begin
if testright then
	kickdir:='l';
	oldpr:=pr;
	oldpc:=pc;
	if pc<ncols and barl(pr,pc+1) then --ball is being pushed
		snd4ada.playSnd(kick); --kick
	--delay 0.05;
	timeofmove:=float(glfwGetTime);
		npush:=npush+1;
		barl(pr,pc+1):=false;
		barl(pr,pc+2):=true;
		oldbr:=pr;  oldbc:=pc+1;
		newbr:=pr;  newbc:=pc+2;
		b:=barptr(pr,pc+1); -- index of barrel @ old pos
		barrow(b):=newbr;
		barcol(b):=newbc;
		barptr(pr,pc+2):=b; -- [same] index of barrel, but @ new pos
		barptr(pr,pc+1):=-1;
		rolling(b):=true;
		timeofroll:=timeofmove;
	end if;
	pc:=pc+1;
	step:=step+1;
	save(step);
	--pt := pt+1;
	test4win;
end if;
end moveright;

procedure undo is
	r,c : integer;
	xx,yy,zz : float;
begin

if step>=2 then --step is big enough

	step:=step-1;
	restore(step);
	--pt:=pt-1;

	for i in 1..nbarrels loop
		r:=barrow(i);
		c:=barcol(i);
		xx := (-0.5+ddxx+float(c))*dx;
		zz := (-0.5+ddzz+float(r))*dz;
		yy := -1.0 + barrad;

		-- reducing draw-radius of barrel is
		-- physically imperfect but still believable...
		-- and smaller size looks more like soccerball:
		cyl2obj.setCyl2(barrel(i), 1.0-2.0*xx, yy, 1.0-2.0*zz, barrad*smallball );
	end loop;

end if; --step is big enough

end undo;

function signum( x : integer ) return integer is
begin
	if x>0 then
		return +1;
	elsif x<0 then
		return -1;
	else
		return 0;
	end if;
end signum;


-- update kicker smoothly
procedure updateGameState( currentTime : float ) is
	dt : constant float := currentTime - timeOfRoll;
	tt : constant float := dt / secPerRoll;
begin
	stillRolling := (tt<1.0);

	if ( abs(newbr-oldbr)+abs(newbc-oldbc) = 1 ) and stillRolling then
		if newbr=oldbr then
			rolldir:=3*signum(newbc-oldbc); -- rotates about Z-axis (vert)
		elsif newbc=oldbc then
			rolldir:=1*signum(newbr-oldbr); -- rotates about X-axis (hori)
		end if;
		upc := float(oldpc) + tt*float(pc-oldpc);
		upr := float(oldpr) + tt*float(pr-oldpr);
	end if;

	if not stillRolling then
		upc:=float(pc);
		upr:=float(pr);
	end if;

end updateGameState;



--po: pictobj.pictangle;
procedure drawShortCube( po: pictobj.pictangle;
xc,yc,zc, xr,yr,zr : float;
vertbuff, uvbuff, elembuff : GLuint )
is
	j1,j2,j3,j4,j5,j6 : float;
begin
	pictobj.setrect( po, xc,yc,zc, xr,yr,zr, j1,j2,j3,j4,j5,j6);
	pictobj.draw( po, vertbuff, uvbuff, elembuff );
end drawShortCube;


procedure drawMan( po: pictobj.pictangle;
xc,yc,zc, xr,yr,zr : float;
vertbuff, uvbuff, elembuff : GLuint )
is
	j1,j2,j3,j4,j5,j6 : float;
begin
	pictobj.settilt( po, xc,yc,zc, xr,yr,zr, j1,j2,j3,j4,j5,j6);
	pictobj.draw( po, vertbuff, uvbuff, elembuff );
end drawMan;




BarrelModelMatrix, ViewMatrix, ProjectionMatrix,
	mvp, bmvp, bmm : mat44 := identity;

procedure updateMVP( wid, hit : glint ) is
	xlook, ylook, zlook, xlk,ylk,zlk, xrt,yrt,zrt, xup,yup,zup : float;
	xme,yme,zme : float;
begin
	eyepos(2) := float(zoomwheel.zdist);
	xme:=eyepos(1);
	yme:=eyepos(2);
	zme:=eyepos(3);

	-- look direction:
	xlook := fmath.cos(vertang)*fmath.sin(choriang);
	ylook := fmath.sin(vertang);
	zlook := fmath.cos(vertang)*fmath.cos(choriang);

	xlk := xme+xlook;
	ylk := yme+ylook;
	zlk := zme+zlook;

	-- Right unit-Direction
	xrt:= sin(choriang-halfpi);
	yrt:= 0.0;
	zrt:= cos(choriang-halfpi);

	-- calculate UP unit-Direction
	cross( xrt,yrt,zrt, xlook,ylook,zlook, xup,yup,zup );

	perspective(ProjectionMatrix, 45.0, float(wid)/float(hit),  0.1, 100.0);

	lookat(ViewMatrix, xme,yme,zme, xlk,ylk,zlk, xup,yup,zup );

	-- we assume modelmatrix=id:
	MVP:=ViewMatrix;
	matXmat(MVP,ProjectionMatrix);

	--MVP := ProjectionMatrix * ViewMatrix * ModelMatrix;

end updateMVP;








procedure release_textures is -- prepare to close down
begin

	glext.binding.glDeleteBuffers(1, vertbuff'address);
	glext.binding.glDeleteBuffers(1, rgbbuff'address);
	glext.binding.glDeleteBuffers(1, uvbuff'address);
	glext.binding.glDeleteBuffers(1, elembuff'address);

	gldeletetextures(1, room_texid'address);
	gldeletetextures(1, floor_texid'address);
	gldeletetextures(1, wall_texid'address);

	--gldeletetextures(1, pushNo_texid'address);
	--gldeletetextures(1, pushSo_texid'address);
	gldeletetextures(1, mpushEa_texid'address);
	gldeletetextures(1, mpushWe_texid'address);
	gldeletetextures(1, mpush_texid'address);

	gldeletetextures(1, fpushEa_texid'address);
	gldeletetextures(1, fpushWe_texid'address);
	gldeletetextures(1, fpush_texid'address);

	glext.binding.glDeleteProgram( nontexshadid );
	glext.binding.glDeleteProgram( pgmtexshadid );

	glext.binding.glDeleteVertexArrays(1, vertexarrayid'address);

end release_textures;


procedure setup_textures is  -- prepare dungeon textures
begin 

	nontexshadid := loadshaders("./data/nontex.vs", "./data/nontex.fs");
	ntmatrixid := glgetuniformlocation(nontexshadid, pmvp);

	pgmtexshadid := loadshaders("./data/texobj.vs", "./data/texobj.fs");
	matrixid := glgetuniformlocation(pgmtexshadid, pmvp);
	uniftex  := glgetuniformlocation(pgmtexshadid, pmyts);

	barloc_texid:= loadPng(mirror,"data/socnet01.png");

	wall_texid:= loadPng(mirror,"data/granite.png");
	floor_texid:= loadPng(mirror,"data/grasss.png");
	room_texid:= loadPng(mirror,"data/soc2.png");

	--male soccer avatar:
	mpush_texid:= loadPng(repeat,"data/man5.png");
	mpushEa_texid:= loadPng(mirror,"data/man5r.png");
	mpushWe_texid:= loadPng(mirror,"data/man5l.png");

	--female soccer avatar:
	fpush_texid:= loadPng(repeat,"data/woman5.png");
	fpushEa_texid:= loadPng(mirror,"data/woman5r.png");
	fpushWe_texid:= loadPng(mirror,"data/woman5l.png");

	gray_texid:= loadPng(mirror,"data/gray.png");


end setup_textures;













myr, myc : integer;



function numeral( c : character ) return boolean is
begin
	if c='0' or c='1' or c='2' or c='3' or c='4'
	or c='5' or c='6' or c='7' or c='8' or c='9'
	then
		return true;
	else
		return false;
	end if;
end numeral;

function underscore( c: character ) return boolean is
begin
	if c='_' then
		return true;
	else
		return false;
	end if;
end underscore;

function period( c: character ) return boolean is
begin
	if c='.' then
		return true;
	else
		return false;
	end if;
end period;




use ada.directories;

	nc1,nc2, ncc : integer := 0;
	numstr : string(1..5) := (others=>' ');

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

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







procedure sortGames is
	ubstr: unbounded_string;
	nsav: integer;
	use ada.characters.handling;
begin
	-- it seems file search does not return a sorted list...
	-- this proc sorts shortName(),gamefiles(),mxlev() arrays

	-- begin bubble sort on 1st char
	for i in reverse 1..fmax loop
		for j in reverse 1..i-1 loop
			--case-aware UBstring sort:
			--if shortName(i) < shortName(j) then

			--case-unaware first letter sort
			--if to_lower(element(shortName(i),1)) 
			--	< to_lower(element(shortName(j),1)) then

			--case-unaware string sort:
			if   to_lower(to_string(shortName(i))) 
				< to_lower(to_string(shortName(j))) then

				--swap i/j
				ubstr := shortName(i);
				shortName(i) := shortName(j);
				shortName(j) := ubstr;

				ubstr := gamefiles(i);
				gamefiles(i) := gamefiles(j);
				gamefiles(j) := ubstr;

				nsav := mxlev(i);
				mxlev(i):=mxlev(j);
				mxlev(j):=nsav;

			end if;
		end loop; --j
	end loop; --i
	-- end sort

end sortGames;


procedure loadGames is
begin
------- begin dynamic read of ./games/ directory -------------------------

	-- find *.sok files under ./games/
	--put_line("Here are the sok files found under ./games/ :");
	totgame:=0;
	start_search( search, "./games/", "*.sok" );
	while more_entries( search ) loop
		get_next_entry( search, directory_entry );
		totgame:=totgame+1;

		myassert( totgame <= maxfmax ,1350 );
		gamefiles(totgame)  := 
			to_unbounded_string( full_name( directory_entry ) );
		shortName(totgame):= 
			to_unbounded_string( simple_name(directory_entry) );

		declare
			fnam : string := simple_name(directory_entry);
			frst : natural := fnam'first;
			last : natural := fnam'last;
			k : natural;
		begin -- search fnam [*_####.sok] for ####
			nc1:=frst;
			while not underscore(fnam(nc1)) loop nc1:=nc1+1; end loop;
			nc1:=nc1+1;
			nc2:=nc1;
			while not period(fnam(nc2)) loop nc2:=nc2+1; end loop;
			nc2:=nc2-1;

			numstr := (others=>' ');
			k:=1;
			for i in nc1..nc2 loop
				numstr(k):=fnam(i);
				k:=k+1;
			end loop;
			ncc:=k-1;
		end; --declare

		nlevels:=integer'value( numstr(1..ncc) );
		--put_line( shortName(totgame) &" #: "& integer'image(nlevels) );
		mxlev(totgame):=nlevels;

	end loop; -- while more_entries
	fmax:=totgame;
	--put_line("...for a total of totgame="&integer'image(totgame));
	--new_line;


------- end dynamic read of ./games/ directory -------------------------

	sortGames;

	--put_line("Here are the sorted sok files found under ./games/ :");
	--for i in 1..fmax loop
	--	put(shortName(i)&", #lev=");
	--	put( integer'image( mxlev(i) ) );
	--	new_line;
	--end loop;
	--new_line;

end loadGames;






procedure checkForUserFile is
begin

-- NOTE:  the following is intended to override settings
--        to allow users to try their own puzzle file:

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

       infilname := to_unbounded_string(fstr);
       myint_io.get(tstr,maxlevel,lst);
       myint_io.get(nstr,flev,lst);
		 normalMode:=false;

     end; --declare
  
  	elsif Ada.Command_Line.Argument_Count = 1 then
		declare
       lst: natural;
       fstr : string := Ada.Command_Line.Argument(1);--File
		begin
		 myfloat_io.get(fstr,timeout,lst);
		end; --declare

   end if;

end checkForUserFile;







-- addendum 2jan21:
procedure xdump2arr(
	puzz: out emutils.puzarray
	) is
	use text_io;
	goal,pusher,fence,box: boolean;
	ch: character;
begin
	puzz:=( others=> (others=> 'x') );
	for row in 1..nrows loop
	for col in 1..ncols loop
		goal := rcpt(row,col);
		fence := wall(row,col);
		pusher:=(pr=row) and (pc=col);
		--box:=ruby(row,col);
		box:=barl(row,col);

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








-- this proc saves current game state to a file
-- ...to solve call "ibox x.sok 1 1"
procedure dump is
	goal,fence,box,pusher: boolean;
	fout : text_io.file_type;
begin

	text_io.create(fout, out_file, "x.sok");
	for row in 1..nrows loop
	for col in 1..ncols loop
		goal := rcpt(row,col);
		fence := wall(row,col);
		pusher:=(pr=row) and (pc=col);
		box:=barl(row,col);

		if goal and box then
			put(fout,'*');
		elsif goal and pusher then
			put(fout,'+');
		elsif pusher then
			put(fout,'@');
		elsif box then
			put(fout,'$');
		elsif goal then
			put(fout,'.');
		elsif fence then
			put(fout,'#');
		else -- space
			put(fout,' ');
		end if;

	end loop;
	new_line(fout);
	end loop; --row
	new_line(fout);
	text_io.close(fout);

end dump;


procedure Draw; -- forward declaration




	mask: array(1..maxrow,1..maxcol) of boolean:=(others=>(others=>false));

	hilite: boolean := false;
	pickdwell: constant float := 0.5;
	mptime: float := float( glfwGetTime );

procedure getMouseClick( 
	mainWin: access GLFWwindow; 
	wid,hit: interfaces.c.int ) is separate;


procedure getMouseInputs( 
	mainWin: access GLFWwindow; 
	--Wwid,Whit: gldouble;
	change: out boolean ) is separate;

procedure getKeyInputs( 
	mainWin : access GLFWwindow; 
	change: out boolean ) is separate;








procedure Draw is
	len: integer :=length(solutionPath);
	lstr: string := integer'image(len);
	nowtime: float;
begin --draw

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

	glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);



	if help  then

		szfont := 20;
		left := 0.05;

		wtex.print2d("WorldCupSokerban Help",    left, 0.95, szfont);

		wtex.print2d("<esc> to quit",            left, 0.90, szfont);


		wtex.print2d("<=> timed Solve1: puller", left, 0.85, szfont);
		wtex.print2d("<.> timed Solve2: hbox4", left, 0.80, szfont);
		wtex.print2d("<,> timed Solve3: ibox", left, 0.75, szfont);


		wtex.print2d("<u> to undo",          left, 0.70, szfont);
		wtex.print2d("<r> reset@setpt;  <1> restart puzzle",    left, 0.65, szfont);

		wtex.print2d("<n> next level",           left, 0.60, szfont);
		wtex.print2d("<p> prev level",           left, 0.55, szfont);

		wtex.print2d("<L-shift> prev file",      left, 0.50, szfont);
		wtex.print2d("<R-shift> next file",      left, 0.45, szfont);

		wtex.print2d("<z> define setpoint",    left, 0.40, szfont);


		wtex.print2d("<c> view closer",          left, 0.35, szfont);
		wtex.print2d("<f> view further",         left, 0.30, szfont);
		wtex.print2d("<o> view defaults",        left, 0.25, szfont);

		wtex.print2d("</> view tilt upward",     left, 0.20, szfont);
		wtex.print2d("<\> view tilt downward",   left, 0.15, szfont);

		wtex.print2d("<b> male avatar",     left, 0.10, szfont);
		wtex.print2d("<g> female avatar",   left, 0.05, szfont);


	elsif details then

		-- intent is to show technical details here so that I can track
		-- down the antialiasing problem under OS-X in case a MacBundle
		-- is used rather than the command line version.

		wtex.print2d(" Ndim: " &
			interfaces.c.int'image(Nwid)&" X "
			& interfaces.c.int'image(Nhit), 0.02, 0.8, 25 );

		wtex.print2d(" hdpi: " &
			interfaces.c.int'image(Fwid)&" X "
			& interfaces.c.int'image(Fhit), 0.02, 0.7, 25 );



--------- begin OGL queries -----------------------------------------

		glGetIntegerv(GL_CONTEXT_PROFILE_MASK, profile'address);
		if( profile = GL_CONTEXT_CORE_PROFILE_BIT ) then
			wtex.print2d("ogl-query:  Core Profile", 0.02, 0.6, 20);
		end if;

		-- Note that OSX currently requires the forward_compatible flag!
		glGetIntegerv(GL_CONTEXT_FLAGS, flags'address);
		if( flags = GL_CONTEXT_FLAG_FORWARD_COMPATIBLE_BIT ) then
			wtex.print2d("ogl-query:  Forward-Compat bit is set", 0.02, 0.5, 20);
		end if;

		glgetintegerv(gl_major_version, major'address);
		glgetintegerv(gl_minor_version, minor'address);
		wtex.print2d( "ogl-query: OGL-major: "&glint'image(major), 0.02, 0.4, 20);
		wtex.print2d( "ogl-query: OGL-minor: "&glint'image(minor), 0.02, 0.3, 20);

		glgetintegerv(gl_max_texture_units, mtu'address);
		wtex.print2d( "ogl-query: maxTexUnits: "&glint'image(mtu), 0.02, 0.2, 20);

		glgetintegerv(gl_max_texture_image_units, mtu'address);
		wtex.print2d( "ogl-query: maxTexImgUnits: "&glint'image(mtu), 0.02, 0.13, 20);

		glgetintegerv(gl_max_combined_texture_image_units, mtu'address);
		wtex.print2d( "ogl-query: maxCombTexImgUnits: "&glint'image(mtu), 0.02, 0.06, 20);


--------- end OGL queries -----------------------------------------


	else -- not details & not help;  show normal screen:



		-- use this to draw ordinary textured objects:
		glUseProgram(pgmTexShadID);
		glUniformMatrix4fv(MatrixID, 1, GL_FALSE, MVP(1,1)'address);
		glUniform1i(uniftex, 0);

		glBindTexture(GL_TEXTURE_2D, room_texid);
		roomobj.Draw( rmo, vertbuff, uvbuff, elembuff );

		glBindTexture(GL_TEXTURE_2D, floor_texid);
		rectobj.Draw( myfloor, vertbuff, uvbuff, elembuff );


		--// draw receptacles
		glBindTexture(GL_TEXTURE_2D, barloc_texid);
		for j in 1..nbarrels loop
	     	pictobj.Draw( barloc(j), vertbuff,uvbuff,elembuff);
		end loop;

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

		-- 15feb21 addendum
		if hilite then
			glBindTexture(GL_TEXTURE_2D, gray_texid);
			for row in 1..nrows loop
			for col in 1..ncols loop
			if mask(row,col) then
				pictobj.draw(celloc(row,col), vertbuff, uvbuff, elembuff);
			end if;
			end loop; -- col
			end loop; -- row
		end if;

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




		--// draw walls made up of short cubes (still using pgmTexShadID)
		glBindTexture(GL_TEXTURE_2D, wall_texid);
		for row in 1..nrows loop
		for col in 1..ncols loop

			-- if wall exists here, draw short cube
			frow:=ddzz+float(row);
			fcol:=ddxx+float(col);
			if( wall(row,col) ) then
				drawShortCube( apo(row,col),
					+1.0-2.0*(-0.5+fcol)*dx, -1.0+barrad, +1.0-2.0*(-0.5+frow)*dz,
					dx, barrad, dz,
					vertbuff, uvbuff, elembuff );
			end if;

		end loop;
		end loop;



		-- draw pusher here:
		if male then
			glBindTexture(GL_TEXTURE_2D, mpush_texid); 
			if kickDir='l'  and stillRolling then
				glBindTexture(GL_TEXTURE_2D, mpushWe_texid);
			elsif kickDir='r'  and stillRolling then
				glBindTexture(GL_TEXTURE_2D, mpushEa_texid);
			end if;
		else --female
			glBindTexture(GL_TEXTURE_2D, fpush_texid); 
			if kickDir='l'  and stillRolling then
				glBindTexture(GL_TEXTURE_2D, fpushWe_texid);
			elsif kickDir='r'  and stillRolling then
				glBindTexture(GL_TEXTURE_2D, fpushEa_texid);
			end if;
		end if;

		--traditional man pusher
		--glBindTexture(GL_TEXTURE_2D, push_texid); 

		-- (upr,upc) smoothly transitions from old to new pusher pos.
		drawMan( ppo,
			+1.0-2.0*(-0.5+ddxx+upc)*dx, 
			-1.0+barrad+0.01, 
			+1.0-2.0*(-0.5+ddzz+upr)*dz,
			dx*xsmallman, 0.01*barrad, dz*zsmallman,
			vertbuff, uvbuff, elembuff ); -- dx=width, dz=height



	nowtime:=float(glfwGetTime);




		--// begin draw barrels /////////////////////////////////
		glUseProgram(nonTexShadID);  -- now use the non-textured shaders

		for ib in 1..nbarrels loop
			BMVP := MVP;

			if rolling(ib) then --only in this case do we need to update position

				barreltime := nowtime;
				tt := float( barreltime - timeofroll ) / secperroll;
				barangle := onepi*tt*rad2deg;
				--barangle := twopi*tt*rad2deg; --11jan17 more dazzle

				if( tt<1.0 ) then
					midbc := float(oldbc) + tt*float(newbc-oldbc);
					midbr := float(oldbr) + tt*float(newbr-oldbr);
					xx:=(-0.5+ddxx+midbc)*dx;
					zz:=(-0.5+ddzz+midbr)*dz;
					yy:= -1.0+barrad;
					barlv(1):=1.0-2.0*xx;
					barlv(2):=yy;
					barlv(3):=1.0-2.0*zz;

					if    (rolldir=+1) then axis:=xaxis; barangle:=-barangle;
					elsif (rolldir=-1) then axis:=xaxis;
					elsif (rolldir=-3) then axis:=zaxis; barangle:=-barangle;
					elsif (rolldir=+3) then axis:=zaxis;
					end if;

					bmm:=identity;

					-- Xlate to origin
					translate(bmm, -barlv(1), -barlv(2), -barlv(3) );

					-- rotate
					degRotate(bmm, barangle, axis(1), axis(2), axis(3) );

					-- Xlate back
					translate(bmm, barlv(1), barlv(2), barlv(3) );

					bmvp := bmm;
					matXmat( bmvp, ViewMatrix );
					matXmat( bmvp, ProjectionMatrix );

				else

					rolling(ib):=false;

					xx:=(-0.5+ddxx+float(barcol(ib)))*dx;
					zz:=(-0.5+ddzz+float(barrow(ib)))*dz;

					yy:= -1.0+barrad;
					barlv(1):=1.0-2.0*xx;
					barlv(2):=yy;
					barlv(3):=1.0-2.0*zz;

				end if; -- tt

				-- update barrel position
				cyl2obj.updcyl2(barrel(ib), barlv(1),barlv(2),barlv(3));

			end if; -- rolling

			-- we have to register bmvp for each ib AFTER it is redefined:
			gluniformmatrix4fv( ntmatrixid, 1, gl_false, BMVP(1,1)'address );

			myr:=barrow(ib);
			myc:=barcol(ib);
			onGoal := rcpt(myr,myc) and barl(myr,myc) and not rolling(ib);
			cyl2obj.draw(barrel(ib),vertbuff,rgbbuff,elembuff, onGoal); -- 2jul15

		end loop;



		--20apr17 addendum
		if waiting then
			declare --19aug19
				lstr: string := integer'image( integer(timeout) );
			begin
				wtex.print2d("please wait "&lstr&"sec", 0.10, 0.98, 20);
			end;

		elsif haveSolution>0 then
			wtex.print2d("press again to solve"&lstr, 0.10, 0.98, 20);
		end if;

		--7may20 addendum
		if pointset and ( (nowtime-sptime)<5.0 ) then
			wtex.print2d("SetPoint Saved!", 0.2, 0.5, 30);
		end if;

			


		elapsedSec := nowtime - playSecs;
		waitSec := nowtime - timeofroll;
		if( winner and (elapsedSec<5.0) ) then
			wtex.print2d("GOOOAAL !",    0.10,0.5,50);
			wtex.print2d(" steps="&integer'image(step),  0.2,0.4,40);
			wtex.print2d(" pushes="&integer'image(npush),0.2,0.3,40);
		end if;

		if winner then

			if not playedonce and (waitSec>0.4)   then
				snd4ada.playSnd(goal); -- goooal

				playedonce:=true;
				playSecs := nowtime;
			end if;

		else
			playedonce:=false;
		end if;


	end if; -- help/details/normal


end Draw;


	procedure barrfree is new unchecked_deallocation(rubyarray,rubyref);

	winredraw, mouseredraw, keyredraw: boolean;

	nerr: integer;

begin -- sokerban =========================================================

	--allocate large objects on heap:
	barrowsave := new rubyarray;
	barcolsave := new rubyarray;

	loadGames; -- sorts also


	normalMode:=true;


	first_prep; -- init graphics/sound, defines fnum, flev


	-- Here, we may begin testing for GLerrors
	nerr:=dumpGLerrorQueue("main 1"); 
	--prevents misleading messages in pngloader or loadshaders



	infilname := gamefiles(fnum);
	maxlevel := mxlev(fnum);

	zoomwheel.enable(mainWin);

-- NOTE:  the following is intended to allow
--        users to try their own puzzle file:
	checkForUserFile; --possibly resets maxlevel, flev
	if not normalMode then
		fnum:=1;
		mxlev(1):=maxlevel;
	end if; --9jul19 correction for commandline mode (single puzzle)



	restart;

	setup_textures;

	roomobj.setrect(rmo,  0.0,0.0,0.0, 1.0,1.0,1.0);
	rectobj.setrect(myfloor, 0.0,-0.999,0.0, 1.0,0.001,1.0, j1,j2,j3,j4,j5,j6);

	currentTime := float(glfwGetTime);
	updateGameState(currentTime);
	updateMVP( Wwid, Whit );

	Draw;

	glflush;
	glfwSwapBuffers( mainWin );




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

		glfwPollEvents;

		getKeyInputs(mainWin, keyredraw);
		exit when userexit;
		getMouseInputs(mainWin, mouseredraw);
		getMouseClick(mainWin,wwid,whit);
		exit when glfwWindowShouldClose(mainWin) /= 0; --14may21 addendum

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


		glfwGetWindowSize( mainWin, Nwid'access, Nhit'access );
		if( (Nwid /= wwid) or (Nhit /= whit) ) then
			winredraw:=true;
			wwid:=Nwid;  whit:=Nhit;

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

		else
			winredraw:=false;
		end if;


		if keyredraw or mouseredraw or winredraw or stillrolling then

			currentTime := float(glfwGetTime);
			updateGameState(currentTime);
			updateMVP( Wwid, Whit );

			Draw;

			glflush;
			glfwSwapBuffers( mainWin );

		end if;

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




	if normalMode then
		text_io.create(tfile, out_file, savename);

		--10jul19
		ada.float_text_io.put(tfile, timeout,0,1,0); 
		new_line(tfile);

		put_line(tfile, integer'image( fmax )); -- #gameFiles
		put_line(tfile, integer'image( fnum )); -- current file#
		new_line(tfile);

		for i in 1..fmax loop
			put_line(tfile, integer'image( mylev(i) ) );
		end loop;

		text_io.close(tfile);
	end if;

	snd4ada.termSnds;

	release_textures;

	wtex.cleanuptext;

	barrfree(barrowsave);
	barrfree(barcolsave);

	glfwdestroywindow(mainWin);
	glfwTerminate;

exception
	when others =>

		snd4ada.termSnds;
		release_textures;
		glfwdestroywindow(mainWin);
		glfwTerminate;

		raise;

end sokerban;

