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


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

with interfaces.c;
use type interfaces.c.unsigned_short;

with ada.numerics.generic_elementary_functions;

with ada.finalization;
with unchecked_deallocation;

with text_io;  use text_io;



package body circtexsurfobj is -- for sandy round island


procedure initialize( ct: in out circtex ) is
begin
	ct.vert := new varray;
	ct.txuv := new tarray;
	ct.elem := new earray;
end initialize;

procedure vfree is new unchecked_deallocation(varray,vap);
procedure tfree is new unchecked_deallocation(tarray,tap);
procedure efree is new unchecked_deallocation(earray,eap);

procedure finalize( ct: in out circtex ) is
begin
	vfree( ct.vert );
	tfree( ct.txuv );
	efree( ct.elem );
	--text_io.put_line("circtexsurf Free");
end finalize;







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


  onepi : constant float     := 3.14159_26535_89793;
  twopi : constant float     := onepi*2.0;









procedure assert( 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 assert;







procedure setround( ct: in out circtex;  xc,zc, outer, hmax, wlev, r1, r2 : float ) is

	da : constant float := twopi/float(nang);
	dr : constant float := outer/float(nrad);

	ang0, ang1, ri, ro, x00,z00, x01,z01, x10,z10, x11,z11 : float;
	fi,fj : float;
	ejj : Interfaces.C.unsigned_short;

begin

	ct.nv:=0;
	ct.tk:=0;
	ct.ej:=0;
	ejj:=0;

	for i in 0..nang-1 loop
	fi := float(i);
	for j in 0..nrad-1 loop
	fj := float(j);

		ang0 := fi*da;
		ang1 := ang0+da;

		ri := fj*dr;
		ro := ri + dr;

		x00 := xc+ri*sin(ang0);
		z00 := zc+ri*cos(ang0);
		x01 := xc+ri*sin(ang1);
		z01 := zc+ri*cos(ang1);
		x10 := xc+ro*sin(ang0);
		z10 := zc+ro*cos(ang0);
		x11 := xc+ro*sin(ang1);
		z11 := zc+ro*cos(ang1);

		if ro < outer then

			ct.vert(ct.nv+1):=x00;
			ct.vert(ct.nv+2):=sandht(x00,z00,hmax,wlev,r1,r2);
			ct.vert(ct.nv+3):=z00;
			ct.nv:=ct.nv+3;

			ct.vert(ct.nv+1):=x10;
			ct.vert(ct.nv+2):=sandht(x10,z10,hmax,wlev,r1,r2);
			ct.vert(ct.nv+3):=z10;
			ct.nv:=ct.nv+3;

			ct.vert(ct.nv+1):=x11;
			ct.vert(ct.nv+2):=sandht(x11,z11,hmax,wlev,r1,r2);
			ct.vert(ct.nv+3):=z11;
			ct.nv:=ct.nv+3;

			ct.vert(ct.nv+1):=x01;
			ct.vert(ct.nv+2):=sandht(x01,z01,hmax,wlev,r1,r2);
			ct.vert(ct.nv+3):=z01;
			ct.nv:=ct.nv+3;


		--// here is my stroke of genius...the texture coordinates
		--// should simply match the rectangular coordinates (x,z)
		--// in order to obtain a realistic appearance of sand:
			ct.txuv(ct.tk+1):=x00;  ct.txuv(ct.tk+2):=z00;
			ct.txuv(ct.tk+3):=x10;  ct.txuv(ct.tk+4):=z10;
			ct.txuv(ct.tk+5):=x11;  ct.txuv(ct.tk+6):=z11;
			ct.txuv(ct.tk+7):=x01;  ct.txuv(ct.tk+8):=z01;
			ct.tk := ct.tk+8;


			ct.elem(ct.ej+1):=ejj+0;
			ct.elem(ct.ej+2):=ejj+1;
			ct.elem(ct.ej+3):=ejj+2;
			ct.elem(ct.ej+4):=ejj+2;
			ct.elem(ct.ej+5):=ejj+3;
			ct.elem(ct.ej+6):=ejj+0;
			ct.ej := ct.ej+6;
			ejj := ejj+4;

		end if; -- within max radius (ro<outer)

	end loop; --j
	end loop; --i

	assert( ct.nv<=nvert );
	assert( ct.tk<=nuv );
	assert( ct.ej<=nelm );


end setround;


-- note:  the shaders for these objects must have two 
-- input "layouts", as well as whatever uniforms are needed:
--
-- layout(location=0) in vec3 vertPosName
-- layout(location=1) in vec3 vertRgbName
--
-- ...where their actual names can be whatever is coct.nvenient
--

use gl;
use glext;
use glext.binding;
use gl.binding;
procedure draw( ct: circtex;  vertbuff, uvbuff, elembuff : gluint ) is
begin

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

	-- 1st attribute:  texture UV
	glBindBuffer(gl_array_buffer, uvbuff);
	glBufferData(gl_array_buffer, glsizeiptr(4*ct.tk), ct.txuv(1)'address, gl_static_draw);
	glEnableVertexAttribArray(1);
	glVertexAttribPointer(1,2,gl_float,gl_false,0, system.null_address);

	-- element indices:
	glBindBuffer(gl_element_array_buffer, elembuff);
	glBufferData(gl_element_array_buffer, glsizeiptr(2*ct.ej), ct.elem(1)'address, gl_static_draw);

	glEnable(gl_blend);
	glBlendFunc(gl_src_alpha, gl_one_minus_src_alpha);

	glDrawElements( gl_triangles, glint(ct.nv), gl_unsigned_short, system.null_address );

	glDisableVertexAttribArray(0);
	glDisableVertexAttribArray(1);

end draw;



end circtexsurfobj;

