From aa5ff988fa606e25ff9c1303612129d9f6887f0e Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Sun, 21 Sep 2025 10:54:00 +1000 Subject: [PATCH] opengl.model.hexagon_column: Add new texturing. --- .../opengl-model-hexagon-lit_textured.adb | 96 ++----------------- ...on_column-lit_colored_textured_rounded.ads | 10 +- ...el-hexagon_column-lit_textured_faceted.ads | 9 +- ...el-hexagon_column-lit_textured_rounded.ads | 10 +- 4 files changed, 29 insertions(+), 96 deletions(-) diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb index bf0678e..c10a4e8 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb @@ -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. diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.ads index c53a094..1d62d88 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.ads @@ -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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.ads index 38fed3d..fb02230 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.ads @@ -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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.ads index ebc8064..a03e94d 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.ads @@ -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;