From f59512d51eea27073cd9928c679ab902d461878b Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Mon, 23 Sep 2024 17:05:25 +1000 Subject: [PATCH] opengl: Allow models with multiple textures to selectively apply/unapply individual textures. --- .../geometry/opengl-geometry-texturing.adb | 51 ++++++++++--------- .../geometry/opengl-geometry-texturing.ads | 17 ++++--- .../source/lean/geometry/opengl-geometry.adb | 18 +++---- .../source/lean/geometry/opengl-geometry.ads | 5 +- .../opengl-model-circle-lit_textured.adb | 18 +++++++ .../opengl-model-circle-lit_textured.ads | 14 +++-- .../opengl-model-hexagon-lit_textured.adb | 26 ++++++++-- .../opengl-model-hexagon-lit_textured.ads | 14 +++-- .../lean/model/opengl-model-hexagon.adb | 2 +- .../opengl-model-polygon-lit_textured.adb | 24 +++++++++ .../opengl-model-polygon-lit_textured.ads | 16 ++++-- .../lean/model/opengl-model-terrain.ads | 4 +- .../lean/model/opengl-model-texturing.adb | 39 +++++++------- .../lean/model/opengl-model-texturing.ads | 14 ++--- .../opengl/source/lean/model/opengl-model.adb | 49 ++++++------------ .../opengl/source/lean/model/opengl-model.ads | 9 ++-- .../opengl/source/lean/opengl-texture_set.adb | 5 +- .../opengl/source/lean/opengl-texture_set.ads | 4 ++ 4-high/gel/source/forge/gel-forge.adb | 16 +++--- 19 files changed, 208 insertions(+), 137 deletions(-) diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb index 3158e76..f5676bc 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -62,7 +62,8 @@ is begin for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count) loop - Uniforms.Textures (i).fade_Uniform.Value_is (Real (for_Model.Fade (i))); + Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (i))); + Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (i)); glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable, GLint (i) - 1); @@ -86,12 +87,14 @@ is declare use ada.Strings, ada.Strings.fixed; - i : constant Positive := Positive (Id); - texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]"; - fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]"; + i : constant Positive := Positive (Id); + texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]"; + fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]"; + texture_applies_uniform_Name : constant String := "texture_Applies[" & trim (Natural'Image (i - 1), Left) & "]"; begin - Uniforms.Textures (Id).texture_Uniform := for_Program.uniform_Variable (named => texture_uniform_Name); - Uniforms.Textures (Id). fade_Uniform := for_Program.uniform_Variable (named => fade_uniform_Name); + Uniforms.Textures (Id). texture_Uniform := for_Program.uniform_Variable (Named => texture_uniform_Name); + Uniforms.Textures (Id). fade_Uniform := for_Program.uniform_Variable (Named => fade_uniform_Name); + Uniforms.Textures (Id).texture_applied_Uniform := for_Program.uniform_Variable (Named => texture_applies_uniform_Name); end; end loop; @@ -106,7 +109,6 @@ is --- Mixin --- ------------- - -- generic package body Mixin is use openGL.texture_Set; @@ -127,7 +129,7 @@ is Which : in texture_Set.texture_ID := 1) is begin - Self.texture_Set.Textures (which).Fade := Now; + Self.texture_Set.Textures (Which).Fade := Now; end Fade_is; @@ -163,23 +165,22 @@ is - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) - -- is - -- begin - -- Texture_is (in_Set => Self.texture_Set, - -- Now => Now); - -- end Texture_is; - -- - -- - -- - -- overriding - -- function Texture (Self : in Item) return openGL.Texture.Object - -- is - -- begin - -- return texture_Set.Texture (in_Set => Self.texture_Set, - -- Which => 1); - -- end Texture; + overriding + procedure texture_Applied_is (Self : in out Item; Now : in Boolean; + Which : in texture_Set.texture_ID := 1) + is + begin + Self.texture_Set.Textures (Which).Applied := Now; + end texture_Applied_is; + + + + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean + is + begin + return Self.texture_Set.Textures (which).Applied; + end texture_Applied; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads index 0452519..1e4f496 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads @@ -20,8 +20,9 @@ is type texture_fade_Uniform_pair is record - texture_Uniform : openGL.Variable.uniform.sampler2D; - fade_Uniform : openGL.Variable.uniform.float; + texture_Uniform : openGL.Variable.uniform.sampler2D; + fade_Uniform : openGL.Variable.uniform.float; + texture_applied_Uniform : openGL.Variable.uniform.bool; end record; @@ -78,11 +79,13 @@ is overriding function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); - -- - -- overriding - -- function Texture (Self : in Item) return openGL.Texture.Object; + + overriding + procedure texture_Applied_is (Self : in out Item; Now : in Boolean; + Which : in texture_Set.texture_ID := 1); + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean; + overriding diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index e183f3b..eea6cce 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -118,15 +118,6 @@ is - -- function Texture (Self : in Item) return openGL.Texture.Object - -- is - -- begin - -- raise program_Error with "Geometry has no texture."; - -- return openGL.Texture.null_Object; - -- end Texture; - - - function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object is begin @@ -136,6 +127,15 @@ is + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean + is + begin + raise program_Error with "Geometry has no texture."; + return False; + end texture_Applied; + + + procedure Program_is (Self : in out Item; Now : in openGL.Program.view) is begin diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index a649d62..2819cdf 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 Which : in texture_Set.texture_ID := 1) is null; function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.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; + procedure texture_Applied_is (Self : in out Item; Now : in Boolean; + Which : in texture_Set.texture_ID := 1) is null; + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean; diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb index dadd5fd..5d74724 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb @@ -72,6 +72,24 @@ is + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean + is + begin + return Self.Face.texture_Applies (Which); + end texture_Applied; + + + + overriding + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean) + is + begin + Self.Face.texture_Applies (Which) := Now; + end texture_Applied_is; + + --------------------- --- openGL Geometries diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads index 7a7438a..f3d3b85 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads @@ -14,9 +14,10 @@ is type Face is record - Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; - Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. - texture_Count : Natural := 0; + Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; + texture_Applies : texture_Set.texture_Apply_array := [others => True]; + Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. + texture_Count : Natural := 0; end record; @@ -55,6 +56,13 @@ is function texture_Count (Self : in Item) return Natural; + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean; + + overriding + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean); + private 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 e88f70a..53483fa 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 @@ -37,7 +37,7 @@ is Now : in texture_Set.fade_Level) is begin - Self.Face.Fades (which) := Now; + Self.Face.Fades (Which) := Now; end Fade_is; @@ -46,7 +46,7 @@ is function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level is begin - return Self.Face.Fades (which); + return Self.Face.Fades (Which); end Fade; @@ -55,7 +55,7 @@ is Now : in openGL.asset_Name) is begin - Self.Face.Textures (Positive (which)) := Now; + Self.Face.Textures (Positive (Which)) := Now; end Texture_is; @@ -71,6 +71,26 @@ is + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean + is + begin + return Self.Face.texture_Applies (Which); + end texture_Applied; + + + + overriding + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean) + is + begin + Self.Face.texture_Applies (Which) := Now; + end texture_Applied_is; + + + + overriding function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; Fonts : in Font.font_id_Map_of_font) return Geometry.views 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 882bf63..236d50d 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 @@ -14,9 +14,10 @@ is type Face is record - Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; - Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. - texture_Count : Natural := 0; + Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; + Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. + texture_Count : Natural := 0; + texture_Applies : texture_Set.texture_Apply_array := [others => True]; end record; @@ -54,6 +55,13 @@ is function texture_Count (Self : in Item) return Natural; + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean; + + overriding + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean); + private diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon.adb index 981d519..9b2baec 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon.adb @@ -6,7 +6,7 @@ is use linear_Algebra_3d; the_Site : Vector_3 := [Radius, 0.0, 0.0]; - Rotation : constant Matrix_3x3 := y_Rotation_from (to_Radians (60.0)); + Rotation : constant Matrix_3x3 := z_Rotation_from (to_Radians (60.0)); the_Sites : Sites; diff --git a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb index d848f38..57a8a60 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb @@ -73,6 +73,30 @@ is + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean + is + begin + return Self.Face.texture_Applies (Which); + end texture_Applied; + + + + overriding + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean) + is + begin + Self.Face.texture_Applies (Which) := Now; + end texture_Applied_is; + + + + + + -------------------- + --- to_GL_Geometries + -- overriding function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; diff --git a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads index 601f9c6..c912028 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads @@ -14,10 +14,11 @@ is type Face is record - Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; - Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. - texture_Count : Natural := 0; - texture_Tiling : openGL.Real := 1.0; -- The number of times the texture should be wrapped. + Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0]; + Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. + texture_Count : Natural := 0; + texture_Tiling : openGL.Real := 1.0; -- The number of times the texture should be wrapped. + texture_Applies : texture_Set.texture_Apply_array := [others => True]; end record; @@ -55,6 +56,13 @@ is function texture_Count (Self : in Item) return Natural; + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean; + + overriding + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean); + private diff --git a/3-mid/opengl/source/lean/model/opengl-model-terrain.ads b/3-mid/opengl/source/lean/model/opengl-model-terrain.ads index daf30ff..552dbc4 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-terrain.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-terrain.ads @@ -46,10 +46,10 @@ is overriding procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in texture_Set.fade_Level); + Now : in texture_Set.fade_Level); procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in asset_Name); + Now : in asset_Name); overriding function texture_Count (Self : in Item) return Natural; diff --git a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb index 97ce4aa..5f393a1 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb @@ -127,7 +127,7 @@ is Which : in texture_Set.texture_ID := 1) is begin - Self.texture_Set.Textures (which).Fade := Now; + Self.texture_Set.Textures (Which).Fade := Now; end Fade_is; @@ -136,7 +136,7 @@ is function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level is begin - return Self.texture_Set.Textures (which).Fade; + return Self.texture_Set.Textures (Which).Fade; end Fade; @@ -163,23 +163,22 @@ is - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) - -- is - -- begin - -- Texture_is (in_Set => Self.texture_Set, - -- Now => Now); - -- end Texture_is; - -- - -- - -- - -- overriding - -- function Texture (Self : in Item) return openGL.Texture.Object - -- is - -- begin - -- return texture_Set.Texture (in_Set => Self.texture_Set, - -- Which => 1); - -- end Texture; + overriding + procedure texture_Applied_is (Self : in out Item; Now : in Boolean; + Which : in texture_Set.texture_ID := 1) + is + begin + Self.texture_Set.Textures (Which).Applied := Now; + end texture_Applied_is; + + + + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean + is + begin + return Self.texture_Set.Textures (Which).Applied; + end texture_Applied; @@ -187,8 +186,6 @@ is procedure enable_Textures (Self : in out Item) is begin - -- ada.Text_IO.put_Line (Self.Model'Image); - texturing.enable (for_Model => Self.Model.all'Access, Uniforms => texture_Uniforms, texture_Set => Self.texture_Set); diff --git a/3-mid/opengl/source/lean/model/opengl-model-texturing.ads b/3-mid/opengl/source/lean/model/opengl-model-texturing.ads index 45dc332..1f41db6 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.ads @@ -69,7 +69,7 @@ is procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; Which : in texture_Set.texture_ID := 1); overriding - function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level; + function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level; overriding @@ -78,17 +78,19 @@ is overriding function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); - -- - -- overriding - -- function Texture (Self : in Item) return openGL.Texture.Object; + + overriding + procedure texture_Applied_is (Self : in out Item; Now : in Boolean; + Which : in texture_Set.texture_ID := 1); + overriding + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean; overriding procedure enable_Textures (Self : in out Item); + private type Item is new Geometry.item with diff --git a/3-mid/opengl/source/lean/model/opengl-model.adb b/3-mid/opengl/source/lean/model/opengl-model.adb index 3555c4f..826b0c4 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 texture_Set.texture_Id; - now : in texture_Set.fade_Level) + procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in texture_Set.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 texture_Set.texture_Id) return texture_Set.fade_Level + function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level is begin raise program_Error with "Model does not support texturing."; @@ -245,40 +245,21 @@ is + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean + is + begin + raise program_Error with "Model does not support texturing."; + return False; + end texture_Applied; - -- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) - -- is - -- begin - -- raise program_Error with "Model does not support texturing."; - -- end Fade_1_is; - -- - -- - -- - -- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) - -- is - -- begin - -- raise program_Error with "Model does not support texturing."; - -- end Fade_2_is; - -- - -- - -- - -- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level - -- is - -- begin - -- raise program_Error with "Model does not support texturing."; - -- return 0.0; - -- end Fade_1; - -- - -- - -- - -- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level - -- is - -- begin - -- raise program_Error with "Model does not support texturing."; - -- return 0.0; - -- end Fade_2; + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean) + is + begin + raise program_Error with "Model does not support texturing."; + end texture_applied_is; end openGL.Model; diff --git a/3-mid/opengl/source/lean/model/opengl-model.ads b/3-mid/opengl/source/lean/model/opengl-model.ads index 84d74c6..6450dc4 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.ads +++ b/3-mid/opengl/source/lean/model/opengl-model.ads @@ -80,12 +80,9 @@ is function texture_Count (Self : in Item) return Natural; - - -- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); - -- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); - -- - -- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; - -- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; + function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean; + procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in Boolean); diff --git a/3-mid/opengl/source/lean/opengl-texture_set.adb b/3-mid/opengl/source/lean/opengl-texture_set.adb index 75a45a6..e36b6a0 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.adb +++ b/3-mid/opengl/source/lean/opengl-texture_set.adb @@ -15,10 +15,7 @@ is procedure Texture_is (in_Set : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) is begin - in_Set.Textures (Which) := (0.0, - Now); --, - -- texture_Uniform => <>, - -- fade_Uniform => <>); + in_Set.Textures (Which).Object := Now; in_Set.is_Transparent := in_Set.is_Transparent or Now .is_Transparent; diff --git a/3-mid/opengl/source/lean/opengl-texture_set.ads b/3-mid/opengl/source/lean/opengl-texture_set.ads index 7396b16..d7daff1 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.ads +++ b/3-mid/opengl/source/lean/opengl-texture_set.ads @@ -24,10 +24,14 @@ is type fade_Levels is array (texture_Id range <>) of fade_Level; + type texture_Apply_array is array (texture_Set.texture_Id) of Boolean; + + type fadeable_Texture is record Fade : fade_Level := 0.0; Object : openGL.Texture.Object := openGL.Texture.null_Object; + Applied : Boolean := True; -- Whether this texture is painted on. -- texture_Uniform : openGL.Variable.uniform.sampler2D; -- fade_Uniform : openGL.Variable.uniform.float; end record; diff --git a/4-high/gel/source/forge/gel-forge.adb b/4-high/gel/source/forge/gel-forge.adb index 418168e..8b8dfae 100644 --- a/4-high/gel/source/forge/gel-forge.adb +++ b/4-high/gel/source/forge/gel-forge.adb @@ -163,9 +163,10 @@ is else the_graphics_Model := openGL.Model.circle.lit_textured.new_Circle (Radius, - Face => (Fades => [1 => 0.0, others => <>], - Textures => [1 => Texture, others => <>], - texture_Count => 1)).all'Access; + Face => (Fades => [1 => 0.0, others => <>], + texture_Applies => [1 => True, others => <>], + Textures => [1 => Texture, others => <>], + texture_Count => 1)).all'Access; end if; return gel.Sprite.Forge.new_Sprite (Name, @@ -220,10 +221,11 @@ is (Color, openGL.Opaque)).all'Access; else the_graphics_Model := openGL.Model.polygon.lit_textured.new_Polygon (openGL.Vector_2_array (Vertices), - Face => (Fades => [1 => 0.0, others => <>], - Textures => [1 => Texture, others => <>], - texture_Count => 1, - texture_Tiling => texture_Tiling)).all'Access; + Face => (Fades => [1 => 0.0, others => <>], + Textures => [1 => Texture, others => <>], + texture_Count => 1, + texture_Tiling => texture_Tiling, + texture_Applies => [others => <>])).all'Access; end if; return gel.Sprite.Forge.new_Sprite (Name,