
--
-- Copyright (C) 2023  <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.finalization;
with unchecked_deallocation;

with text_io;  use text_io;


package body zfishobj is
-- fish that move in Z-direction




procedure initialize( rect: in out zfish ) is
begin
	rect.vert := new varray;
	rect.txuv := new tarray;
	rect.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( rect: in out zfish ) is
begin
	vfree( rect.vert );
	tfree( rect.txuv );
	efree( rect.elem );
end finalize;





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;





-- usually, either xr or yr is near zero...
-- Z=long-direction with "nperedge" sections
procedure setrect( rect: in out zfish;
xr,yr,zr : float ) is

	e,ebase, t, tbase, k : integer := 0;

	jj, jjbase : glushort:=0;

	dj0,dj1,
	xd,yd,zd,
	fn, umax,vmax, umin,vmin : float;

	xc,yc,zc : constant float := 0.0;
	xm,xp,ym,yp,zm,zp : float;

begin

	xm  := xc-xr;
	xp  := xc+xr;
	ym  := yc-yr;
	yp  := yc+yr;
	zm  := zc-zr;
	zp  := zc+zr;
	xd := 2.0*xr;
	yd := 2.0*yr;
	zd := 2.0*zr;

	fn:=float(nperedge);


for i in 1..1 loop -- head & tail

	umin := 0.0;
	umax := 1.0;

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

	-- front Z+ ccw exterior
	rect.vert(k+ 1):=xm;  rect.vert(k+ 2):=ym;  rect.vert(k+ 3):=zp; --LL
	rect.vert(k+ 4):=xp;  rect.vert(k+ 5):=ym;  rect.vert(k+ 6):=zp; --LR
	rect.vert(k+ 7):=xp;  rect.vert(k+ 8):=yp;  rect.vert(k+ 9):=zp; --UR
	rect.vert(k+10):=xm;  rect.vert(k+11):=yp;  rect.vert(k+12):=zp; --UL
	k:=k+12;

	t := 0*8 + tbase;
	rect.txuv(t+1):=0.0;  rect.txuv(t+2):=0.0;
	rect.txuv(t+3):=1.0;  rect.txuv(t+4):=0.0;
	rect.txuv(t+5):=1.0;  rect.txuv(t+6):=1.0;
	rect.txuv(t+7):=0.0;  rect.txuv(t+8):=1.0;


	-- back Z- ccw exterior
	rect.vert(k+ 1):=xp;  rect.vert(k+ 2):=ym;  rect.vert(k+ 3):=zm; --LL
	rect.vert(k+ 4):=xm;  rect.vert(k+ 5):=ym;  rect.vert(k+ 6):=zm; --LR
	rect.vert(k+ 7):=xm;  rect.vert(k+ 8):=yp;  rect.vert(k+ 9):=zm; --UR
	rect.vert(k+10):=xp;  rect.vert(k+11):=yp;  rect.vert(k+12):=zm; --UL
	k:=k+12;

	t := 1*8 + tbase;
	rect.txuv(t+1):=0.0;  rect.txuv(t+2):=0.0;
	rect.txuv(t+3):=1.0;  rect.txuv(t+4):=0.0;
	rect.txuv(t+5):=1.0;  rect.txuv(t+6):=1.0;
	rect.txuv(t+7):=0.0;  rect.txuv(t+8):=1.0;
------------------------------------------------------------------


	-- element indices:
	for s in 0..1 loop
		jj:=glushort(s*4)+jjbase;
		e := s*6 + ebase;
		rect.elem(e+1):=jj+0;
		rect.elem(e+2):=jj+1;
		rect.elem(e+3):=jj+2;
		rect.elem(e+4):=jj+2;
		rect.elem(e+5):=jj+3;
		rect.elem(e+6):=jj+0;
	end loop;
	ebase:=ebase+12;
	jjbase:=jjbase+8;


	tbase := tbase+16;






for j in 1..nperedge loop -- "j" subdivides Z-direction only

	dj0:=float(j-1)/fn;
	dj1:=float(j)/fn;
	vmin := dj0;
	vmax := dj1;


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

	-- top Y+ ccw exterior
	rect.vert(k+ 1):=xm;  rect.vert(k+ 2):=yp;  rect.vert(k+ 3):=zm+zd*dj1; --NE
	rect.vert(k+ 4):=xp;  rect.vert(k+ 5):=yp;  rect.vert(k+ 6):=zm+zd*dj1; --NW
	rect.vert(k+ 7):=xp;  rect.vert(k+ 8):=yp;  rect.vert(k+ 9):=zm+zd*dj0; --SW
	rect.vert(k+10):=xm;  rect.vert(k+11):=yp;  rect.vert(k+12):=zm+zd*dj0; --SE
	k:=k+12;

	t := 0*8 + tbase;
	rect.txuv(t+1):=vmax;  rect.txuv(t+2):=0.0;
	rect.txuv(t+3):=vmax;  rect.txuv(t+4):=1.0;
	rect.txuv(t+5):=vmin;  rect.txuv(t+6):=1.0;
	rect.txuv(t+7):=vmin;  rect.txuv(t+8):=0.0;


	-- bottom Y- ccw exterior
	rect.vert(k+ 1):=xm;  rect.vert(k+ 2):=ym;  rect.vert(k+ 3):=zm+zd*dj0; --SE
	rect.vert(k+ 4):=xp;  rect.vert(k+ 5):=ym;  rect.vert(k+ 6):=zm+zd*dj0; --SW
	rect.vert(k+ 7):=xp;  rect.vert(k+ 8):=ym;  rect.vert(k+ 9):=zm+zd*dj1; --NW
	rect.vert(k+10):=xm;  rect.vert(k+11):=ym;  rect.vert(k+12):=zm+zd*dj1; --NE
	k:=k+12;

	t := 1*8 + tbase;
	rect.txuv(t+1):=vmin;  rect.txuv(t+2):=0.0;
	rect.txuv(t+3):=vmin;  rect.txuv(t+4):=1.0;
	rect.txuv(t+5):=vmax;  rect.txuv(t+6):=1.0;
	rect.txuv(t+7):=vmax;  rect.txuv(t+8):=0.0;

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





------------------------------------------------------------------
	-- right X- ccw exterior
	rect.vert(k+ 1):=xm;  rect.vert(k+ 2):=ym;  rect.vert(k+ 3):=zm+zd*dj0; --LL
	rect.vert(k+ 4):=xm;  rect.vert(k+ 5):=ym;  rect.vert(k+ 6):=zm+zd*dj1; --LR
	rect.vert(k+ 7):=xm;  rect.vert(k+ 8):=yp;  rect.vert(k+ 9):=zm+zd*dj1; --UR
	rect.vert(k+10):=xm;  rect.vert(k+11):=yp;  rect.vert(k+12):=zm+zd*dj0; --UL
	k:=k+12;

	t := 2*8 + tbase;
	rect.txuv(t+1):=vmin;  rect.txuv(t+2):=0.0;
	rect.txuv(t+3):=vmax;  rect.txuv(t+4):=0.0;
	rect.txuv(t+5):=vmax;  rect.txuv(t+6):=1.0;
	rect.txuv(t+7):=vmin;  rect.txuv(t+8):=1.0;


	-- left X+ ccw exterior
	rect.vert(k+ 1):=xp;  rect.vert(k+ 2):=ym;  rect.vert(k+ 3):=zm+zd*dj1; --LL
	rect.vert(k+ 4):=xp;  rect.vert(k+ 5):=ym;  rect.vert(k+ 6):=zm+zd*dj0; --LR
	rect.vert(k+ 7):=xp;  rect.vert(k+ 8):=yp;  rect.vert(k+ 9):=zm+zd*dj0; --UR
	rect.vert(k+10):=xp;  rect.vert(k+11):=yp;  rect.vert(k+12):=zm+zd*dj1; --UL
	k:=k+12;

	t := 3*8 + tbase;
	rect.txuv(t+1):=vmax;  rect.txuv(t+2):=0.0;
	rect.txuv(t+3):=vmin;  rect.txuv(t+4):=0.0;
	rect.txuv(t+5):=vmin;  rect.txuv(t+6):=1.0;
	rect.txuv(t+7):=vmax;  rect.txuv(t+8):=1.0;



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

	tbase:=tbase+32;


	-- element indices (5=nFaces-1):
	for s in 2..5 loop
		jj:=glushort(s*4)+jjbase;
		e := s*6 + ebase;
		rect.elem(e+1):=jj+0;
		rect.elem(e+2):=jj+1;
		rect.elem(e+3):=jj+2;
		rect.elem(e+4):=jj+2;
		rect.elem(e+5):=jj+3;
		rect.elem(e+6):=jj+0;
	end loop;
	ebase:=ebase+24;
	jjbase:=jjbase+16;


end loop;--for j


end loop;--for i

rect.nu:=tbase;
rect.ne:=ebase;
rect.nv:=k;

--put_line( integer'image(nperedge) );--7
--put_line( integer'image(tbase) );--240
--put_line( integer'image(ebase) );--180
--put_line( integer'image(k) );    --360
--put_line( integer'image(nuv) );  -- 336
--put_line( integer'image(nelm) ); -- 252
--put_line( integer'image(nvert) ); --504


myassert( rect.nu <= nuv );
myassert( rect.ne <= nelm );
myassert( rect.nv <= nvert );


end setrect;



--
-- 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 convenient
--
use gl;
use glext;
use glext.binding;
use gl.binding;

procedure draw( rect: zfish; vertbuff, uvbuff, elembuff : gluint ) is
begin

	-- 0th attribute:  vertices
	glBindBuffer(gl_array_buffer, vertbuff);
	glBufferData(gl_array_buffer, glsizeiptr(4*rect.nv), rect.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*rect.nu), rect.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*rect.ne), rect.elem(1)'address, gl_static_draw);

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

	--glDrawElements( gl_triangles, glint(nvert), gl_unsigned_short, system.null_address );
	-- fix 25jan17
	glDrawElements( gl_triangles, glint(rect.nv), gl_unsigned_short, system.null_address );

	glDisableVertexAttribArray(0);
	glDisableVertexAttribArray(1);

end draw;






end zfishobj;

