opengl: Rid 'Texture' and 'Texture_is' for texture_Sets.

This commit is contained in:
Rod Kay
2025-09-25 15:12:14 +10:00
parent 9ccf2d3cb5
commit 5a003202bf
32 changed files with 192 additions and 127 deletions

View File

@@ -420,6 +420,9 @@ is
deallocate (the_Vertices);
destroy (the_Model);
Self.Geometry.Model_is (Self'unchecked_Access);
-- Set the geometry texture.
--
if Self.Texture /= null_Asset

View File

@@ -44,7 +44,7 @@ is
--
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 openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views
is
pragma unreferenced (Textures, Fonts);

View File

@@ -27,7 +27,7 @@ is
--
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 openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
procedure end_Site_is (Self : in out Item; Now : in Vector_3;

View File

@@ -57,16 +57,16 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);
the_Geometry.is_Transparent;
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;
Color : constant rgba_Color := +Self.Color;
the_Face : Geometry_view;
Color : constant rgba_Color := +Self.Color;
the_Face : Geometry_view;
begin
declare

View File

@@ -60,6 +60,7 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
the_Geometry.is_Transparent;
@@ -113,8 +114,6 @@ is
end if;
end;
the_Face.Model_is (Self.all'unchecked_Access);
return [1 => the_Face.all'Access];
end to_GL_Geometries;

View File

@@ -51,9 +51,9 @@ is
(triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;

View File

@@ -48,8 +48,9 @@ is
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive
(triangle_Fan,
the_Indices).all'Access;
the_Indices).all'unchecked_Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -80,7 +81,6 @@ is
then
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
front_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -100,7 +100,6 @@ is
then
rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
rear_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -120,7 +119,6 @@ is
then
upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
upper_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -140,7 +138,6 @@ is
then
lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
lower_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -160,7 +157,6 @@ is
then
left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
left_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -180,7 +176,6 @@ is
then
right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
right_Face.Model_is (Self.all'unchecked_Access);
end if;
end;

View File

@@ -51,6 +51,7 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -86,7 +87,6 @@ is
then
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
front_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -106,7 +106,6 @@ is
then
rear_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
rear_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -126,7 +125,6 @@ is
then
upper_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
upper_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -146,7 +144,6 @@ is
then
lower_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
lower_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -166,7 +163,6 @@ is
then
left_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
left_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -186,7 +182,6 @@ is
then
right_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
right_Face.Model_is (Self.all'unchecked_Access);
end if;
end;

View File

@@ -80,6 +80,8 @@ is
begin
-- Define capsule shaft,
--
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
declare
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
@@ -197,8 +199,6 @@ is
begin
the_shaft_Geometry.add (Primitive.view (the_Primitive));
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
end;
@@ -234,7 +234,10 @@ is
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
begin
cap_Geometry.Model_is (Self.all'unchecked_Access);
if not is_Fore
then
a := Degrees_360;
@@ -397,8 +400,6 @@ is
end;
end;
cap_Geometry.Model_is (Self.all'unchecked_Access);
return cap_Geometry;
end new_Cap;

View File

@@ -77,6 +77,8 @@ is
begin
-- Define capsule shaft,
--
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
declare
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
@@ -190,8 +192,6 @@ is
begin
the_shaft_Geometry.add (Primitive.view (the_Primitive));
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
end;
@@ -228,6 +228,8 @@ is
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
begin
cap_Geometry.Model_is (Self.all'unchecked_Access);
if not is_Fore
then
a := Degrees_360;
@@ -388,8 +390,6 @@ is
end;
end;
cap_Geometry.Model_is (Self.all'unchecked_Access);
return cap_Geometry;
end new_Cap;

View File

@@ -38,8 +38,7 @@ is
is
pragma unreferenced (Textures, Fonts);
use --Geometry,
Geometry.textured,
use Geometry.textured,
real_Functions;
Length : constant Real := Self.Height;
@@ -77,6 +76,8 @@ is
begin
-- Define capsule shaft,
--
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
declare
vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge.
indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle.
@@ -209,7 +210,10 @@ is
longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords.
begin
cap_Geometry.Model_is (Self.all'unchecked_Access);
if not is_Fore
then
a := Degrees_360;
@@ -371,9 +375,6 @@ is
cap_2_Geometry := new_Cap (is_Fore => False);
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
cap_1_Geometry .Model_is (Self.all'unchecked_Access);
cap_2_Geometry .Model_is (Self.all'unchecked_Access);
return [1 => the_shaft_Geometry.all'Access,
2 => cap_1_Geometry.all'Access,

View File

@@ -80,6 +80,7 @@ is
Id : texture_Set.texture_Id;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
@@ -90,8 +91,8 @@ is
Id := texture_Id (i);
the_Geometry.Fade_is (which => Id,
now => Self.texture_Details.Fades (Id));
-- the_Geometry.Fade_is (which => Id,
-- now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (which => Id,
now => Textures.fetch (Self.texture_Details.Textures (i)));
@@ -99,7 +100,6 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Geometry;

View File

@@ -52,6 +52,7 @@ is
the_Primitive : constant Primitive.indexed.view
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

View File

@@ -58,7 +58,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
Id : texture_Set.texture_Id;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
@@ -66,8 +68,8 @@ is
loop
Id := texture_Id (i);
the_Geometry.Fade_is (Which => Id,
Now => Self.texture_Details.Fades (Id));
-- the_Geometry.Fade_is (Which => Id,
-- Now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (Which => Id,
Now => Textures.fetch (Self.texture_Details.Textures (i)));
@@ -75,7 +77,6 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;

View File

@@ -70,8 +70,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.add (Primitive.view (the_Primitive));
return the_Geometry;
end new_hexagon_Face;
@@ -90,6 +91,7 @@ is
the_Primitive : constant Primitive.view
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);

View File

@@ -75,8 +75,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.add (Primitive.view (the_Primitive));
return the_Geometry;
end new_hexagon_Face;
@@ -95,6 +96,7 @@ is
the_Primitive : constant Primitive.view
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);

View File

@@ -77,6 +77,7 @@ is
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -99,6 +100,7 @@ is
:= Primitive.indexed.new_Primitive (triangle_Strip,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

View File

@@ -71,8 +71,9 @@ is
:= Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.add (Primitive.view (the_Primitive));
return the_Geometry;
end new_hexagon_Face;
@@ -91,6 +92,7 @@ is
the_Primitive : constant Primitive.view
:= Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);

View File

@@ -73,6 +73,7 @@ is
the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
@@ -95,6 +96,7 @@ is
:= Primitive.indexed.new_Primitive (triangle_Strip,
the_Indices);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));

View File

@@ -70,6 +70,7 @@ is
Id : texture_Set.texture_Id;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
@@ -77,8 +78,8 @@ is
loop
Id := texture_Id (i);
the_Geometry.Fade_is (Which => Id,
Now => Self.texture_Details.Fades (Id));
-- the_Geometry.Fade_is (Which => Id,
-- Now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (Which => Id,
Now => Textures.fetch (Self.texture_Details.Textures (i)));
@@ -86,7 +87,6 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Geometry;

View File

@@ -73,6 +73,8 @@ is
the_Geometry : constant Geometry_view := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
use linear_Algebra,
@@ -201,7 +203,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

View File

@@ -65,6 +65,8 @@ is
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
use linear_Algebra,
@@ -188,7 +190,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

View File

@@ -70,6 +70,8 @@ is
the_Geometry : constant Geometry.textured.view := Geometry.textured.new_Geometry;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
use linear_Algebra_3d;
@@ -199,7 +201,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

View File

@@ -81,6 +81,8 @@ is
the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
set_Sites:
declare
vert_Id : Index_t := 0;
@@ -228,8 +230,6 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

View File

@@ -284,59 +284,16 @@ is
the_Primitive := Primitive.indexed .new_Primitive (Triangles, the_Indices);
the_Geometry := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => True);
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.Vertices_are (the_Vertices);
the_Geometry.Texture_is (Texture.Forge.to_Texture (Self.Font.gl_Texture));
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.is_Transparent;
-- the_Geometry.texture_Details_is (openGL.texture_Set.to_Details ([1 => to_Asset ("assets/textures/Face1.bmp")]));
return [1 => Geometry.view (the_Geometry)];
end;
end to_GL_Geometries;
------------
-- Texturing
--
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level)
-- is
-- begin
-- null;
-- end Fade_is;
--
--
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
-- is
-- begin
-- return 0.0;
-- end Fade;
--
--
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in openGL.asset_Name)
-- is
-- begin
-- null;
-- end Texture_is;
--
--
--
--
-- overriding
-- function texture_Count (Self : in Item) return Natural
-- is
-- begin
-- return 1;
-- end texture_Count;
end openGL.Model.Text.lit_colored;

View File

@@ -8,6 +8,26 @@ is
package body Mixin
is
overriding
procedure texture_Object_is (Self : in out textured_Item; Which : in texture_Set.texture_Id;
Now : in openGL.texture.Object)
is
begin
Self.texture_Details.Objects (Integer (Which)) := Now;
end texture_Object_is;
overriding
function texture_Object (Self : in textured_Item; Which : in texture_Set.texture_Id) return openGL.texture.Object
is
begin
return Self.texture_Details.Objects (Integer (Which));
end texture_Object;
overriding
procedure Fade_is (Self : in out textured_Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)

View File

@@ -18,6 +18,13 @@ is
is
type textured_Item is abstract new Item with private;
overriding
procedure texture_Object_is (Self : in out textured_Item; Which : in texture_Set.texture_Id;
Now : in openGL.texture.Object);
overriding
function texture_Object (Self : in textured_Item; Which : in texture_Set.texture_Id) return openGL.texture.Object;
overriding
function Fade (Self : in textured_Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;

View File

@@ -104,7 +104,7 @@ is
procedure create_GL_Geometries (Self : in out Item'Class; Textures : access Texture.name_Map_of_texture'Class;
procedure create_GL_Geometries (Self : in out Item'Class; Textures : access openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font)
is
all_Geometries : constant Geometry.views := Self.to_GL_Geometries (Textures, Fonts);
@@ -222,6 +222,24 @@ is
use ada.Tags;
function texture_Object (Self : in Item; Which : in texture_Set.texture_Id) return openGL.texture.Object
is
begin
raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing.";
return openGL.Texture.null_Object;
end texture_Object;
procedure texture_Object_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.texture.Object)
is
begin
raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing.";
end texture_Object_is;
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is

View File

@@ -74,6 +74,10 @@ is
-- Texturing
--
function texture_Object (Self : in Item; Which : in texture_Set.texture_Id) return texture.Object;
procedure texture_Object_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture.Object);
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);