opengl.model.hexagon_column: Add new texturing.

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

@@ -9,13 +9,13 @@ is
    --- Forge
    --
 
-   function new_Hexagon (Radius : in Real;
+   function new_Hexagon (Radius          : in Real;
-                         Face   : in lit_textured.Face) return View
+                         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,
+            the_Geometry.Fade_is (Which => Id,
-                                  now   => Self.Face.Fades (Id));
+                                  Now   => Self.texture_Details.Fades (Id));
 
-            the_Geometry.Texture_is     (which => Id,
+            the_Geometry.Texture_is     (Which => Id,
-                                         now   => Textures.fetch (Self.Face.Textures (i)));
+                                         Now   => Textures.fetch (Self.texture_Details.Textures (i)));
-            the_Geometry.is_Transparent (now   => the_Geometry.Texture.is_Transparent);
+            the_Geometry.is_Transparent (Now   => the_Geometry.Texture.is_Transparent);
          end loop;
 
          the_Geometry.is_Transparent (True);     -- TODO: Do transparency properly.

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;

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;

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;