opengl: Allow models with multiple textures to selectively apply/unapply individual textures.

This commit is contained in:
Rod Kay
2024-09-23 17:05:25 +10:00
parent 47b04dcc8f
commit f59512d51e
19 changed files with 208 additions and 137 deletions

View File

@@ -62,7 +62,8 @@ is
begin begin
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count) for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
loop 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, glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
GLint (i) - 1); GLint (i) - 1);
@@ -86,12 +87,14 @@ is
declare declare
use ada.Strings, use ada.Strings,
ada.Strings.fixed; ada.Strings.fixed;
i : constant Positive := Positive (Id); i : constant Positive := Positive (Id);
texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]"; texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
fade_uniform_Name : constant String := "Fade[" & 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 begin
Uniforms.Textures (Id).texture_Uniform := for_Program.uniform_Variable (named => texture_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). 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;
end loop; end loop;
@@ -106,7 +109,6 @@ is
--- Mixin --- --- Mixin ---
------------- -------------
-- generic
package body Mixin package body Mixin
is is
use openGL.texture_Set; use openGL.texture_Set;
@@ -127,7 +129,7 @@ is
Which : in texture_Set.texture_ID := 1) Which : in texture_Set.texture_ID := 1)
is is
begin begin
Self.texture_Set.Textures (which).Fade := Now; Self.texture_Set.Textures (Which).Fade := Now;
end Fade_is; end Fade_is;
@@ -163,23 +165,22 @@ is
-- overriding overriding
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
-- is Which : in texture_Set.texture_ID := 1)
-- begin is
-- Texture_is (in_Set => Self.texture_Set, begin
-- Now => Now); Self.texture_Set.Textures (Which).Applied := Now;
-- end Texture_is; end texture_Applied_is;
--
--
--
-- overriding overriding
-- function Texture (Self : in Item) return openGL.Texture.Object function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
-- is is
-- begin begin
-- return texture_Set.Texture (in_Set => Self.texture_Set, return Self.texture_Set.Textures (which).Applied;
-- Which => 1); end texture_Applied;
-- end Texture;

View File

@@ -20,8 +20,9 @@ is
type texture_fade_Uniform_pair is type texture_fade_Uniform_pair is
record record
texture_Uniform : openGL.Variable.uniform.sampler2D; texture_Uniform : openGL.Variable.uniform.sampler2D;
fade_Uniform : openGL.Variable.uniform.float; fade_Uniform : openGL.Variable.uniform.float;
texture_applied_Uniform : openGL.Variable.uniform.bool;
end record; end record;
@@ -78,11 +79,13 @@ is
overriding overriding
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; 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
-- procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
-- overriding Which : in texture_Set.texture_ID := 1);
-- function Texture (Self : in Item) return openGL.Texture.Object; overriding
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
overriding overriding

View File

@@ -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 function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
is is
begin 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) procedure Program_is (Self : in out Item; Now : in openGL.Program.view)
is is
begin begin

View File

@@ -62,8 +62,9 @@ is
Which : in texture_Set.texture_ID := 1) is null; 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; 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; procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
-- function Texture (Self : in Item) return openGL.Texture.Object; Which : in texture_Set.texture_ID := 1) is null;
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;

View File

@@ -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 --- openGL Geometries

View File

@@ -14,9 +14,10 @@ is
type Face is type Face is
record record
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.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_Applies : texture_Set.texture_Apply_array := [others => True];
texture_Count : Natural := 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;
end record; end record;
@@ -55,6 +56,13 @@ is
function texture_Count (Self : in Item) return Natural; 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 private

View File

@@ -37,7 +37,7 @@ is
Now : in texture_Set.fade_Level) Now : in texture_Set.fade_Level)
is is
begin begin
Self.Face.Fades (which) := Now; Self.Face.Fades (Which) := Now;
end Fade_is; end Fade_is;
@@ -46,7 +46,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 is
begin begin
return Self.Face.Fades (which); return Self.Face.Fades (Which);
end Fade; end Fade;
@@ -55,7 +55,7 @@ is
Now : in openGL.asset_Name) Now : in openGL.asset_Name)
is is
begin begin
Self.Face.Textures (Positive (which)) := Now; Self.Face.Textures (Positive (Which)) := Now;
end Texture_is; 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 overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; 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 Fonts : in Font.font_id_Map_of_font) return Geometry.views

View File

@@ -14,9 +14,10 @@ is
type Face is type Face is
record record
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.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. 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_Count : Natural := 0;
texture_Applies : texture_Set.texture_Apply_array := [others => True];
end record; end record;
@@ -54,6 +55,13 @@ is
function texture_Count (Self : in Item) return Natural; 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 private

View File

@@ -6,7 +6,7 @@ is
use linear_Algebra_3d; use linear_Algebra_3d;
the_Site : Vector_3 := [Radius, 0.0, 0.0]; 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; the_Sites : Sites;

View File

@@ -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 overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;

View File

@@ -14,10 +14,11 @@ is
type Face is type Face is
record record
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.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. 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_Count : Natural := 0;
texture_Tiling : openGL.Real := 1.0; -- The number of times the texture should be wrapped. 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; end record;
@@ -55,6 +56,13 @@ is
function texture_Count (Self : in Item) return Natural; 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 private

View File

@@ -46,10 +46,10 @@ is
overriding overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; 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; procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name); Now : in asset_Name);
overriding overriding
function texture_Count (Self : in Item) return Natural; function texture_Count (Self : in Item) return Natural;

View File

@@ -127,7 +127,7 @@ is
Which : in texture_Set.texture_ID := 1) Which : in texture_Set.texture_ID := 1)
is is
begin begin
Self.texture_Set.Textures (which).Fade := Now; Self.texture_Set.Textures (Which).Fade := Now;
end Fade_is; 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 function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level
is is
begin begin
return Self.texture_Set.Textures (which).Fade; return Self.texture_Set.Textures (Which).Fade;
end Fade; end Fade;
@@ -163,23 +163,22 @@ is
-- overriding overriding
-- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
-- is Which : in texture_Set.texture_ID := 1)
-- begin is
-- Texture_is (in_Set => Self.texture_Set, begin
-- Now => Now); Self.texture_Set.Textures (Which).Applied := Now;
-- end Texture_is; end texture_Applied_is;
--
--
--
-- overriding overriding
-- function Texture (Self : in Item) return openGL.Texture.Object function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean
-- is is
-- begin begin
-- return texture_Set.Texture (in_Set => Self.texture_Set, return Self.texture_Set.Textures (Which).Applied;
-- Which => 1); end texture_Applied;
-- end Texture;
@@ -187,8 +186,6 @@ is
procedure enable_Textures (Self : in out Item) procedure enable_Textures (Self : in out Item)
is is
begin begin
-- ada.Text_IO.put_Line (Self.Model'Image);
texturing.enable (for_Model => Self.Model.all'Access, texturing.enable (for_Model => Self.Model.all'Access,
Uniforms => texture_Uniforms, Uniforms => texture_Uniforms,
texture_Set => Self.texture_Set); texture_Set => Self.texture_Set);

View File

@@ -69,7 +69,7 @@ is
procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level;
Which : in texture_Set.texture_ID := 1); Which : in texture_Set.texture_ID := 1);
overriding 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 overriding
@@ -78,17 +78,19 @@ is
overriding overriding
function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; 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
-- procedure texture_Applied_is (Self : in out Item; Now : in Boolean;
-- overriding Which : in texture_Set.texture_ID := 1);
-- function Texture (Self : in Item) return openGL.Texture.Object; overriding
function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean;
overriding overriding
procedure enable_Textures (Self : in out Item); procedure enable_Textures (Self : in out Item);
private private
type Item is new Geometry.item with type Item is new Geometry.item with

View File

@@ -218,8 +218,8 @@ is
-- Texturing -- Texturing
-- --
procedure Fade_is (Self : in out Item; which : in texture_Set.texture_Id; 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)
is is
begin begin
raise program_Error with "Model does not support texturing."; 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 is
begin begin
raise program_Error with "Model does not support texturing."; 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) procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- is Now : in Boolean)
-- begin is
-- raise program_Error with "Model does not support texturing."; begin
-- end Fade_1_is; raise program_Error with "Model does not support texturing.";
-- end texture_applied_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;
end openGL.Model; end openGL.Model;

View File

@@ -80,12 +80,9 @@ is
function texture_Count (Self : in Item) return Natural; function texture_Count (Self : in Item) return Natural;
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean;
-- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); Now : in Boolean);
--
-- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level;
-- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;

View File

@@ -15,10 +15,7 @@ is
procedure Texture_is (in_Set : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) procedure Texture_is (in_Set : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is is
begin begin
in_Set.Textures (Which) := (0.0, in_Set.Textures (Which).Object := Now;
Now); --,
-- texture_Uniform => <>,
-- fade_Uniform => <>);
in_Set.is_Transparent := in_Set.is_Transparent in_Set.is_Transparent := in_Set.is_Transparent
or Now .is_Transparent; or Now .is_Transparent;

View File

@@ -24,10 +24,14 @@ is
type fade_Levels is array (texture_Id range <>) of fade_Level; 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 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;
Applied : Boolean := True; -- Whether this texture is painted on.
-- texture_Uniform : openGL.Variable.uniform.sampler2D; -- texture_Uniform : openGL.Variable.uniform.sampler2D;
-- fade_Uniform : openGL.Variable.uniform.float; -- fade_Uniform : openGL.Variable.uniform.float;
end record; end record;

View File

@@ -163,9 +163,10 @@ is
else else
the_graphics_Model := openGL.Model.circle.lit_textured.new_Circle (Radius, the_graphics_Model := openGL.Model.circle.lit_textured.new_Circle (Radius,
Face => (Fades => [1 => 0.0, others => <>], Face => (Fades => [1 => 0.0, others => <>],
Textures => [1 => Texture, others => <>], texture_Applies => [1 => True, others => <>],
texture_Count => 1)).all'Access; Textures => [1 => Texture, others => <>],
texture_Count => 1)).all'Access;
end if; end if;
return gel.Sprite.Forge.new_Sprite (Name, return gel.Sprite.Forge.new_Sprite (Name,
@@ -220,10 +221,11 @@ is
(Color, openGL.Opaque)).all'Access; (Color, openGL.Opaque)).all'Access;
else else
the_graphics_Model := openGL.Model.polygon.lit_textured.new_Polygon (openGL.Vector_2_array (Vertices), the_graphics_Model := openGL.Model.polygon.lit_textured.new_Polygon (openGL.Vector_2_array (Vertices),
Face => (Fades => [1 => 0.0, others => <>], Face => (Fades => [1 => 0.0, others => <>],
Textures => [1 => Texture, others => <>], Textures => [1 => Texture, others => <>],
texture_Count => 1, texture_Count => 1,
texture_Tiling => texture_Tiling)).all'Access; texture_Tiling => texture_Tiling,
texture_Applies => [others => <>])).all'Access;
end if; end if;
return gel.Sprite.Forge.new_Sprite (Name, return gel.Sprite.Forge.new_Sprite (Name,