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

opengl.model.polygon.lit_textured: Use model texturing mixin.

Browse Source
This commit is contained in:
Rod Kay
2025-09-07 06:27:46 +10:00
parent eb12d98f65
commit b766155987
6 changed files with 243 additions and 216 deletions
Download Patch File Download Diff File Expand all files Collapse all files

186
3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb
View File

@@ -10,15 +10,29 @@ is
--- Forge
--
function new_polygon (vertex_Sites : in Vector_2_array;
Face : in Face_t) return View
-- function new_polygon (vertex_Sites : in Vector_2_array;
-- Face : in Face_t) return View
-- is
-- Self : constant View := new Item;
-- begin
-- Self.vertex_Sites (1 .. vertex_Sites'Length) := vertex_Sites;
-- Self.vertex_Count := vertex_Sites'Length;
--
-- Self.Face := Face;
--
-- return Self;
-- end new_polygon;
function new_polygon (vertex_Sites : in Vector_2_array;
texture_Details : in texture_Set.Details) return View
is
Self : constant View := new Item;
begin
Self.vertex_Sites (1 .. vertex_Sites'Length) := vertex_Sites;
Self.vertex_Count := vertex_Sites'Length;
Self.Face := Face;
Self.texture_Details_is (texture_Details);
return Self;
end new_polygon;
@@ -30,11 +44,11 @@ is
--- Attributes ---
------------------
function Face (Self : in Item) return Face_t
is
begin
return Self.Face;
end Face;
-- function texture_Details (Self : in Item) return texture_Set.Details
-- is
-- begin
-- return Self.texture_Details;
-- end texture_Details;
@@ -42,77 +56,77 @@ is
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
Self.Face.texture_Details.Fades (which) := Now;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return Self.Face.texture_Details.Fades (which);
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
Self.Face.texture_Details.Textures (Positive (which)) := Now;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return Self.Face.texture_Details.texture_Count;
end texture_Count;
overriding
function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
is
begin
return Self.Face.texture_Details.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_Details.texture_Applies (Which) := Now;
end texture_Applied_is;
overriding
procedure animate (Self : in out Item)
is
use type texture_Set.Animation_view;
begin
if Self.Face.texture_Details.Animation = null
then
return;
end if;
texture_Set.animate (Self.Face.texture_Details.Animation.all,
Self.Face.texture_Details.texture_Applies);
end animate;
-- overriding
-- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in texture_Set.fade_Level)
-- is
-- begin
-- Self.Face.texture_Details.Fades (which) := Now;
-- end Fade_is;
--
--
--
-- overriding
-- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
-- is
-- begin
-- return Self.Face.texture_Details.Fades (which);
-- end Fade;
--
--
--
-- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
-- Now : in openGL.asset_Name)
-- is
-- begin
-- Self.Face.texture_Details.Textures (Positive (which)) := Now;
-- end Texture_is;
--
--
--
--
-- overriding
-- function texture_Count (Self : in Item) return Natural
-- is
-- begin
-- return Self.Face.texture_Details.texture_Count;
-- end texture_Count;
--
--
--
-- overriding
-- function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean
-- is
-- begin
-- return Self.Face.texture_Details.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_Details.texture_Applies (Which) := Now;
-- end texture_Applied_is;
--
--
--
--
-- overriding
-- procedure animate (Self : in out Item)
-- is
-- use type texture_Set.Animation_view;
-- begin
-- if Self.Face.texture_Details.Animation = null
-- then
-- return;
-- end if;
--
-- texture_Set.animate (Self.Face.texture_Details.Animation.all,
-- Self.Face.texture_Details.texture_Applies);
-- end animate;
@@ -164,15 +178,15 @@ is
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
for i in 1 .. Self.Face.texture_Details.texture_Count
for i in 1 .. Self.texture_Details.texture_Count
loop
Id := texture_Id (i);
the_Geometry.Fade_is (which => Id,
now => Self.Face.texture_Details.Fades (Id));
now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (which => Id,
now => Textures.fetch (Self.Face.texture_Details.Textures (i)));
now => Textures.fetch (Self.texture_Details.Textures (i)));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
end loop;
@@ -198,15 +212,15 @@ is
loop
the_Vertices (Index_t (i)) := (Site => Vector_3 (the_Sites (i) & 0.0),
Normal => Normal,
Coords => (Coords_and_Centroid.Coords (Index_t (i)).S * Self.Face.texture_Details.texture_Tiling.S,
Coords_and_Centroid.Coords (Index_t (i)).T * Self.Face.texture_Details.texture_Tiling.T),
Coords => (Coords_and_Centroid.Coords (Index_t (i)).S * Self.texture_Details.texture_Tiling.S,
Coords_and_Centroid.Coords (Index_t (i)).T * Self.texture_Details.texture_Tiling.T),
Shine => default_Shine);
end loop;
the_Vertices (the_Vertices'Last) := (Site => Vector_3 (Coords_and_Centroid.Centroid & 0.0),
Normal => Normal,
Coords => (S => 0.5 * Self.Face.texture_Details.texture_Tiling.S,
T => 0.5 * Self.Face.texture_Details.texture_Tiling.T),
Coords => (S => 0.5 * Self.texture_Details.texture_Tiling.S,
T => 0.5 * Self.texture_Details.texture_Tiling.T),
Shine => default_Shine);
face_Geometry := new_Geometry (Vertices => the_Vertices);