nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

18
3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb
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

14
3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads
View File

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

26
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb
View File

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

14
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads
View File

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

2
3-mid/opengl/source/lean/model/opengl-model-hexagon.adb
View File

@@ -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;

24
3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb
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
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;

16
3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads
View File

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

4
3-mid/opengl/source/lean/model/opengl-model-terrain.ads
View File

@@ -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;

39
3-mid/opengl/source/lean/model/opengl-model-texturing.adb
View File

@@ -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);

14
3-mid/opengl/source/lean/model/opengl-model-texturing.ads
View File

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

49
3-mid/opengl/source/lean/model/opengl-model.adb
View File

@@ -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;

9
3-mid/opengl/source/lean/model/opengl-model.ads
View File

@@ -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);