opengl.model.polygon: Add a lit and textured model.

3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb

@@ -78,7 +78,7 @@ begin
          the_Visuals (i) := new_Visual (the_Models (i));
       end loop;
 
-      the_Visuals (3).Site_is ([0.0, 0.0, -50.0]);
+      the_Visuals (4).Site_is ([0.0, 0.0, -50.0]);
 
 
       --  Main loop.

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

@@ -21,6 +21,7 @@ with
      openGL.Model.line          .colored,
      openGL.Model.any,
      openGL.Model.polygon       .lit_colored,
+     openGL.Model.polygon       .lit_textured,
      openGL.Model.segment_line,
 
      openGL.Model.sphere        .colored,
@@ -157,7 +158,7 @@ is
                                                          Plane   => Billboard.xy,
                                                          Texture => the_Texture);
 
-      the_colored_billboard_Model : constant Model.billboard.textured.view
+      the_colored_billboard_Model : constant Model.billboard.textured.view               -- TODO: Add color.
         := Model.billboard.textured.forge.new_Billboard (Size    => (1.0, 1.0),
                                                          Plane   => Billboard.xy,
                                                          Texture => the_Texture);
@@ -236,10 +237,16 @@ is
                                 Texture          => the_Texture,
                                 Texture_is_lucid => False);
 
-      the_polygon_Model : constant Model.polygon.lit_colored.view
+      the_lit_colored_polygon_Model : constant Model.polygon.lit_colored.view
         := Model.polygon.lit_colored.new_Polygon (Vertices => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
                                                   Color    => (Red, Opaque));
 
+      the_lit_textured_polygon_Model : constant Model.polygon.lit_textured.view
+        := Model.polygon.lit_textured.new_Polygon (vertex_Sites => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
+                                                   Face         => (Fades         => (1 => 0.0,         others => <>),
+                                                                    Textures      => (1 => the_Texture, others => <>),
+                                                                    texture_Count => 1));
+
       the_text_Model : constant Model.Text.lit_colored.view
         := Model.Text.lit_colored.new_Text (Text     => "Once upon a midnight dreary ...",
                                             Font     => the_font_Id,
@@ -274,7 +281,8 @@ is
       the_segment_line_Model.add_Segment     (end_Site   => [0.0, 2.0, 0.0]);
 
       return [                the_ground_Model.all'Access,
-                             the_polygon_Model.all'Access,
+                the_lit_textured_polygon_Model.all'Access,
+                 the_lit_colored_polygon_Model.all'Access,
                                 the_text_Model.all'Access,
                                the_arrow_Model.all'Access,
                               the_ball_1_Model.all'Access,

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

@@ -0,0 +1,180 @@
+with
+     openGL.Geometry.lit_textured,
+     openGL.Primitive.indexed,
+     openGL.Texture.Coordinates;
+
+
+package body openGL.Model.polygon.lit_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_polygon (vertex_Sites : in Vector_2_array;
+                         Face         : in lit_textured.Face) 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;
+
+
+
+
+   ------------------
+   --- Attributes ---
+   ------------------
+
+
+   ------------
+   -- 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 to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+                                                    Fonts    : in     Font.font_id_Map_of_font) return Geometry.views
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry,
+          Geometry.lit_textured,
+          Texture;
+
+      the_Sites : Vector_2_array renames Self.vertex_Sites (1 .. Self.vertex_Count);
+
+
+      function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
+      is
+         use Primitive,
+             texture_Set;
+
+
+         function the_Indices return Indices
+         is
+            Result : Indices (1 .. the_Sites'Length);
+         begin
+            for i in Result'Range
+            loop
+               Result (i) := Index_t (i);
+            end loop;
+
+            return Result;
+         end the_Indices;
+
+
+         the_Geometry  : constant Geometry.lit_textured.view
+           := Geometry.lit_textured.new_Geometry;
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
+
+         Id : texture_Set.texture_Id;
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         for i in 1 .. Self.Face.texture_Count
+         loop
+            Id := texture_Id (i);
+
+            the_Geometry.Fade_is (which => Id,
+                                  now   => Self.Face.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);
+         end loop;
+
+         the_Geometry.is_Transparent (True);     -- TODO: Do transparency properly.
+         the_Geometry.Model_is       (Self.all'unchecked_Access);
+
+         return the_Geometry;
+      end new_Face;
+
+
+      upper_Face : Geometry.lit_textured.view;
+
+   begin
+      --  Upper Face
+      --
+      declare
+         use openGL.Texture.Coordinates;
+
+         the_Vertices :          Geometry.lit_textured.Vertex_array (1 .. the_Sites'Length + 1);
+         the_Coords   : constant Coordinates_2D := to_Coordinates (the_Sites);
+         Centroid     :          Vector_2       := (0.0, 0.0);
+      begin
+         --- Calculate the centroid and min/max of x and y.
+         --
+         for i in the_Sites'Range
+         loop
+            Centroid := Centroid + the_Sites (i);
+         end loop;
+
+         Centroid := Centroid / Real (the_Sites'Length);
+
+         for i in the_Sites'Range
+         loop
+            the_Vertices (Index_t (i)) := (Site   => Vector_3 (the_Sites (i) & 0.0),
+                                           Normal => Normal,
+                                           Coords => the_Coords (Index_t (i)),
+                                           Shine  => default_Shine);
+         end loop;
+
+         the_Vertices (the_Vertices'Last) := (Site   => Vector_3 (Centroid & 0.0),
+                                              Normal => Normal,
+                                              Coords => (0.5, 0.5),
+                                              Shine  => default_Shine);
+
+         upper_Face := new_Face (Vertices => the_Vertices);
+      end;
+
+      return (1 => upper_Face.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.polygon.lit_textured;

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

@@ -0,0 +1,68 @@
+with
+     openGL.texture_Set,
+     openGL.Texture;
+
+
+package openGL.Model.polygon.lit_textured
+--
+--  Models a lit and textured polygon.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+
+   type Face is
+      record
+         Fades         : texture_Set.fade_Levels           (texture_Set.texture_Id)       := [others => 0.0];
+         Textures      : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset];     -- The textures to be applied to the hex.
+         texture_Count : Natural := 0;
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Polygon (vertex_Sites : in Vector_2_array;
+                         Face         : in lit_textured.Face) return View;
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   function to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+                                                    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
+
+   type Item is new Model.polygon.item with
+      record
+         vertex_Sites : Vector_2_array (1 .. 8);
+         vertex_Count : Positive;
+
+         Face       : lit_textured.Face;
+      end record;
+
+end openGL.Model.polygon.lit_textured;

3-mid/opengl/source/lean/model/opengl-model-polygon.ads

@@ -5,4 +5,10 @@ package openGL.Model.polygon
 is
    type Item is abstract new Model.item with null record;
 
+
+
+private
+
+   Normal : constant Vector_3 := [0.0, 0.0, 1.0];
+
 end openGL.Model.polygon;

3-mid/opengl/source/lean/opengl-texture_set.ads

@@ -31,6 +31,7 @@ is
 
    type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
 
+
    type Item is
       record
          Textures       : fadeable_Textures;