From 640c3f47905340557ffc36aa3ccfea8ddb09ce5f Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Tue, 16 May 2023 17:17:28 +1000 Subject: [PATCH] opengl: Rename 'openGL.Geometry.texturing' to 'openGL.texturing'. --- .../opengl-geometry-lit_colored_textured.adb | 18 +- .../opengl-geometry-lit_colored_textured.ads | 12 +- .../geometry/opengl-geometry-lit_textured.adb | 15 +- .../geometry/opengl-geometry-lit_textured.ads | 12 +- .../geometry/opengl-geometry-textured.adb | 17 +- .../geometry/opengl-geometry-textured.ads | 12 +- ... opengl-geometry-texturing (copy 1).adb-1} | 0 ... opengl-geometry-texturing (copy 1).ads-1} | 0 .../source/lean/geometry/opengl-geometry.ads | 15 +- .../opengl-model-hexagon-lit_textured.adb | 13 +- .../opengl-model-hexagon-lit_textured.ads | 16 +- .../opengl/source/lean/model/opengl-model.adb | 6 +- .../opengl/source/lean/model/opengl-model.ads | 9 +- 3-mid/opengl/source/lean/opengl-texturing.adb | 186 ++++++++++++++++++ 3-mid/opengl/source/lean/opengl-texturing.ads | 54 +++++ 15 files changed, 312 insertions(+), 73 deletions(-) rename 3-mid/opengl/source/lean/geometry/{opengl-geometry-texturing.adb => opengl-geometry-texturing (copy 1).adb-1} (100%) rename 3-mid/opengl/source/lean/geometry/{opengl-geometry-texturing.ads => opengl-geometry-texturing (copy 1).ads-1} (100%) create mode 100644 3-mid/opengl/source/lean/opengl-texturing.adb create mode 100644 3-mid/opengl/source/lean/opengl-texturing.ads 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 bf651e0..aa00452 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 @@ -18,7 +18,8 @@ with package body openGL.Geometry.lit_colored_textured is - use GL.lean, + use openGL.texturing, + GL.lean, GL.Pointers, Interfaces, System; @@ -280,14 +281,14 @@ is --- Texturing -- - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level) + procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level) is begin Self.Textures.Textures (Which).Fade := Now; end Fade_is; - function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level + function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level is begin return Self.Textures.Textures (Which).Fade; @@ -299,7 +300,6 @@ is 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, @@ -311,8 +311,8 @@ is function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object is begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => Which); + return openGL.texturing.Texture (in_Set => Self.Textures, + which => Which); end Texture; @@ -320,7 +320,6 @@ is overriding 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); @@ -331,8 +330,8 @@ is function Texture (Self : in Item) return openGL.Texture.Object is begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => 1); + return openGL.texturing.Texture (in_Set => Self.Textures, + which => 1); end Texture; @@ -340,7 +339,6 @@ is overriding procedure enable_Texture (Self : in out Item) is - use openGL.Geometry.texturing; begin enable (Self.Textures, Self.Program); end enable_Texture; 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 c73a377..71526d4 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 @@ -1,5 +1,5 @@ with - openGL.Geometry.texturing; + openGL.texturing; package openGL.Geometry.lit_colored_textured @@ -42,12 +42,12 @@ is --- Texturing. -- - 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 Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level); + function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level; - procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object); - function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object; + procedure Texture_is (Self : in out Item; Which : texturing.texture_ID; Now : in openGL.Texture.Object); + function Texture (Self : in Item; Which : texturing.texture_ID) return openGL.Texture.Object; overriding procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); @@ -61,7 +61,7 @@ private type Item is new Geometry.item with record - Textures : Geometry.texturing.texture_Set; + Textures : texturing.texture_Set; end record; 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 9ffafdd..e34909a 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 @@ -25,6 +25,7 @@ package body openGL.Geometry.lit_textured is use GL.lean, GL.Pointers, + openGL.texturing, Interfaces; ----------- @@ -304,7 +305,7 @@ is --- Texturing -- - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level) + procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in texturing.fade_Level) is begin Self.Textures.Textures (which).Fade := Now; @@ -312,7 +313,7 @@ is - function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level + function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level is begin return Self.Textures.Textures (which).Fade; @@ -322,7 +323,6 @@ is 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, @@ -334,8 +334,8 @@ is function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object is begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => Which); + return openGL.texturing.Texture (in_Set => Self.Textures, + Which => Which); end Texture; @@ -343,7 +343,6 @@ is overriding 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); @@ -355,8 +354,8 @@ is function Texture (Self : in Item) return openGL.Texture.Object is begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => 1); + return texturing.Texture (in_Set => Self.Textures, + Which => 1); end Texture; 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 ef6bc47..f142703 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 @@ -1,5 +1,5 @@ with - openGL.Geometry.texturing; + openGL.texturing; package openGL.Geometry.lit_textured @@ -45,12 +45,12 @@ is --- Texturing. -- - 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 Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level); + function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level; - procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object); - function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object; + procedure Texture_is (Self : in out Item; Which : texturing.texture_ID; Now : in openGL.Texture.Object); + function Texture (Self : in Item; Which : texturing.texture_ID) return openGL.Texture.Object; overriding procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); @@ -64,7 +64,7 @@ private type Item is new Geometry.item with record - Textures : Geometry.texturing.texture_Set; + Textures : texturing.texture_Set; end record; 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 d648f33..a13961c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb @@ -19,6 +19,8 @@ is use GL.lean, GL.Pointers, + openGL.texturing, + Interfaces, System; @@ -167,7 +169,7 @@ is --- Texturing -- - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level) + procedure Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level) is begin Self.Textures.Textures (Which).Fade := Now; @@ -175,7 +177,7 @@ is - function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level + function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level is begin return Self.Textures.Textures (Which).Fade; @@ -185,7 +187,6 @@ is 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, @@ -197,8 +198,8 @@ is function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object is begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => Which); + return openGL.texturing.Texture (in_Set => Self.Textures, + Which => Which); end Texture; @@ -206,7 +207,6 @@ is overriding 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); @@ -218,8 +218,8 @@ is function Texture (Self : in Item) return openGL.Texture.Object is begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => 1); + return openGL.texturing.Texture (in_Set => Self.Textures, + which => 1); end Texture; @@ -227,7 +227,6 @@ is overriding procedure enable_Texture (Self : in out Item) is - use openGL.Geometry.texturing; begin enable (Self.Textures, Self.Program); end enable_Texture; 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 cf8a144..c2a15b7 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads @@ -1,5 +1,5 @@ with - openGL.Geometry.texturing; + openGL.texturing; package openGL.Geometry.textured @@ -42,12 +42,12 @@ is --- Texturing. -- - 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 Fade_is (Self : in out Item; Which : texturing.texture_ID; Now : in texturing.fade_Level); + function Fade (Self : in Item; Which : texturing.texture_ID) return texturing.fade_Level; - procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object); - function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object; + procedure Texture_is (Self : in out Item; Which : texturing.texture_ID; Now : in openGL.Texture.Object); + function Texture (Self : in Item; Which : texturing.texture_ID) return openGL.Texture.Object; overriding procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); @@ -61,7 +61,7 @@ private type Item is new Geometry.item with record - Textures : Geometry.texturing.texture_Set; + Textures : 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 (copy 1).adb-1 similarity index 100% rename from 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb rename to 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).adb-1 diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1 similarity index 100% rename from 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads rename to 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1 diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index f3ceaf8..fabf0e7 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -2,7 +2,8 @@ with openGL.Primitive, openGL.Buffer, openGL.Program, - openGL.Texture; + openGL.Texture, + openGL.texturing; limited with @@ -51,11 +52,11 @@ is - max_Textures : constant := 32; - - type texture_Id is range 1 .. max_Textures; - - + -- max_Textures : constant := 32; + -- + -- type texture_Id is range 1 .. max_Textures; + -- + -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null; function Texture (Self : in Item) return openGL.Texture.Object; @@ -102,7 +103,7 @@ is private use ada.Strings.unbounded; - type Textures is array (texture_Id) of openGL.Texture.Object; + type Textures is array (texturing.texture_Id) of openGL.Texture.Object; type Item is abstract tagged limited diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb index 5ffb46e..17f9393 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb @@ -33,8 +33,8 @@ is -- overriding - procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; - Now : in Geometry.Texturing.fade_Level) + procedure Fade_is (Self : in out Item; Which : in texturing.texture_Id; + Now : in texturing.fade_Level) is begin Self.Face.Fades (which) := Now; @@ -43,7 +43,7 @@ is overriding - function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level + function Fade (Self : in Item; Which : in texturing.texture_Id) return texturing.fade_Level is begin return Self.Face.Fades (which); @@ -51,7 +51,7 @@ is - procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id; + procedure Texture_is (Self : in out Item; Which : in texturing.texture_Id; Now : in openGL.asset_Name) is begin @@ -87,7 +87,8 @@ is function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view is - use Primitive; + use Primitive, + texturing; the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry; @@ -95,7 +96,7 @@ is the_Primitive : constant Primitive.indexed.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); - Id : texture_Id; + Id : texturing.texture_Id; begin the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads index fbfe2b0..45c7e23 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads @@ -1,5 +1,5 @@ with - openGL.Geometry.texturing, + openGL.texturing, openGL.Texture; @@ -14,8 +14,8 @@ is type Face is record - Fades : Geometry.texturing.fade_Levels (Geometry.texture_Id) := [others => 0.0]; - Textures : openGL.asset_Names (1 .. Positive (Geometry.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. + Fades : texturing.fade_Levels (texturing.texture_Id) := [others => 0.0]; + Textures : openGL.asset_Names (1 .. Positive (texturing.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. texture_Count : Natural := 0; end record; @@ -41,14 +41,14 @@ is -- overriding - function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level; + function Fade (Self : in Item; Which : in texturing.texture_Id) return texturing.fade_Level; overriding - procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; - Now : in Geometry.Texturing.fade_Level); + procedure Fade_is (Self : in out Item; Which : in texturing.texture_Id; + Now : in texturing.fade_Level); - procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id; - Now : in openGL.asset_Name); + procedure Texture_is (Self : in out Item; Which : in texturing.texture_Id; + Now : in asset_Name); overriding function texture_Count (Self : in Item) return Natural; diff --git a/3-mid/opengl/source/lean/model/opengl-model.adb b/3-mid/opengl/source/lean/model/opengl-model.adb index f9ff7a2..8ffd71f 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.adb +++ b/3-mid/opengl/source/lean/model/opengl-model.adb @@ -218,8 +218,8 @@ is -- Texturing -- - procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; - Now : in Geometry.Texturing.fade_Level) + procedure Fade_is (Self : in out Item; which : in texturing.texture_Id; + now : in texturing.fade_Level) is begin raise program_Error with "Model does not support texturing."; @@ -227,7 +227,7 @@ is - function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level + function Fade (Self : in Item; which : in texturing.texture_Id) return texturing.fade_Level is begin raise program_Error with "Model does not support texturing."; diff --git a/3-mid/opengl/source/lean/model/opengl-model.ads b/3-mid/opengl/source/lean/model/opengl-model.ads index c056e56..e68e187 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.ads +++ b/3-mid/opengl/source/lean/model/opengl-model.ads @@ -2,7 +2,8 @@ with openGL.remote_Model, openGL.Font, openGL.Texture, - openGL.Geometry.texturing; + openGL.Geometry, + openGL.texturing; package openGL.Model @@ -73,9 +74,9 @@ is -- Texturing -- - function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level; - procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; - Now : in Geometry.Texturing.fade_Level); + function Fade (Self : in Item; Which : in texturing.texture_Id) return texturing.fade_Level; + procedure Fade_is (Self : in out Item; Which : in texturing.texture_Id; + Now : in texturing.fade_Level); function texture_Count (Self : in Item) return Natural; diff --git a/3-mid/opengl/source/lean/opengl-texturing.adb b/3-mid/opengl/source/lean/opengl-texturing.adb new file mode 100644 index 0000000..79cdbc5 --- /dev/null +++ b/3-mid/opengl/source/lean/opengl-texturing.adb @@ -0,0 +1,186 @@ +with + openGL.Tasks, + + GL.Binding, + GL.lean, + + ada.Strings.fixed; + +with ada.Text_IO; use ada.Text_IO; + + +package body openGL.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, + texture_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 + null; + + declare + uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]"; + begin + the_Textures.Textures (Id).texture_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 + null; + glUniform1i (the_Textures.Textures (Id).texture_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); + -- Id : constant texture_Id := texture_Id (i); + -- begin + -- -- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image); + -- + -- -- the_Textures.Textures (Id).fade_Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); + -- -- Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); + -- null; + -- 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.texturing; diff --git a/3-mid/opengl/source/lean/opengl-texturing.ads b/3-mid/opengl/source/lean/opengl-texturing.ads new file mode 100644 index 0000000..7c7cf80 --- /dev/null +++ b/3-mid/opengl/source/lean/opengl-texturing.ads @@ -0,0 +1,54 @@ +with + openGL.Program, + openGL.Texture, + openGL.Variable.uniform; + + +package openGL.texturing +-- +-- Facilitates texturing of geometries. +-- +is + max_Textures : constant := 32; + + type texture_Id is range 1 .. max_Textures; + + + + type fade_Level is delta 0.001 range 0.0 .. 1.0 -- '0.0' is no fading, '1.0' is fully faded (ie invisible). + with Atomic; + + type fade_Levels is array (texture_Id range <>) of fade_Level; + + + type fadeable_Texture is + record + Fade : fade_Level := 0.0; + Object : openGL.Texture.Object := openGL.Texture.null_Object; + texture_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.texturing;