diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb index 80a2a1e..9478a55 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb @@ -274,7 +274,7 @@ is overriding - procedure enable_Texture (Self : in Item) + procedure enable_Texture (Self : in out Item) is use GL, GL.Binding, diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads index ae76077..39435cf 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads @@ -42,6 +42,6 @@ private type Item is new Geometry.item with null record; overriding - procedure enable_Texture (Self : in Item); + procedure enable_Texture (Self : in out Item); end openGL.Geometry.lit_colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb index d0175f1..8ac6238 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb @@ -288,7 +288,7 @@ is overriding - procedure enable_Texture (Self : in Item) + procedure enable_Texture (Self : in out Item) is use GL, GL.Binding, diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads index 9db8e42..4625941 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads @@ -53,6 +53,6 @@ private type Item is new Geometry.item with null record; overriding - procedure enable_Texture (Self : in Item); + procedure enable_Texture (Self : in out Item); end openGL.Geometry.lit_colored_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb index 3600a58..7e7345d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb @@ -246,7 +246,7 @@ is overriding - procedure enable_Texture (Self : in Item) + procedure enable_Texture (Self : in out Item) is use GL, GL.Binding, diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads index 8024d09..36e9066 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads @@ -43,6 +43,6 @@ private type Item is new Geometry.item with null record; overriding - procedure enable_Texture (Self : in Item); + procedure enable_Texture (Self : in out Item); end openGL.Geometry.lit_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb index e3d23a6..6c6146d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb @@ -262,7 +262,7 @@ is overriding - procedure enable_Texture (Self : in Item) + procedure enable_Texture (Self : in out Item) is use GL, GL.Binding, diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads index 2803711..3b3bee0 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads @@ -52,6 +52,6 @@ private type Item is new Geometry.item with null record; overriding - procedure enable_Texture (Self : in Item); + procedure enable_Texture (Self : in out Item); end openGL.Geometry.lit_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb index e12f3b4..3b7f486 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb @@ -3,21 +3,18 @@ with openGL.Shader, openGL.Program.lit, openGL.Attribute, - openGL.Variable.uniform, openGL.Texture, openGL.Palette, openGL.Tasks, openGL.Errors, - GL.Binding, GL.lean, GL.Pointers, - ada.Strings.fixed, Interfaces.C.Strings, 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 @@ -175,6 +172,7 @@ is end if; Self.Program_is (the_Program.all'Access); + return Self; end new_Geometry; @@ -324,7 +322,7 @@ is overriding - procedure enable_Texture (Self : in Item) + procedure enable_Texture (Self : in out Item) is -- check_is_OK : constant Boolean := openGL.Tasks.Check -- with unreferenced; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads index c15adc0..4b3e8a8 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads @@ -61,6 +61,6 @@ private overriding - procedure enable_Texture (Self : in Item); + procedure enable_Texture (Self : in out Item); end openGL.Geometry.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb index e956276..bee7c49 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb @@ -164,7 +164,7 @@ is overriding - procedure enable_Texture (Self : in Item) + procedure enable_Texture (Self : in out Item) is use GL, GL.Binding, diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads index 1324bc4..cbca762 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads @@ -40,6 +40,6 @@ private type Item is new Geometry.item with null record; overriding - procedure enable_Texture (Self : in Item); + procedure enable_Texture (Self : in out Item); end openGL.Geometry.textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index 723fb76..51daa67 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -157,7 +157,7 @@ is procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object) is begin - in_Set.Textures (Which) := (0.0, Now); + in_Set.Textures (Which) := (0.0, Now, 0); in_Set.is_Transparent := in_Set.is_Transparent or Now .is_Transparent; @@ -566,27 +566,42 @@ is -- Textures -- - procedure enable (the_Textures : in texture_Set; - Program : in openGL.Program.view) + procedure enable (the_Textures : in out texture_Set; + Program : in openGL.Program.view) is use GL, GL.Binding, openGL.Texture; - -- check_is_OK : constant Boolean := openGL.Tasks.Check - -- with unreferenced; - begin 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 loop declare - use GL.lean, - GL.Pointers, - ada.Strings, - ada.Strings.fixed, - Interfaces; + use GL.lean; use type GL.GLint; @@ -625,14 +640,11 @@ is GL_TEXTURE30, 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); begin -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); - glUniform1i (loc, + glUniform1i (the_Textures.Textures (Id).uniform_Location, -- loc, GLint (i) - 1); glActiveTexture (all_texture_Units (Id)); diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index fb8b1a1..c508fa6 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -62,8 +62,9 @@ is type fadeable_Texture is record - Fade : fade_Level := 0.0; - Object : openGL.Texture.Object := openGL.Texture.null_Object; + Fade : fade_Level := 0.0; + Object : openGL.Texture.Object := openGL.Texture.null_Object; + uniform_Location : GL.GLint := 0; end record; type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; @@ -73,10 +74,11 @@ is Textures : fadeable_Textures; Count : Natural := 0; is_Transparent : Boolean := False; -- Any of the textures contains lucid colors. + Initialised : Boolean := False; end record; - procedure enable (the_Textures : in texture_Set; - Program : in openGL.Program.view); + procedure enable (the_Textures : in out texture_Set; + Program : in openGL.Program.view); 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; @@ -110,7 +112,7 @@ is -- procedure render (Self : in out Item'Class); - procedure enable_Texture (Self : in Item) is null; + procedure enable_Texture (Self : in out Item) is null; -----------