opengl.model.sphere.lit_colored_textured: Update texturing.

3-mid/opengl/source/demo/opengl-demo.adb

@@ -2,24 +2,32 @@ with
      openGL.Palette,
      openGL.Font,
      openGL.IO,
+
      openGL.Model.arrow    .colored,
      openGL.Model.billboard.textured,
+
      openGL.Model.box      .colored,
      openGL.Model.box      .textured,
      openGL.Model.box      .lit_textured,
+
      openGL.Model.capsule  .lit_textured,
      openGL.Model.grid,
+
      openGL.Model.hexagon       .lit_colored,
      openGL.Model.hexagon       .lit_textured,
      openGL.Model.hexagon_Column.lit_colored_faceted,
      openGL.Model.hexagon_Column.lit_colored_rounded,
+
      openGL.Model.line          .colored,
      openGL.Model.any,
      openGL.Model.polygon       .lit_colored,
      openGL.Model.segment_line,
+
      openGL.Model.sphere        .colored,
      openGL.Model.sphere        .lit_colored,
      openGL.Model.sphere        .lit_textured,
+     openGL.Model.sphere        .lit_colored_textured,
+
      openGL.Model.Text          .lit_colored,
      openGL.Model.terrain,
      openGL.Light,
@@ -141,6 +149,9 @@ is
       the_ball_3_Model : constant Model.sphere.lit_textured.view
         := Model.sphere.lit_textured.new_Sphere (Radius => 1.0, Image => the_Texture);
 
+      the_ball_4_Model : constant Model.sphere.lit_colored_textured.view
+        := Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, Image => the_Texture);
+
       the_billboard_Model : constant Model.billboard.textured.view
         := Model.billboard.textured.forge.new_Billboard (Size    => (1.0, 1.0),
                                                          Plane   => Billboard.xy,
@@ -269,6 +280,7 @@ is
                               the_ball_1_Model.all'Access,
                               the_ball_2_Model.all'Access,
                               the_ball_3_Model.all'Access,
+                              the_ball_4_Model.all'Access,
 
                            the_billboard_Model.all'Access,
                    the_colored_billboard_Model.all'Access,

3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.adb

@@ -186,16 +186,10 @@ is
       end set_Indices;
 
 
-      if Self.Image /= null_Asset     -- TODO: Use 'Textures' (ie name_Map_of_texture) here and in other models.
+      if Self.Image /= null_Asset
       then
-         set_Texture:
+         the_Geometry.Texture_is (Textures.fetch (Self.Image));
-         declare
+         the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
-            use Texture;
-            the_Image   : constant Image          := IO.to_Image      (Self.Image);
-            the_Texture : constant Texture.object := Forge.to_Texture ( the_Image);
-         begin
-            the_Geometry.Texture_is (the_Texture);
-         end set_Texture;
       end if;
 
       the_Geometry.is_Transparent (False);
@@ -209,8 +203,52 @@ 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;
 
 
+
+
+   ------------
+   -- 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
+      Self.Image := Now;
+   end Texture_is;
+
+
+
+   overriding
+   function texture_Count (Self : in Item) return Natural
+   is
+   begin
+      return 1;
+   end texture_Count;
+
+
 end openGL.Model.sphere.lit_colored_textured;

3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.ads

@@ -23,6 +23,24 @@ is
                                                     Fonts    : in     Font.font_id_Map_of_font) return Geometry.views;
 
 
+   ------------
+   -- Texturing
+   --
+
+   overriding
+   function  Fade       (Self : in     Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
+
+   overriding
+   procedure Fade_is    (Self : in out Item;   Which : in texture_Set.texture_Id;
+                                               Now   : in texture_Set.fade_Level);
+
+   procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
+                                               Now   : in asset_Name);
+
+   overriding
+   function  texture_Count (Self : in Item) return Natural;
+
+
 
 private
 

3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads

@@ -48,7 +48,7 @@ private
 
    type Item is new Model.sphere.item with
       record
-         Image : asset_Name := null_Asset;
+         Image : asset_Name := null_Asset;     -- Usually a mercator projection to be mapped onto the sphere.
       end record;
 
 end openGL.Model.sphere.lit_textured;