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

opengl.model.hexagon_column: Add new texturing.

Browse Source
This commit is contained in:
Rod Kay
2025-09-21 10:54:00 +10:00
parent 0f99def0cd
commit aa5ff988fa
4 changed files with 29 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -9,13 +9,13 @@ is
--- Forge
--
function new_Hexagon (Radius : in Real;
Face : in lit_textured.Face) return View
function new_Hexagon (Radius : in Real;
texture_Details : in texture_Set.Details) return View
is
Self : constant View := new Item;
begin
Self.Radius := Radius;
Self.Face := Face;
Self.texture_Details_is (texture_Details);
return Self;
end new_Hexagon;
@@ -28,84 +28,6 @@ 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.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.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.Textures (Positive (Which)) := Now;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return Self.Face.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_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
procedure animate (Self : in out Item)
is
use type texture_Set.Animation_view;
begin
if Self.Face.Animation = null
then
return;
end if;
texture_Set.animate (Self.Face.Animation.all,
Self.Face.texture_Applies);
end animate;
---------------------
--- openGL Geometries
--
@@ -140,16 +62,16 @@ is
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
for i in 1 .. Self.Face.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.Fades (Id));
the_Geometry.Fade_is (Which => Id,
Now => Self.texture_Details.Fades (Id));
the_Geometry.Texture_is (which => Id,
now => Textures.fetch (Self.Face.Textures (i)));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
the_Geometry.Texture_is (Which => Id,
Now => Textures.fetch (Self.texture_Details.Textures (i)));
the_Geometry.is_Transparent (Now => the_Geometry.Texture.is_Transparent);
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.

10
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Texture;
openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon_Column.lit_colored_textured_rounded
@@ -10,7 +11,10 @@ package openGL.Model.hexagon_Column.lit_colored_textured_rounded
-- The shaft of the column appears rounded, whereas the top and bottom appear as hexagons.
--
is
type Item is new Model.hexagon_Column.item with private;
package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
type Item is new textured_Model.textured_Item with private;
type View is access all Item'Class;
@@ -54,7 +58,7 @@ is
private
type Item is new Model.hexagon_Column.item with
type Item is new textured_Model.textured_Item with
record
upper_Face,
lower_Face : hex_Face;

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

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Texture;
openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon_Column.lit_textured_faceted
@@ -8,7 +9,9 @@ package openGL.Model.hexagon_Column.lit_textured_faceted
-- Models a lit, colored and textured column with 6 faceted shaft sides.
--
is
type Item is new Model.hexagon_Column.Item with private;
package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
type Item is new textured_Model.textured_Item with private;
type View is access all Item'Class;
@@ -48,7 +51,7 @@ is
private
type Item is new Model.hexagon_Column.item with
type Item is new textured_Model.textured_Item with
record
upper_Face,
lower_Face : hex_Face;

10
3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Texture;
openGL.Texture,
openGL.Model.texturing;
package openGL.Model.hexagon_Column.lit_textured_rounded
@@ -10,7 +11,9 @@ package openGL.Model.hexagon_Column.lit_textured_rounded
-- The shaft of the column appears rounded, whereas the top and bottom appear as hexagons.
--
is
type Item is new Model.hexagon_Column.item with private;
package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
type Item is new textured_Model.textured_Item with private;
type View is access all Item'Class;
@@ -51,11 +54,12 @@ is
private
type Item is new Model.hexagon_Column.item with
type Item is new textured_Model.textured_Item with
record
upper_Face,
lower_Face : hex_Face;
Shaft : shaft_Face;
end record;
end openGL.Model.hexagon_Column.lit_textured_rounded;