nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

opengl.geometry: Pre-initialise texture uniforms.

Browse Source
This commit is contained in:
Rod Kay
2023-05-04 21:32:03 +10:00
parent eb17c310f1
commit 4ca946531a
14 changed files with 48 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb
View File

@@ -274,7 +274,7 @@ is
overriding overriding
procedure enable_Texture (Self : in Item) procedure enable_Texture (Self : in out Item)
is is
use GL, use GL,
GL.Binding, GL.Binding,

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads
View File

@@ -42,6 +42,6 @@ private
type Item is new Geometry.item with null record; type Item is new Geometry.item with null record;
overriding overriding
procedure enable_Texture (Self : in Item); procedure enable_Texture (Self : in out Item);
end openGL.Geometry.lit_colored_textured; end openGL.Geometry.lit_colored_textured;

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb
View File

@@ -288,7 +288,7 @@ is
overriding overriding
procedure enable_Texture (Self : in Item) procedure enable_Texture (Self : in out Item)
is is
use GL, use GL,
GL.Binding, GL.Binding,

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads
View File

@@ -53,6 +53,6 @@ private
type Item is new Geometry.item with null record; type Item is new Geometry.item with null record;
overriding overriding
procedure enable_Texture (Self : in Item); procedure enable_Texture (Self : in out Item);
end openGL.Geometry.lit_colored_textured_skinned; end openGL.Geometry.lit_colored_textured_skinned;

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb
View File

@@ -246,7 +246,7 @@ is
overriding overriding
procedure enable_Texture (Self : in Item) procedure enable_Texture (Self : in out Item)
is is
use GL, use GL,
GL.Binding, GL.Binding,

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads
View File

@@ -43,6 +43,6 @@ private
type Item is new Geometry.item with null record; type Item is new Geometry.item with null record;
overriding overriding
procedure enable_Texture (Self : in Item); procedure enable_Texture (Self : in out Item);
end openGL.Geometry.lit_textured; end openGL.Geometry.lit_textured;

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb
View File

@@ -262,7 +262,7 @@ is
overriding overriding
procedure enable_Texture (Self : in Item) procedure enable_Texture (Self : in out Item)
is is
use GL, use GL,
GL.Binding, GL.Binding,

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads
View File

@@ -52,6 +52,6 @@ private
type Item is new Geometry.item with null record; type Item is new Geometry.item with null record;
overriding overriding
procedure enable_Texture (Self : in Item); procedure enable_Texture (Self : in out Item);
end openGL.Geometry.lit_textured_skinned; end openGL.Geometry.lit_textured_skinned;

8
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb
View File

@@ -3,21 +3,18 @@ with
openGL.Shader, openGL.Shader,
openGL.Program.lit, openGL.Program.lit,
openGL.Attribute, openGL.Attribute,
openGL.Variable.uniform,
openGL.Texture, openGL.Texture,
openGL.Palette, openGL.Palette,
openGL.Tasks, openGL.Tasks,
openGL.Errors, openGL.Errors,
GL.Binding,
GL.lean, GL.lean,
GL.Pointers, GL.Pointers,
ada.Strings.fixed,
Interfaces.C.Strings, Interfaces.C.Strings,
System.storage_Elements; System.storage_Elements;
with ada.Text_IO; use ada.Text_IO; -- with ada.Text_IO; use ada.Text_IO;
package body openGL.Geometry.lit_textured_x2 package body openGL.Geometry.lit_textured_x2
@@ -175,6 +172,7 @@ is
end if; end if;
Self.Program_is (the_Program.all'Access); Self.Program_is (the_Program.all'Access);
return Self; return Self;
end new_Geometry; end new_Geometry;
@@ -324,7 +322,7 @@ is
overriding overriding
procedure enable_Texture (Self : in Item) procedure enable_Texture (Self : in out Item)
is is
-- check_is_OK : constant Boolean := openGL.Tasks.Check -- check_is_OK : constant Boolean := openGL.Tasks.Check
-- with unreferenced; -- with unreferenced;

2
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads
View File

@@ -61,6 +61,6 @@ private
overriding overriding
procedure enable_Texture (Self : in Item); procedure enable_Texture (Self : in out Item);
end openGL.Geometry.lit_textured_x2; end openGL.Geometry.lit_textured_x2;

2
3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb
View File

@@ -164,7 +164,7 @@ is
overriding overriding
procedure enable_Texture (Self : in Item) procedure enable_Texture (Self : in out Item)
is is
use GL, use GL,
GL.Binding, GL.Binding,

2
3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads
View File

@@ -40,6 +40,6 @@ private
type Item is new Geometry.item with null record; type Item is new Geometry.item with null record;
overriding overriding
procedure enable_Texture (Self : in Item); procedure enable_Texture (Self : in out Item);
end openGL.Geometry.textured; end openGL.Geometry.textured;

42
3-mid/opengl/source/lean/geometry/opengl-geometry.adb
View File

@@ -157,7 +157,7 @@ is
procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object) procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object)
is is
begin begin
in_Set.Textures (Which) := (0.0, Now); in_Set.Textures (Which) := (0.0, Now, 0);
in_Set.is_Transparent := in_Set.is_Transparent in_Set.is_Transparent := in_Set.is_Transparent
or Now .is_Transparent; or Now .is_Transparent;
@@ -566,27 +566,42 @@ is
-- Textures -- Textures
-- --
procedure enable (the_Textures : in texture_Set; procedure enable (the_Textures : in out texture_Set;
Program : in openGL.Program.view) Program : in openGL.Program.view)
is is
use GL, use GL,
GL.Binding, GL.Binding,
openGL.Texture; openGL.Texture;
-- check_is_OK : constant Boolean := openGL.Tasks.Check
-- with unreferenced;
begin begin
Tasks.check; Tasks.check;
if not the_Textures.Initialised
then
for i in 1 .. the_Textures.Count
loop
declare
use GL.lean,
GL.Pointers,
ada.Strings,
ada.Strings.fixed,
Interfaces;
uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Natural'Image (i - 1), Left) & "]");
uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access);
Id : constant texture_Id := texture_Id (i);
begin
the_Textures.Textures (Id).uniform_Location := glGetUniformLocation (Program.gl_Program, +uniform_Name_ptr);
end;
end loop;
the_Textures.Initialised := True;
end if;
for i in 1 .. the_Textures.Count for i in 1 .. the_Textures.Count
loop loop
declare declare
use GL.lean, use GL.lean;
GL.Pointers,
ada.Strings,
ada.Strings.fixed,
Interfaces;
use type GL.GLint; use type GL.GLint;
@@ -625,14 +640,11 @@ is
GL_TEXTURE30, GL_TEXTURE30,
GL_TEXTURE31); GL_TEXTURE31);
uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Natural'Image (i - 1), Left) & "]");
uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access);
loc : constant GL.GLint := glGetUniformLocation (Program.gl_Program, +uniform_Name_ptr);
Id : constant texture_Id := texture_Id (i); Id : constant texture_Id := texture_Id (i);
begin begin
-- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image);
glUniform1i (loc, glUniform1i (the_Textures.Textures (Id).uniform_Location, -- loc,
GLint (i) - 1); GLint (i) - 1);
glActiveTexture (all_texture_Units (Id)); glActiveTexture (all_texture_Units (Id));

12
3-mid/opengl/source/lean/geometry/opengl-geometry.ads
View File

@@ -62,8 +62,9 @@ is
type fadeable_Texture is type fadeable_Texture is
record record
Fade : fade_Level := 0.0; Fade : fade_Level := 0.0;
Object : openGL.Texture.Object := openGL.Texture.null_Object; Object : openGL.Texture.Object := openGL.Texture.null_Object;
uniform_Location : GL.GLint := 0;
end record; end record;
type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
@@ -73,10 +74,11 @@ is
Textures : fadeable_Textures; Textures : fadeable_Textures;
Count : Natural := 0; Count : Natural := 0;
is_Transparent : Boolean := False; -- Any of the textures contains lucid colors. is_Transparent : Boolean := False; -- Any of the textures contains lucid colors.
Initialised : Boolean := False;
end record; end record;
procedure enable (the_Textures : in texture_Set; procedure enable (the_Textures : in out texture_Set;
Program : in openGL.Program.view); Program : in openGL.Program.view);
procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object); procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object; function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object;
@@ -110,7 +112,7 @@ is
-- --
procedure render (Self : in out Item'Class); procedure render (Self : in out Item'Class);
procedure enable_Texture (Self : in Item) is null; procedure enable_Texture (Self : in out Item) is null;
----------- -----------