From 2ac6d57a5336d6b15a375d562bc85ef526fbd64e Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Fri, 5 May 2023 03:13:07 +1000 Subject: [PATCH] opengl.geometry: Add/use texturing support. --- .../opengl-geometry-lit_textured_x2.adb | 96 ++------ .../opengl-geometry-lit_textured_x2.ads | 10 +- .../geometry/opengl-geometry-texturing.adb | 172 +++++++++++++ .../geometry/opengl-geometry-texturing.ads | 45 ++++ .../source/lean/geometry/opengl-geometry.adb | 232 +----------------- .../source/lean/geometry/opengl-geometry.ads | 46 +--- .../opengl-model-hexagon-lit_textured_x2.ads | 10 +- 7 files changed, 254 insertions(+), 357 deletions(-) create mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb create mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads 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 3b7f486..80c3c0f 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 @@ -267,14 +267,14 @@ is - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level) + procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level) is begin Self.Textures.Textures (Which).Fade := Now; end Fade_is; - function Fade (Self : in Item; Which : texture_ID) return fade_Level + function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level is begin return Self.Textures.Textures (Which).Fade; @@ -284,8 +284,9 @@ is - procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) + procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) is + use openGL.Geometry.texturing; begin Texture_is (in_Set => Self.Textures, Which => Which, @@ -294,29 +295,31 @@ is - function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object + function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object is begin - return Texture (in_Set => Self.Textures, - Which => Which); + return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, + Which => Which); end Texture; overriding - procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is + use openGL.Geometry.texturing; begin Texture_is (in_Set => Self.Textures, Now => Now); end Texture_is; + overriding - function Texture (Self : in Item) return openGL.Texture.Object + function Texture (Self : in Item) return openGL.Texture.Object is begin - return Texture (in_Set => Self.Textures, - Which => 1); + return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, + Which => 1); end Texture; @@ -324,80 +327,9 @@ is overriding procedure enable_Texture (Self : in out Item) is - -- check_is_OK : constant Boolean := openGL.Tasks.Check - -- with unreferenced; - + use openGL.Geometry.texturing; begin enable (Self.Textures, Self.Program); - - -- Tasks.check; - - -- for i in 1 .. Self.Textures.Count - -- loop - -- declare - -- use ada.Strings, - -- ada.Strings.fixed; - -- - -- use type GL.GLint; - -- - -- -- "bone_Matrices[" & Trim (Integer'Image (i - 1), Left) & "]"); - -- - -- type texture_Units is array (texture_Id) of GLenum; - -- all_texture_Units : constant texture_Units := (GL_TEXTURE0, - -- GL_TEXTURE1, - -- GL_TEXTURE2, - -- GL_TEXTURE3, - -- GL_TEXTURE4, - -- GL_TEXTURE5, - -- GL_TEXTURE6, - -- GL_TEXTURE7, - -- GL_TEXTURE8, - -- GL_TEXTURE9, - -- GL_TEXTURE10, - -- GL_TEXTURE11, - -- GL_TEXTURE12, - -- GL_TEXTURE13, - -- GL_TEXTURE14, - -- GL_TEXTURE15, - -- GL_TEXTURE16, - -- GL_TEXTURE17, - -- GL_TEXTURE18, - -- GL_TEXTURE19, - -- GL_TEXTURE20, - -- GL_TEXTURE21, - -- GL_TEXTURE22, - -- GL_TEXTURE23, - -- GL_TEXTURE24, - -- GL_TEXTURE25, - -- GL_TEXTURE26, - -- GL_TEXTURE27, - -- GL_TEXTURE28, - -- GL_TEXTURE29, - -- GL_TEXTURE30, - -- GL_TEXTURE31); - -- - -- uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Integer'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 (Self.Program.gl_Program, +uniform_Name_ptr); - -- begin - -- -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); - -- - -- glUniform1i (loc, - -- GLint (i) - 1); - -- - -- glActiveTexture (all_texture_Units (texture_Id (i))); - -- glBindTexture (GL_TEXTURE_2D, - -- Self.Textures.Textures (texture_Id (i)).Object.Name); - -- end; - -- - -- - -- declare - -- the_texture_count_Uniform : constant openGL.Variable.uniform.int := Self.Program.uniform_Variable ("texture_Count"); - -- begin - -- the_texture_count_Uniform.Value_is (Self.Textures.Count); - -- end; - -- end loop; - end enable_Texture; 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 4b3e8a8..6763006 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 @@ -1,3 +1,7 @@ +with + openGL.Geometry.texturing; + + package openGL.Geometry.lit_textured_x2 -- -- Supports per-vertex site texture and lighting. @@ -37,8 +41,8 @@ is procedure Indices_are (Self : in out Item; Now : in Indices; for_Facia : in Positive); - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level); - function Fade (Self : in Item; Which : texture_ID) return fade_Level; + procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level); + function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level; procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object); @@ -56,7 +60,7 @@ private type Item is new Geometry.item with record - Textures : texture_Set; + Textures : Geometry.texturing.texture_Set; end record; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb new file mode 100644 index 0000000..365a1db --- /dev/null +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -0,0 +1,172 @@ +with + openGL.Tasks, + + GL.Binding, + GL.lean, + + ada.Strings.fixed; + + +package body openGL.Geometry.texturing +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, + textures_Uniform => <>, + fade_Uniform => <>); + + in_Set.is_Transparent := in_Set.is_Transparent + or Now .is_Transparent; + + if Natural (Which) > in_Set.Count + then + in_Set.Count := Natural (Which); + end if; + end Texture_is; + + + function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object + is + begin + return in_Set.Textures (Which).Object; + end Texture; + + + + + function Texture (in_Set : in texture_Set) return openGL.Texture.Object + is + begin + return in_Set.Textures (1).Object; + end Texture; + + + procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object) + is + begin + in_Set.Textures (1).Object := Now; + in_Set.is_Transparent := in_Set.is_Transparent + or Now .is_Transparent; + + if in_Set.Count = 0 + then + in_Set.Count := 1; + end if; + end Texture_is; + + + + procedure enable (the_Textures : in out texture_Set; + Program : in openGL.Program.view) + is + use GL, + GL.Binding, + openGL.Texture; + + begin + Tasks.check; + + if not the_Textures.initialised + then + for i in 1 .. the_Textures.Count + loop + declare + use ada.Strings, + ada.Strings.fixed; + + Id : constant texture_Id := texture_Id (i); + begin + declare + uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]"; + begin + the_Textures.Textures (Id).textures_Uniform := Program.uniform_Variable (Named => uniform_Name); + end; + + declare + uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; + begin + the_Textures.Textures (Id).fade_Uniform := Program.uniform_Variable (Named => uniform_Name); + end; + end; + end loop; + + the_Textures.Initialised := True; + end if; + + + for i in 1 .. the_Textures.Count + loop + declare + use GL.lean; + + use type GL.GLint; + + type texture_Units is array (texture_Id) of GLenum; + + all_texture_Units : constant texture_Units := (GL_TEXTURE0, + GL_TEXTURE1, + GL_TEXTURE2, + GL_TEXTURE3, + GL_TEXTURE4, + GL_TEXTURE5, + GL_TEXTURE6, + GL_TEXTURE7, + GL_TEXTURE8, + GL_TEXTURE9, + GL_TEXTURE10, + GL_TEXTURE11, + GL_TEXTURE12, + GL_TEXTURE13, + GL_TEXTURE14, + GL_TEXTURE15, + GL_TEXTURE16, + GL_TEXTURE17, + GL_TEXTURE18, + GL_TEXTURE19, + GL_TEXTURE20, + GL_TEXTURE21, + GL_TEXTURE22, + GL_TEXTURE23, + GL_TEXTURE24, + GL_TEXTURE25, + GL_TEXTURE26, + GL_TEXTURE27, + GL_TEXTURE28, + GL_TEXTURE29, + GL_TEXTURE30, + GL_TEXTURE31); + + Id : constant texture_Id := texture_Id (i); + begin + glUniform1i (the_Textures.Textures (Id).textures_Uniform.gl_Variable, + GLint (i) - 1); + glActiveTexture (all_texture_Units (Id)); + glBindTexture (GL_TEXTURE_2D, + the_Textures.Textures (Id).Object.Name); + end; + + + declare + use ada.Strings, + ada.Strings.fixed; + + uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; + Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name); + begin + Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); + end; + end loop; + + + declare + the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count"); + begin + the_texture_count_Uniform.Value_is (the_Textures.Count); + end; + end enable; + + +end openGL.Geometry.texturing; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads new file mode 100644 index 0000000..20d420a --- /dev/null +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads @@ -0,0 +1,45 @@ +with + openGL.Program, + openGL.Texture, + openGL.Variable.uniform; + + +package openGL.Geometry.texturing +-- +-- Facilitates texturing of geometries. +-- +is + + type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible). + + type fadeable_Texture is + record + Fade : fade_Level := 0.0; + Object : openGL.Texture.Object := openGL.Texture.null_Object; + textures_Uniform : openGL.Variable.uniform.sampler2D; + fade_Uniform : openGL.Variable.uniform.float; + end record; + + type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; + + type texture_Set is + record + 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 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; + + procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object); + function Texture (in_Set : in texture_Set) return openGL.Texture.Object; + + +end openGL.Geometry.texturing; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index 3a137ff..44cb41d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -1,12 +1,6 @@ with openGL.Primitive.indexed, openGL.Primitive.long_indexed, - openGL.Tasks, - - GL.Binding, - GL.lean, - - ada.Strings.fixed, ada.unchecked_Deallocation; @@ -50,6 +44,8 @@ is end free_Primitives; + + -------------- -- Attributes -- @@ -98,34 +94,6 @@ is - - - - - - -- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in openGL.Texture.Object) - -- is - -- begin - -- Self.Textures.Textures (Which) := (0.0, Now); - -- Self.is_Transparent := Self.is_Transparent - -- or Now .is_Transparent; - -- - -- if Natural (Which) > Self.Textures.Count - -- then - -- Self.Textures.Count := Natural (Which); - -- end if; - -- end Texture_is; - -- - -- - -- function Texture (Self : in Item'Class; Which : texture_ID) return openGL.Texture.Object - -- is - -- begin - -- return Self.Textures.Textures (Which).Object; - -- end Texture; - - - - function Texture (Self : in Item) return openGL.Texture.Object is begin @@ -134,71 +102,6 @@ is end Texture; - -- procedure Texture_is (Self : in out Item'Class; Now : in openGL.Texture.Object) - -- is - -- begin - -- Self.Textures.Textures (1).Object := Now; - -- Self.is_Transparent := Self.is_Transparent - -- or Now .is_Transparent; - -- - -- if Self.Textures.Count = 0 - -- then - -- Self.Textures.Count := 1; - -- end if; - -- end Texture_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, - textures_Uniform => <>, - fade_Uniform => <>); - - in_Set.is_Transparent := in_Set.is_Transparent - or Now .is_Transparent; - - if Natural (Which) > in_Set.Count - then - in_Set.Count := Natural (Which); - end if; - end Texture_is; - - - function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object - is - begin - return in_Set.Textures (Which).Object; - end Texture; - - - - - function Texture (in_Set : in texture_Set) return openGL.Texture.Object - is - begin - return in_Set.Textures (1).Object; - end Texture; - - - procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object) - is - begin - in_Set.Textures (1).Object := Now; - in_Set.is_Transparent := in_Set.is_Transparent - or Now .is_Transparent; - - if in_Set.Count = 0 - then - in_Set.Count := 1; - end if; - end Texture_is; - - - - procedure Program_is (Self : in out Item; Now : in openGL.Program.view) is @@ -249,6 +152,8 @@ is end is_Transparent; + + -------------- -- Operations -- @@ -282,6 +187,8 @@ is end render; + + ----------- -- Normals -- @@ -442,6 +349,8 @@ is pragma Unreferenced (Facets_of); + + ----------- -- Normals -- @@ -561,129 +470,6 @@ is - ----------- - -- Textures - -- - - procedure enable (the_Textures : in out texture_Set; - Program : in openGL.Program.view) - is - use GL, - GL.Binding, - openGL.Texture; - - begin - Tasks.check; - - if not the_Textures.initialised - then - for i in 1 .. the_Textures.Count - loop - declare - use ada.Strings, - ada.Strings.fixed; - - Id : constant texture_Id := texture_Id (i); - begin - declare - uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]"; - begin - the_Textures.Textures (Id).textures_Uniform := Program.uniform_Variable (Named => uniform_Name); - end; - - declare - uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; - begin - the_Textures.Textures (Id).fade_Uniform := Program.uniform_Variable (Named => uniform_Name); - end; - end; - end loop; - - the_Textures.Initialised := True; - end if; - - - for i in 1 .. the_Textures.Count - loop - declare - use GL.lean; - - use type GL.GLint; - - type texture_Units is array (texture_Id) of GLenum; - - all_texture_Units : constant texture_Units := (GL_TEXTURE0, - GL_TEXTURE1, - GL_TEXTURE2, - GL_TEXTURE3, - GL_TEXTURE4, - GL_TEXTURE5, - GL_TEXTURE6, - GL_TEXTURE7, - GL_TEXTURE8, - GL_TEXTURE9, - GL_TEXTURE10, - GL_TEXTURE11, - GL_TEXTURE12, - GL_TEXTURE13, - GL_TEXTURE14, - GL_TEXTURE15, - GL_TEXTURE16, - GL_TEXTURE17, - GL_TEXTURE18, - GL_TEXTURE19, - GL_TEXTURE20, - GL_TEXTURE21, - GL_TEXTURE22, - GL_TEXTURE23, - GL_TEXTURE24, - GL_TEXTURE25, - GL_TEXTURE26, - GL_TEXTURE27, - GL_TEXTURE28, - GL_TEXTURE29, - GL_TEXTURE30, - GL_TEXTURE31); - - Id : constant texture_Id := texture_Id (i); - begin - -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); - - glUniform1i (the_Textures.Textures (Id).textures_Uniform.gl_Variable, -- loc, - GLint (i) - 1); - - -- glUniform1i (the_Textures.Textures (Id).textures_uniform_Location, -- loc, - -- GLint (i) - 1); - - glActiveTexture (all_texture_Units (Id)); - glBindTexture (GL_TEXTURE_2D, - the_Textures.Textures (Id).Object.Name); - end; - - - declare - use ada.Strings, - ada.Strings.fixed; - - uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; - Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name); - begin - Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); - end; - end loop; - - - declare - the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count"); - begin - the_texture_count_Uniform.Value_is (the_Textures.Count); - end; - end enable; - - - - - --------- -- Bounds -- @@ -706,6 +492,8 @@ is end get_Bounds; + + --------------- -- Transparency -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index 658ffb3..0202921 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -2,8 +2,7 @@ with openGL.Primitive, openGL.Buffer, openGL.Program, - openGL.Texture, - openGL.Variable.uniform; + openGL.Texture; private @@ -49,52 +48,9 @@ is type texture_Id is range 1 .. max_Textures; - -- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in Texture.Object); - -- function Texture (Self : in Item'Class; Which : texture_ID) return Texture.Object; - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null; function Texture (Self : in Item) return openGL.Texture.Object; - - - - -- ************************************************************************* - -- TODO: Move all texture code to a new 'openGL.Geometry.texturing' package. - - type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible). - - type fadeable_Texture is - record - Fade : fade_Level := 0.0; - Object : openGL.Texture.Object := openGL.Texture.null_Object; - textures_Uniform : openGL.Variable.uniform.sampler2D; - fade_Uniform : openGL.Variable.uniform.float; - end record; - - type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; - - type texture_Set is - record - 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 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; - - procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object); - function Texture (in_Set : in texture_Set) return openGL.Texture.Object; - - - - procedure Bounds_are (Self : in out Item'Class; Now : in Bounds); function Bounds (self : in Item'Class) return Bounds; -- Returns the bounds in object space. diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads index 2ad2f3e..6a64289 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads @@ -1,5 +1,5 @@ with - openGL.Geometry, + openGL.Geometry.texturing, openGL.Texture; @@ -13,10 +13,10 @@ is type Face is record - Texture_1 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. - Texture_2 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. - Fade_1 : openGL.Geometry.fade_Level := 0.5; - Fade_2 : openGL.Geometry.fade_Level := 0.5; + Texture_1 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. + Texture_2 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. + Fade_1 : openGL.Geometry.texturing.fade_Level := 0.5; + Fade_2 : openGL.Geometry.texturing.fade_Level := 0.5; end record;