Add initial prototype.

3-mid/opengl/source/lean/model/opengl-model-any.adb

@@ -0,0 +1,495 @@
+with
+     openGL.Primitive.short_indexed,
+     openGL.Primitive.      indexed,
+     openGL.Primitive.long_indexed,
+
+     openGL.Geometry.lit_textured,
+     openGL.Geometry.lit_colored_textured_skinned,
+
+     openGL.Texture,
+     openGL.Palette,
+
+     openGL.IO.wavefront,
+     openGL.IO.collada,
+     openGL.IO.lat_long_Radius,
+
+     ada.Strings.fixed,
+     ada.Containers.hashed_Maps,
+
+     ada.unchecked_Deallocation;
+
+
+package body openGL.Model.any
+is
+
+   type lit_textured_skinned_Geometry_view is access all openGL.Geometry.lit_colored_textured_skinned.item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function to_Model (Model            : in asset_Name;
+                      Texture          : in asset_Name;
+                      Texture_is_lucid : in Boolean) return openGL.Model.any.item
+   is
+   begin
+      return Self : openGL.Model.any.item := (openGL.Model.item with
+                                              Model,
+                                              Texture,
+                                              Texture_is_lucid,
+                                              Geometry => null)
+      do
+         Self.Bounds.Ball := 1.0;
+      end return;
+   end to_Model;
+
+
+   function new_Model (Model            : in asset_Name;
+                       Texture          : in asset_Name;
+                       Texture_is_lucid : in Boolean) return openGL.Model.any.view
+   is
+   begin
+      return new openGL.Model.any.item' (to_Model (Model, Texture, Texture_is_lucid));
+   end new_Model;
+
+
+   --------------
+   --- Attributes
+   --
+
+   function model_Name (Self : in Item) return asset_Name
+   is
+   begin
+      return Self.Model;
+   end model_Name;
+
+
+   use openGL.IO;
+
+   function Hash (Self : in io.Vertex) return ada.Containers.Hash_type
+   is
+   begin
+      return ada.Containers.Hash_type (Self.site_Id + 3 * Self.coord_Id + 5 * Self.normal_Id + 7 * Self.weights_Id);
+   end Hash;
+
+   package io_vertex_Maps_of_gl_vertex_id is new ada.containers.Hashed_Maps (io.Vertex,
+                                                                             long_Index_t,
+                                                                             Hash,
+                                                                             "=");
+   subtype io_vertex_Map_of_gl_vertex_id is io_vertex_Maps_of_gl_vertex_id.Map;
+
+   type any_Vertex is
+      record
+         Site   : Vector_3;
+         Normal : Vector_3;
+         Coords : Coordinate_2D;
+         Shine  : Real;
+         Bones  : bone_Weights (1 .. 4);
+      end record;
+
+   type any_Vertex_array      is array (long_Index_t range <>) of aliased any_Vertex;
+   type any_Vertex_array_view is access all any_Vertex_array;
+
+   procedure deallocate is new ada.unchecked_Deallocation (any_Vertex_array,
+                                                           any_Vertex_array_view);
+
+
+   function to_lit_textured_Vertices (From : in any_Vertex_array) return Geometry.lit_textured.Vertex_large_array
+   is
+      Result : Geometry.lit_textured.Vertex_large_array (From'Range);
+   begin
+      for i in From'Range
+      loop
+         Result (i) := (Site   => From (i).Site,
+                        Normal => From (i).Normal,
+                        Coords => From (i).Coords,
+                        Shine  => From (i).Shine);
+      end loop;
+
+      return Result;
+   end to_lit_textured_Vertices;
+
+
+
+   function to_lit_textured_skinned_Vertices (From : in any_Vertex_array) return Geometry.lit_colored_textured_skinned.Vertex_array
+   is
+      use Palette;
+      Result : Geometry.lit_colored_textured_skinned.Vertex_array (From'Range);
+   begin
+      for i in From'Range
+      loop
+         Result (i) := (Site         => From (i).Site,
+                        Normal       => From (i).Normal,
+                        Coords       => From (i).Coords,
+                        Shine        => From (i).Shine,
+                        Color        => (+White, opaque_Value),
+                        bone_Ids     => [1 => Real (From (i).Bones (1).Bone),
+                                         2 => Real (From (i).Bones (2).Bone),
+                                         3 => Real (From (i).Bones (3).Bone),
+                                         4 => Real (From (i).Bones (4).Bone)],
+                        bone_Weights => [1 =>       From (i).Bones (1).Weight,
+                                         2 =>       From (i).Bones (2).Weight,
+                                         3 =>       From (i).Bones (3).Weight,
+                                         4 =>       From (i).Bones (4).Weight]);
+      end loop;
+
+      return Result;
+   end to_lit_textured_skinned_Vertices;
+
+
+
+   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 (Textures, Fonts);
+   begin
+      Self.build_GL_Geometries;
+      return [1 => Self.Geometry];
+   end to_GL_Geometries;
+
+
+
+   procedure build_GL_Geometries (Self : in out Item)
+   is
+      use Geometry;
+
+      model_Name : constant String := to_String (Self.Model);
+
+      function load_Model return io.Model
+      is
+         use ada.Strings.fixed;
+      begin
+         if    Tail (model_Name, 4) = ".obj" then   return wavefront      .to_Model (model_Name);
+         elsif Tail (model_Name, 4) = ".dae" then   return collada        .to_Model (model_Name);
+         elsif Tail (model_Name, 4) = ".tab" then   return lat_long_Radius.to_Model (model_Name);
+         else                                       raise  unsupported_model_Format with "Model => '" & model_Name & "'";
+         end if;
+      end load_Model;
+
+      the_Model     : openGL.io.Model := load_Model;
+      the_Map       : io_vertex_Map_of_gl_vertex_id;
+
+      the_Vertices  : any_Vertex_array_view := new any_Vertex_array' (1 .. 100_000 => <>);
+      vertex_Count  : openGL.long_Index_t   := 0;
+
+      tri_Count     : Index_t := 0;
+      Normals_known : Boolean := False;
+
+      --  TODO: Use one set of gl face vertices and 2 sets of indices (1 for tris and 1 for quads).
+
+   begin
+      Self.Bounds := null_Bounds;
+
+      --  1st pass: - Set our openGL face vertices.
+      --            - Build 'io vertex' to 'openGL face vertex_Id' map.
+      --
+      for f in the_Model.Faces'Range
+      loop
+         declare
+            use io_vertex_Maps_of_gl_vertex_id;
+
+            the_model_Face : io.Face renames the_Model.Faces (f);
+
+         begin
+            if    the_model_Face.Kind = Triangle
+               or the_model_Face.Kind = Quad
+            then
+               declare
+                  the_io_Vertices : constant io.Vertices := Vertices_of (the_model_Face);
+                  Cursor          :          io_vertex_Maps_of_gl_vertex_id.Cursor;
+               begin
+                  case the_model_Face.Kind
+                  is
+                     when Triangle =>   tri_Count := tri_Count + 1;
+                     when Quad     =>   tri_Count := tri_Count + 2;
+                     when Polygon  =>   null;
+                  end case;
+
+                  for v in the_io_Vertices'Range
+                  loop
+                     Cursor := the_Map.find (the_io_Vertices (v));
+
+                     if not has_Element (Cursor)
+                     then   -- We do not know about this vertex yet, so add it.
+                        vertex_Count := vertex_Count + 1;
+
+                        declare
+                           the_io_Vertex :  io.Vertex renames the_io_Vertices (v);
+                           the_gl_Vertex : any_Vertex renames the_Vertices (vertex_Count);
+                        begin
+                           the_gl_Vertex.Site := the_Model.Sites (the_io_Vertex.site_Id);
+
+                           Self.Bounds.Box  := Self.Bounds.Box or the_gl_Vertex.Site;
+                           Self.Bounds.Ball := Real'Max (Self.Bounds.Ball,
+                                                         abs (the_gl_Vertex.Site));
+
+                           if the_io_Vertex.coord_Id /= null_Id
+                           then   the_gl_Vertex.Coords := the_Model.Coords (the_io_Vertex.coord_Id);
+                           else   the_gl_Vertex.Coords := (0.0, 0.0);
+                           end if;
+
+                           if the_io_Vertex.normal_Id /= null_Id
+                           then   the_gl_Vertex.Normal := the_Model.Normals (the_io_Vertex.normal_Id);
+                                  the_gl_Vertex.Shine  := default_Shine;
+                                  normals_Known        := True;
+                           else   the_gl_Vertex.Normal := [0.0, 0.0, 0.0];
+                           end if;
+
+                           if    the_Model.Weights        /= null
+                             and the_io_Vertex.weights_Id /= null_Id
+                           then
+                              declare
+                                 the_Weights : bone_Weights renames the_Model.Weights (the_io_Vertex.weights_Id).all;
+                              begin
+                                 if the_Weights'Length > 0
+                                 then
+                                    the_gl_Vertex.Bones (1) := the_Weights (1);
+                                    --
+                                    --  nb: Only using the first 4 bones atm.
+
+                                    if the_Weights'Length >= 2
+                                    then   the_gl_Vertex.Bones (2) := the_Weights (2);
+                                    else   the_gl_Vertex.Bones (2) := (0, 0.0);
+                                    end if;
+
+                                    if the_Weights'Length >= 3
+                                    then   the_gl_Vertex.Bones (3) := the_Weights (3);
+                                    else   the_gl_Vertex.Bones (3) := (0, 0.0);
+                                    end if;
+
+                                    if the_Weights'Length >= 4
+                                    then   the_gl_Vertex.Bones (4) := the_Weights (4);
+                                    else   the_gl_Vertex.Bones (4) := (0, 0.0);
+                                    end if;
+
+                                 else
+                                    the_gl_Vertex.Bones := [1 => (0, 0.0),
+                                                            2 => (0, 0.0),
+                                                            3 => (0, 0.0),
+                                                            4 => (0, 0.0)];
+                                 end if;
+                              end;
+
+                           else
+                              the_gl_Vertex.Bones := [1 => (0, 0.0),
+                                                      2 => (0, 0.0),
+                                                      3 => (0, 0.0),
+                                                      4 => (0, 0.0)];
+                           end if;
+
+                           the_Map.insert (the_io_Vertex, vertex_Count);   --  'vertex_Count' provides the index of the current vertex.
+                        end;
+                     end if;
+
+                  end loop;
+               end;
+
+            end if;
+         end;
+      end loop;
+
+      --  We now have our gl face vertices built and mapped to each model vertex.
+
+
+      --  2nd pass: - Set the triangle faceted indices.
+      --            - Set the quad     faceted indices.
+      --
+      declare
+         tri_indices_Count :          long_Index_t := 0;
+         tri_indices_Last  : constant long_Index_t := long_Index_t (tri_Count) * 3;
+         tri_Indices       : aliased  long_Indices (1 .. tri_indices_Last);
+
+         procedure add_to_Tri (the_Vertex : in io.Vertex)
+         is
+         begin
+            tri_indices_Count               := tri_indices_Count + 1;
+            tri_Indices (tri_indices_Count) := the_Map.Element (the_Vertex);
+         end add_to_Tri;
+
+      begin
+         for f in the_Model.Faces'Range
+         loop
+            declare
+               the_model_Face  :          io.Face     renames the_Model.Faces (f);
+               the_io_Vertices : constant io.Vertices :=      Vertices_of (the_model_Face);
+            begin
+               case the_model_Face.Kind
+               is
+                  when Triangle =>
+                     for v in the_io_Vertices'Range
+                     loop
+                        add_to_Tri (the_io_Vertices (v));
+                     end loop;
+
+                  when Quad     =>
+                     add_to_Tri (the_io_Vertices (1));
+                     add_to_Tri (the_io_Vertices (2));
+                     add_to_Tri (the_io_Vertices (3));
+
+                     add_to_Tri (the_io_Vertices (3));
+                     add_to_Tri (the_io_Vertices (4));
+                     add_to_Tri (the_io_Vertices (1));
+
+                  when Polygon  =>
+                     null;
+               end case;
+            end;
+         end loop;
+
+         pragma assert (tri_indices_Count = tri_indices_Last);
+
+
+         --  Determine which geometry class is required and create the geometry.
+         --
+         if the_Model.Weights = null
+         then
+            declare
+               use Geometry.lit_textured;
+
+               my_Vertices : aliased  lit_textured.Vertex_large_array
+                 := to_lit_textured_Vertices (the_Vertices (1 .. vertex_Count));
+
+               my_Geometry : constant Geometry.lit_textured.view
+                 := lit_textured.new_Geometry;
+            begin
+               if not normals_Known
+               then
+                  set_Normals:
+                  declare
+                     type Normals_view is access all Normals;
+
+                     function get_Sites return Sites
+                     is
+                        Result : Sites := [1 .. my_Vertices'Length => <>];
+                     begin
+                        for i in Result'Range
+                        loop
+                           Result (i) := my_Vertices (long_Index_t (i)).Site;
+                        end loop;
+
+                        return Result;
+                     end get_Sites;
+
+                     the_Sites   : constant openGL.Sites := get_Sites;
+                     the_Normals :          Normals_view := Geometry.Normals_of (Primitive.Triangles,
+                                                                                 tri_Indices,
+                                                                                 the_Sites);
+                     procedure deallocate is new ada.unchecked_Deallocation (Normals, Normals_view);
+
+                  begin
+                     for i in my_Vertices'Range
+                     loop
+                        my_Vertices (i).Normal := the_Normals (Index_t (i));
+                        my_Vertices (i).Shine  := default_Shine;
+                     end loop;
+
+                     deallocate (the_Normals);
+                  end set_Normals;
+               end if;
+
+               my_Geometry.Vertices_are (now => my_Vertices);
+               Self.Geometry := Geometry.view (my_Geometry);
+            end;
+
+         else   -- Is skinned.
+            declare
+               use Geometry.lit_colored_textured_skinned;
+
+               my_Vertices : aliased constant lit_colored_textured_skinned.Vertex_array
+                 := to_lit_textured_skinned_Vertices (the_Vertices (1 .. vertex_Count));
+
+               my_Geometry : constant lit_textured_skinned_Geometry_view
+                 := lit_colored_textured_skinned.new_Geometry;
+            begin
+               my_Geometry.Vertices_are (now => my_Vertices);
+               Self.Geometry := Geometry.view (my_Geometry);
+            end;
+         end if;
+
+         deallocate (the_Vertices);
+         destroy    (the_Model);
+
+         --  Set the geometry texture.
+         --
+         if Self.Texture /= null_Asset
+         then
+            if Self.has_lucid_Texture
+            then
+               declare
+                  use Texture;
+                  the_Image   : constant lucid_Image
+                    := io.to_lucid_Image (Self.Texture);
+
+                  the_Texture : constant Texture.object
+                    := Forge.to_Texture (the_Image);
+
+               begin
+                  Self.Geometry.Texture_is (the_Texture);
+               end;
+            else
+               declare
+                  use Texture;
+                  the_Image   : constant Image          := io.to_Image (Self.Texture);
+                  the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+               begin
+                  Self.Geometry.Texture_is (the_Texture);
+               end;
+            end if;
+         end if;
+
+         --  Add any facia to the geometry.
+         --
+         if tri_Indices'Length > 0
+         then
+            if vertex_Count <= long_Index_t (short_Index_t'Last)
+            then
+               declare
+                  the_Primitive : constant Primitive.short_indexed.view
+                    := Primitive.short_indexed.new_Primitive (Primitive.Triangles,
+                                                              tri_Indices);
+               begin
+                  Self.Geometry.add (Primitive.view (the_Primitive));
+               end;
+
+            elsif vertex_Count <= long_Index_t (Index_t'Last)
+            then
+               declare
+                  the_Primitive : constant Primitive.indexed.view
+                    := Primitive.indexed.new_Primitive (primitive.Triangles,
+                                                        tri_Indices);
+               begin
+                  Self.Geometry.add (Primitive.view (the_Primitive));
+               end;
+
+            else
+               if openGL.Profile /= Desk
+               then
+                  raise Model_too_complex with "Only the 'Desk' openGL profile allows models with more than 2**16 - 1 vertices.";
+               end if;
+
+               declare
+                  the_Primitive : constant Primitive.long_indexed.view
+                    := Primitive.long_indexed.new_Primitive (primitive.Triangles,
+                                                             tri_Indices);
+               begin
+                  Self.Geometry.add (Primitive.view (the_Primitive));
+               end;
+            end if;
+         end if;
+
+
+         if Geometry_3d.Extent (Self.Bounds.Box, 3) = 0.0
+         then
+            Self.Bounds.Box.Lower (3) := Self.Bounds.Box.Lower (3) - 0.2;     -- TODO: This is dubious at best.
+         end if;
+
+         Self.Geometry.is_Transparent (now => False);
+         Self.Geometry.Label_is (to_String (Self.Model) & "-" & to_String (Self.Texture));
+      end;
+
+   end build_GL_Geometries;
+
+
+end openGL.Model.any;

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

@@ -0,0 +1,58 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.any
+--
+--  Provides a general 3D model.
+--
+--  This model is largely used by the IO importers of various model formats (ie collada, wavefront, etc).
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Model (Model            : in asset_Name;
+                       Texture          : in asset_Name;
+                       Texture_is_lucid : in Boolean) return openGL.Model.any.view;
+
+   --------------
+   --- Attributes
+   --
+
+   function model_Name (Self : in Item) return asset_Name;
+
+   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;
+   --
+   --  Raises unsupported_model_Format when the model is not a :
+   --     - wavefront       '.obj'
+   --     - collada         '.dae'
+   --     - lat_long_radius '.tab'
+
+   unsupported_model_Format : exception;
+
+
+
+private
+
+   type Item is new Model.item with
+      record
+         Model             : asset_Name := null_Asset;   -- A wavefront '.obj' or collada '.dae' file.   -- TODO: Rename to 'model_Name'.
+
+         Texture           : asset_Name := null_Asset;   -- The models texture image.
+         has_lucid_Texture : Boolean    := False;
+
+         Geometry          : openGL.Geometry.view;
+      end record;
+
+   procedure build_GL_Geometries (Self : in out Item);
+
+
+end openGL.Model.any;

3-mid/opengl/source/lean/model/opengl-model-arrow-colored.adb

@@ -0,0 +1,162 @@
+with
+     openGL.Primitive.indexed;
+
+package body openGL.Model.arrow.colored
+is
+   ---------
+   --- Forge
+   --
+
+   function to_Arrow (Color      : in openGL.Color := Palette.White;
+                      line_Width : in Real         := 1.0;
+                      End_1,
+                      End_2      : in Vector_3     := Origin_3D) return Item
+   is
+      Self : Model.arrow.colored.item;
+   begin
+      Self.Color      := Color;
+      Self.line_Width := line_Width;
+
+      Self.Vertices (1).Site := End_1;   -- Main line.
+      Self.Vertices (2).Site := End_2;   --
+
+      Self.Vertices (3).Site := End_2;   -- Side bits.
+      Self.Vertices (4).Site := End_2;   --
+
+      Self.set_side_Bits;
+
+      return Self;
+   end to_Arrow;
+
+
+   function new_Arrow (Color      : in openGL.Color := Palette.White;
+                       line_Width : in Real         := 1.0;
+                       End_1,
+                       End_2      : in Vector_3     := Origin_3D) return View
+   is
+   begin
+      return new Arrow.colored.item' (to_Arrow (Color, line_Width, End_1, End_2));
+   end new_Arrow;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use openGL.Geometry.colored;
+
+      Color         : constant openGL.rgb_Color := +Self.Color;
+      indices_Count : constant long_Index_t     := 2;
+      the_Indices   : aliased  Indices          := [1 .. indices_Count => <>];
+      the_Primitive :          Primitive.indexed.view;
+   begin
+      Geometry.free (Self.Geometry);
+      Self.Geometry := Geometry.colored.new_Geometry;
+
+      set_Colors:
+      begin
+         Self.Vertices (1).Color := (primary => Color,  Alpha => opaque_Value);
+         Self.Vertices (2).Color := (primary => Color,  Alpha => opaque_Value);
+         Self.Vertices (3).Color := (primary => Color,  Alpha => opaque_Value);
+         Self.Vertices (4).Color := (primary => Color,  Alpha => opaque_Value);
+      end set_Colors;
+
+      Self.Geometry.is_Transparent (False);
+      Self.Geometry.Vertices_are   (Self.Vertices);
+
+      -- Main line.
+      --
+      Self.Geometry.free_Primitives;
+
+      the_Indices   := [1, 2];
+      the_Primitive := Primitive.indexed.new_Primitive (Primitive.Lines, the_Indices, line_Width => Self.line_Width);
+      Self.Geometry.add (Primitive.view (the_Primitive));
+
+      -- Left bit.
+      --
+      the_Indices   := [2, 3];
+      the_Primitive := Primitive.indexed.new_Primitive (Primitive.Lines, the_Indices, line_Width => Self.line_Width);
+      Self.Geometry.add (Primitive.view (the_Primitive));
+
+      -- Right bit.
+      --
+      the_Indices   := [2, 4];
+      the_Primitive := Primitive.indexed.new_Primitive (Primitive.Lines, the_Indices, line_Width => Self.line_Width);
+      Self.Geometry.add (Primitive.view (the_Primitive));
+
+      Self.set_side_Bits;
+
+      return [1 => Self.Geometry];
+   end to_GL_Geometries;
+
+
+
+   procedure set_side_Bits (Self : in out Item)
+   is
+      use linear_Algebra_3d;
+
+      End_1 : Vector_3    renames Self.Vertices (1).Site;
+      End_2 : Vector_3    renames Self.Vertices (2).Site;
+
+      polar_Coords     : constant Geometry_2d.polar_Site := Geometry_2d.to_Polar (to_Vector_2 (End_2 - End_1));
+
+      the_Angle        : constant Radians          := polar_Coords.Angle;
+      bit_Length       : constant Real             := abs (End_2 - End_1) * 0.1;
+
+      left_bit_Offset  : constant Geometry_2d.Site := Geometry_2d.to_Site ((Angle  => the_Angle + to_Radians (135.0),
+                                                                            Extent => bit_Length));
+      right_bit_Offset : constant Geometry_2d.Site := Geometry_2d.to_Site ((Angle  => the_Angle + to_Radians (135.0 + 90.0),
+                                                                            Extent => bit_Length));
+
+      left_bit_End     : constant Vector_3         := End_2 + to_Vector_3 ( left_bit_Offset);
+      right_bit_End    : constant Vector_3         := End_2 + to_Vector_3 (right_bit_Offset);
+   begin
+      Self.Vertices (3).Site :=  left_bit_End;   -- Left bit.
+      Self.Vertices (4).Site := right_bit_End;   -- Right bit.
+   end set_side_Bits;
+
+
+
+   function End_Site (Self : in  Item;   for_End : in Integer) return Vector_3
+   is
+   begin
+      return Self.Vertices (Index_t (for_End)).Site;
+   end End_Site;
+
+
+   procedure End_Site_is (Self : in out Item;   Now     : in Vector_3;
+                                                for_End : in Integer)
+   is
+   begin
+      Self.Vertices (Index_t (for_End)).Site := Now;
+      Self.set_side_Bits;
+      Self.is_Modified := True;
+   end End_Site_is;
+
+
+
+   overriding
+   procedure modify (Self : in out Item)
+   is
+   begin
+      Self.Geometry.Vertices_are (Self.Vertices);
+      Self.set_Bounds;
+      Self.is_Modified := False;
+   end modify;
+
+
+   overriding
+   function is_Modified (Self : in Item) return Boolean
+   is
+   begin
+      return Self.is_Modified;
+   end is_Modified;
+
+
+end openGL.Model.arrow.colored;

3-mid/opengl/source/lean/model/opengl-model-arrow-colored.ads

@@ -0,0 +1,61 @@
+with
+     openGL.geometry.colored,
+     openGL.Font,
+     openGL.Palette;
+
+
+package openGL.Model.arrow.colored
+--
+--  Models a colored arrow.
+--
+is
+   type Item is new openGL.Model.arrow.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Arrow (Color      : in openGL.Color := Palette.White;
+                       line_Width : in Real         := 1.0;
+                       End_1,
+                       End_2      : in Vector_3     := Origin_3D) 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;
+
+   procedure end_Site_is (Self : in out Item;   Now     : in Vector_3;
+                                                for_End : in Integer);
+   function  end_Site    (Self : in     Item;   for_End : in Integer) return Vector_3;
+
+   overriding
+   procedure modify      (Self : in out Item);
+
+   overriding
+   function  is_Modified (Self : in     Item) return Boolean;
+
+
+
+private
+
+   type Item is new openGL.Model.arrow.item with
+      record
+         Color       :         openGL.Color;
+         line_Width  :         Real;
+
+         Vertices    : aliased Geometry.colored.Vertex_array (1 .. 4);
+         Geometry    : access  Geometry.colored.item'Class;
+
+         is_Modified :         Boolean := False;
+      end record;
+
+   procedure set_side_Bits (Self : in out Item);
+
+
+end openGL.Model.arrow.colored;

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

@@ -0,0 +1,14 @@
+package openGL.Model.arrow
+--
+--  Models an arrow.
+--
+is
+   type Item is abstract new Model.item with private;
+
+
+
+private
+
+   type Item is abstract new Model.item with null record;
+
+end openGL.Model.arrow;

3-mid/opengl/source/lean/model/opengl-model-billboard-colored.adb

@@ -0,0 +1,137 @@
+with
+     openGL.Primitive.indexed,
+     openGL.IO;
+
+
+package body openGL.Model.billboard.colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Billboard (Size    : in Size_t         := default_Size;
+                           Plane   : in billboard.Plane;
+                           Color   : in lucid_Color;
+                           Texture : in asset_Name) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.define (Size);
+
+      Self.Plane        := Plane;
+      Self.Color        := Color;
+      Self.Texture_Name := Texture;
+
+      return Self;
+   end new_Billboard;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry,
+          Geometry.colored,
+          Texture;
+
+      the_Indices  : aliased constant Indices         := (1, 2, 3, 4);
+      the_Sites    :         constant billboard.Sites := vertex_Sites (Self.Plane,
+                                                                       Self.Width,
+                                                                       Self.Height);
+
+      function new_Face (Vertices : access Geometry.colored.Vertex_array) return Geometry.colored.view
+      is
+         use openGL.Primitive;
+
+         the_Geometry  : constant Geometry.colored.view := Geometry.colored.new_Geometry;
+         the_Primitive : constant Primitive.view        := Primitive.indexed.new_Primitive (triangle_Fan,
+                                                                                            the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add (the_Primitive);
+         the_Geometry.is_Transparent;
+
+         return the_Geometry;
+      end new_Face;
+
+      Color    : constant rgba_Color  := +Self.Color;
+      the_Face : Geometry.colored.view;
+
+   begin
+      declare
+         the_Vertices : constant access Geometry.colored.Vertex_array := Self.Vertices;
+      begin
+         the_Vertices.all := Geometry.colored.Vertex_array'
+                               (1 => (site => the_Sites (1),  color => Color),
+                                2 => (site => the_Sites (2),  color => Color),
+                                3 => (site => the_Sites (3),  color => Color),
+                                4 => (site => the_Sites (4),  color => Color));
+
+         the_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.texture_Name /= null_Asset
+         then
+            Self.Texture := IO.to_Texture (Self.texture_Name);
+         end if;
+
+         if Self.Texture /= null_Object
+         then
+            the_Face.Texture_is (Self.Texture);
+         end if;
+      end;
+
+      Self.Geometry := the_Face;
+
+      return (1 => Geometry.view (the_Face));
+   end to_GL_Geometries;
+
+
+
+   procedure Color_is (Self : in out Item;   Now : in lucid_Color)
+   is
+   begin
+      Self.Color := Now;
+
+      for i in Self.Vertices'Range
+      loop
+         Self.Vertices (i).Color := +Now;
+      end loop;
+
+      Self.is_Modified := True;
+   end Color_is;
+
+
+
+   procedure Texture_Coords_are (Self : in out Item;   Now : in Coordinates)
+   is
+   begin
+      Self.texture_Coords := Now;
+      Self.needs_Rebuild  := True;
+   end Texture_Coords_are;
+
+
+
+   overriding
+   procedure modify (Self : in out Item)
+   is
+   begin
+      Self.Geometry.Vertices_are (Self.Vertices.all);
+      Self.is_Modified := False;
+   end modify;
+
+
+   overriding
+   function is_Modified (Self : in Item) return Boolean
+   is
+   begin
+      return Self.is_Modified;
+   end is_Modified;
+
+
+end openGL.Model.billboard.colored;

3-mid/opengl/source/lean/model/opengl-model-billboard-colored.ads

@@ -0,0 +1,61 @@
+with
+     openGL.Geometry.colored,
+     openGL.Texture,
+     openGL.Font,
+     openGL.Palette;
+
+
+package openGL.Model.billboard.colored
+--
+--  Models a colored, textured billboard.
+--
+is
+   type Item is new Model.billboard.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Billboard (Size    : in Size_t         := default_Size;
+                           Plane   : in billboard.Plane;
+                           Color   : in lucid_Color;
+                           Texture : in asset_Name) 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;
+
+   procedure Color_is           (Self : in out Item;   Now : in lucid_Color);
+   procedure Texture_Coords_are (Self : in out Item;   Now : in Coordinates);
+
+   overriding
+   procedure modify      (Self : in out Item);
+
+   overriding
+   function  is_Modified (Self : in     Item) return Boolean;
+
+
+
+private
+
+   type Item is new Model.billboard.item with
+      record
+         Color          : lucid_Color           := (Palette.White, Opaque);
+
+         texture_Name   : asset_Name            := null_Asset;
+         Texture        : openGL.Texture.Object := openGL.Texture.null_Object;      -- The texture to be applied to the billboard face.
+         texture_Coords : Coordinates           := ((0.0, 0.0), (1.0, 0.0), (1.0, 1.0), (0.0, 1.0));
+
+         is_Modified    : Boolean               := False;
+
+         Vertices : access Geometry.colored.Vertex_array := new geometry.colored.Vertex_array (1 .. 4);
+         Geometry : access Geometry.colored.item'Class;
+      end record;
+
+end openGL.Model.billboard.colored;

3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.adb

@@ -0,0 +1,139 @@
+with
+     openGL.Primitive.indexed,
+     openGL.IO;
+
+
+package body openGL.Model.billboard.colored_textured
+is
+   type Geometry_view is access all Geometry.colored_textured.item'Class;
+
+   ---------
+   --- Forge
+   --
+
+   function new_Billboard (Size    : in Size_t         := default_Size;
+                           Plane   : in billboard.Plane;
+                           Color   : in lucid_Color;
+                           Texture : in asset_Name) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.define (Size);
+
+      Self.Plane        := Plane;
+      Self.Color        := Color;
+      Self.Texture_Name := Texture;
+
+      return Self;
+   end new_Billboard;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry,
+          Geometry.colored_textured,
+          Texture;
+
+      the_Indices  : aliased constant Indices         := [1, 2, 3, 4];
+      the_Sites    :         constant billboard.Sites := vertex_Sites (Self.Plane,
+                                                                       Self.Width,
+                                                                       Self.Height);
+
+      function new_Face (Vertices : access Geometry.colored_textured.Vertex_array) return Geometry_view
+      is
+         use openGL.Primitive;
+
+         the_Geometry  : constant Geometry_view  := Geometry.colored_textured.new_Geometry;
+         the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
+                                                                                     the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add (the_Primitive);
+         the_Geometry.is_Transparent;
+
+         return the_Geometry;
+      end new_Face;
+
+      Color    : constant rgba_Color := +Self.Color;
+      the_Face : Geometry_view;
+
+   begin
+      declare
+         the_Vertices : constant access Geometry.colored_textured.Vertex_array := Self.Vertices;
+      begin
+         the_Vertices.all := Geometry.colored_textured.Vertex_array'
+                               (1 => (site => the_Sites (1),    color => Color,  coords => (Self.texture_Coords (1))),
+                                2 => (site => the_Sites (2),    color => Color,  coords => (Self.texture_Coords (2))),
+                                3 => (site => the_Sites (3),    color => Color,  coords => (Self.texture_Coords (3))),
+                                4 => (site => the_Sites (4),    color => Color,  coords => (Self.texture_Coords (4))));
+
+         the_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.texture_Name /= null_Asset
+         then
+            Self.Texture := IO.to_Texture (Self.texture_Name);
+         end if;
+
+         if Self.Texture /= null_Object
+         then
+            the_Face.Texture_is (Self.Texture);
+         end if;
+      end;
+
+      Self.Geometry := the_Face;
+
+      return [1 => Geometry.view (the_Face)];
+   end to_GL_Geometries;
+
+
+
+   procedure Color_is (Self : in out Item;   Now : in lucid_Color)
+   is
+   begin
+      Self.Color := Now;
+
+      for i in Self.Vertices'Range
+      loop
+         Self.Vertices (i).Color := +Now;
+      end loop;
+
+      Self.is_Modified := True;
+   end Color_is;
+
+
+
+   procedure Texture_Coords_are (Self : in out Item;   Now : in Coordinates)
+   is
+   begin
+      Self.texture_Coords := Now;
+      Self.needs_Rebuild  := True;
+   end Texture_Coords_are;
+
+
+
+   overriding
+   procedure modify (Self : in out Item)
+   is
+   begin
+      Self.Geometry.Vertices_are (Self.Vertices.all);
+      Self.is_Modified := False;
+   end modify;
+
+
+   overriding
+   function is_Modified (Self : in Item) return Boolean
+   is
+   begin
+      return Self.is_Modified;
+   end is_Modified;
+
+
+end openGL.Model.billboard.colored_textured;

3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads

@@ -0,0 +1,61 @@
+with
+     openGL.Geometry.colored_textured,
+     openGL.Texture,
+     openGL.Font,
+     openGL.Palette;
+
+
+package openGL.Model.billboard.colored_textured
+--
+--  Models a colored, textured billboard.
+--
+is
+   type Item is new Model.billboard.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Billboard (Size    : in Size_t         := default_Size;
+                           Plane   : in billboard.Plane;
+                           Color   : in lucid_Color;
+                           Texture : in asset_Name) 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;
+
+   procedure Color_is           (Self : in out Item;   Now : in lucid_Color);
+   procedure Texture_Coords_are (Self : in out Item;   Now : in Coordinates);
+
+   overriding
+   procedure modify      (Self : in out Item);
+
+   overriding
+   function  is_Modified (Self : in     Item) return Boolean;
+
+
+
+private
+
+   type Item is new Model.billboard.item with
+      record
+         Color          : lucid_Color           := (Palette.White, Opaque);
+
+         texture_Name   : asset_Name            := null_Asset;
+         Texture        : openGL.Texture.Object := openGL.Texture.null_Object;      -- The texture to be applied to the billboard face.
+         texture_Coords : Coordinates           := [(0.0, 0.0), (1.0, 0.0), (1.0, 1.0), (0.0, 1.0)];
+
+         is_Modified    : Boolean               := False;
+
+         Vertices : Geometry.colored_textured.Vertex_array_view := new geometry.colored_textured.Vertex_array (1 .. 4);
+         Geometry : access Geometry.colored_textured.item'Class;
+      end record;
+
+end openGL.Model.billboard.colored_textured;

3-mid/opengl/source/lean/model/opengl-model-billboard-textured.adb

@@ -0,0 +1,198 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.textured,
+     openGL.io,
+
+     ada.unchecked_Deallocation;
+
+
+package body openGL.Model.billboard.textured
+is
+   ---------
+   --- Forge
+   --
+
+   package body Forge
+   is
+      function new_Billboard (Size    : in Size_t         := default_Size;
+                              Plane   : in billboard.Plane;
+                              Texture : in asset_Name;
+                              Lucid   : in Boolean        := False) return View
+      is
+         Self : constant View := new Item (Lucid);
+      begin
+         Self.Plane        := Plane;
+         Self.Texture_Name := Texture;
+         Self.define (Size);
+
+         return Self;
+      end new_Billboard;
+   end Forge;
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   function to_GL_Geometries (Self : access Item;   Textures : access openGL.Texture.name_Map_of_texture'Class;
+                                                    Fonts    : in     Font.font_id_Map_of_font) return Geometry.views
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry,
+          Geometry.textured,
+          openGL.Texture;
+
+      the_Indices  : aliased constant Indices         := [1, 2, 3, 4];
+      the_Sites    :         constant billboard.Sites := vertex_Sites (Self.Plane,
+                                                                       Self.Width,
+                                                                       Self.Height);
+
+      function new_Face (Vertices : in Geometry.textured.Vertex_array) return Geometry.textured.view
+      is
+         use Primitive;
+
+         the_Geometry  : constant Geometry.textured.view := Geometry.textured.new_Geometry;
+         the_Primitive : constant Primitive.view         := Primitive.indexed.new_Primitive (triangle_Fan,
+                                                                                             the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add (the_Primitive);
+         the_Geometry.is_Transparent;
+
+         return the_Geometry;
+      end new_Face;
+
+      the_Face : Geometry.textured.view;
+
+   begin
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (site => the_Sites (1),  coords => Self.texture_Coords (1)),
+               2 => (site => the_Sites (2),  coords => Self.texture_Coords (2)),
+               3 => (site => the_Sites (3),  coords => Self.texture_Coords (3)),
+               4 => (site => the_Sites (4),  coords => Self.texture_Coords (4))];
+      begin
+         the_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.texture_Name /= null_Asset
+         then
+            Self.Texture := IO.to_Texture (Self.texture_Name);
+         end if;
+
+         if Self.Lucid
+         then
+            if Self.lucid_Image /= null
+            then
+               if Self.Texture /= null_Object
+               then
+                  set_Image (Self.Texture, Self.lucid_Image.all);
+               else
+                  Self.Texture := openGL.Texture.Forge.to_Texture (Self.lucid_Image.all);
+               end if;
+            end if;
+         else
+            if Self.Image /= null
+            then
+               if Self.Texture /= null_Object
+               then
+                  Self.Texture.set_Image (Self.Image.all);
+               else
+                  Self.Texture := openGL.Texture.Forge.to_Texture (Self.Image.all);
+               end if;
+            end if;
+         end if;
+
+         if Self.Texture /= null_Object
+         then
+            the_Face.Texture_is (Self.Texture);
+         end if;
+      end;
+
+      return [1 => the_Face.all'Access];
+   end to_GL_Geometries;
+
+
+
+   procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
+   is
+   begin
+      Self.Texture := Now;
+   end Texture_is;
+
+
+   function Texture (Self : in Item) return openGL.Texture.Object
+   is
+   begin
+      return Self.Texture;
+   end Texture;
+
+
+
+   procedure Texture_Coords_are (Self : in out Item;   Now : in Coordinates)
+   is
+   begin
+      Self.texture_Coords := Now;
+      Self.needs_Rebuild  := True;
+   end Texture_Coords_are;
+
+
+
+   procedure Size_is (Self : in out Item;   Now : in Size_t)
+   is
+   begin
+      Self.Size          := Now;
+      Self.needs_Rebuild := True;
+   end Size_is;
+
+
+
+   procedure Image_is (Self : in out Item;   Now : in Image)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Image,
+                                                              Image_view);
+   begin
+      if Self.Image = null
+      then
+         Self.Image := new Image' (Now);
+
+      elsif Self.Image'Length (1) = Now'Length (1)
+        and Self.Image'Length (2) = Now'Length (2)
+      then
+         Self.Image.all := Now;
+
+      else
+         deallocate (Self.Image);
+         Self.Image := new Image' (Now);
+      end if;
+
+      Self.needs_Rebuild := True;
+   end Image_is;
+
+
+
+   procedure Image_is (Self : in out Item;   Now : in lucid_Image)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (lucid_Image,
+                                                              lucid_Image_view);
+   begin
+      if Self.lucid_Image = null
+      then
+         Self.lucid_Image := new lucid_Image' (Now);
+
+      elsif Self.lucid_Image'Length (1) = Now'Length (1)
+        and Self.lucid_Image'Length (2) = Now'Length (2)
+      then
+         Self.lucid_Image.all := Now;
+
+      else
+         deallocate (Self.lucid_Image);
+         Self.lucid_Image := new lucid_Image' (Now);
+      end if;
+
+      Self.needs_Rebuild := True;
+   end Image_is;
+
+
+end openGL.Model.billboard.textured;

3-mid/opengl/source/lean/model/opengl-model-billboard-textured.ads

@@ -0,0 +1,64 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.billboard.textured
+--
+--  Models a textured billboard.
+--
+is
+   type Item (Lucid : Boolean) is new Model.billboard.item with private;
+   type View                   is access all Item'Class;
+
+   type       Image_view  is access       Image;
+   type lucid_Image_view  is access lucid_Image;
+
+
+   ---------
+   --- Forge
+   --
+
+   package Forge
+   is
+      function new_Billboard (Size    : in Size_t         := default_Size;
+                              Plane   : in billboard.Plane;
+                              Texture : in asset_Name;
+                              Lucid   : in Boolean        := False) return View;
+   end Forge;
+
+
+   --------------
+   --- 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;
+
+   procedure Texture_is         (Self : in out Item;   Now : in Texture.Object);
+   function  Texture            (Self : in     Item)     return Texture.Object;
+
+   procedure Texture_Coords_are (Self : in out Item;   Now : in Coordinates);
+   procedure Size_is            (Self : in out Item;   Now : in Size_t);
+
+   procedure Image_is           (Self : in out Item;   Now : in       Image);
+   procedure Image_is           (Self : in out Item;   Now : in lucid_Image);
+
+
+
+private
+
+   type Item (Lucid : Boolean) is new Model.billboard.item with
+      record
+         texture_Name   : asset_Name            := null_Asset;
+         Texture        : openGL.Texture.Object := openGL.Texture.null_Object;      -- The texture to be applied to the billboard face.
+         texture_Coords : Coordinates           := [(0.0, 0.0), (1.0, 0.0), (1.0, 1.0), (0.0, 1.0)];     -- TODO: Should be constant/static ?
+
+         case Lucid is
+            when True  => lucid_Image : lucid_Image_view;
+            when False =>       Image :       Image_view;
+         end case;
+      end record;
+
+end openGL.Model.billboard.textured;

3-mid/opengl/source/lean/model/opengl-model-billboard.adb

@@ -0,0 +1,67 @@
+package body openGL.Model.billboard
+is
+
+   ---------
+   --- Forge
+   --
+
+   procedure define (Self : out Item;   Size : Size_t := default_Size)
+   is
+   begin
+      Self.Size := Size;
+   end define;
+
+
+
+   --------------
+   --- Attributes
+   --
+
+   function Size (Self : in Item) return Size_t
+   is
+   begin
+      return Self.Size;
+   end Size;
+
+
+
+   function Width (Self : in Item) return Real
+   is
+   begin
+      return Self.Size.Width;
+   end Width;
+
+
+
+   function Height (Self : in Item) return Real
+   is
+   begin
+      return Self.Size.Height;
+   end Height;
+
+
+
+   function vertex_Sites (for_Plane     : in Plane;
+                          Width, Height : in Real) return Sites
+   is
+      half_Width  : constant Real := Width  / 2.0;
+      half_Height : constant Real := Height / 2.0;
+
+      the_Sites   : constant array (Plane) of Sites := [xy => [[-half_Width, -half_Height,         0.0],
+                                                               [ half_Width, -half_Height,         0.0],
+                                                               [ half_Width,  half_Height,         0.0],
+                                                               [-half_Width,  half_Height,         0.0]],
+                                                        xz => [[-half_Width,          0.0,         1.0],
+                                                               [ half_Width,          0.0,         1.0],
+                                                               [ half_Width,          0.0,        -1.0],
+                                                               [-half_Width,          0.0,        -1.0]],
+                                                        yz => [[        0.0, -half_Height,  half_Width],
+                                                               [        0.0, -half_Height, -half_Width],
+                                                               [        0.0,  half_Height, -half_Width],
+                                                               [        0.0,  half_Height,  half_Width]]];
+   begin
+      return the_Sites (for_Plane);
+   end vertex_Sites;
+
+
+end openGL.Model.billboard;

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

@@ -0,0 +1,57 @@
+package openGL.Model.billboard
+--
+--  Models a rectangle capable of displaying an image.
+--
+is
+   type Item   is abstract new Model.item with private;
+
+   type Plane  is (xy, xz, yz);
+
+   type Size_t is
+      record
+         Width  : Real;
+         Height : Real;
+      end record;
+
+   type Coordinates is array (1 .. 4) of Coordinate_2D;
+
+
+   ---------
+   --- Forge
+   --
+
+   default_Size : constant Size_t;
+
+   procedure define (Self : out Item;   Size : Size_t := default_Size);
+
+
+   --------------
+   --- Attributes
+   --
+
+   function Size   (Self : in Item) return Size_t;
+   function Width  (Self : in Item) return Real;
+   function Height (Self : in Item) return Real;
+
+
+
+private
+
+   type Item is abstract new Model.item with
+      record
+         Plane  : billboard.Plane := xy;
+         Size   : Size_t;
+      end record;
+
+
+   subtype site_Id is Index_t range 1 .. 4;
+   subtype Sites   is Vector_3_array (site_Id'Range);
+
+   function vertex_Sites (for_Plane     : in Plane;
+                          Width, Height : in Real) return Sites;
+
+   Normal       : constant Vector_3 := [0.0,  0.0,  1.0];
+   default_Size : constant Size_t   := (Width  => 1.0,
+                                        Height => 1.0);
+
+end openGL.Model.billboard;

3-mid/opengl/source/lean/model/opengl-model-box-colored.adb

@@ -0,0 +1,145 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.colored;
+
+
+package body openGL.Model.box.colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in colored.Faces) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Faces := Faces;
+      Self.Size  := Size;
+
+      return Self;
+   end new_Box;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+      use Geometry;
+
+      the_Sites    :         constant box.Sites := Self.vertex_Sites;
+      the_Indices  : aliased constant Indices   := [1, 2, 3, 4];
+
+
+      function new_Face (Vertices : access Geometry.colored.Vertex_array) return Geometry.colored.view
+      is
+         use Geometry.colored,
+             Primitive;
+
+         the_Geometry  : constant Geometry.colored .view := Geometry.colored.new_Geometry;
+         the_Primitive : constant Primitive.indexed.view := Primitive.indexed.new_Primitive (triangle_Fan,
+                                                                                             the_Indices);
+      begin
+         the_Geometry.Vertices_are   (Vertices.all);
+         the_Geometry.add            (Primitive.view (the_Primitive));
+         the_Geometry.is_Transparent (now => False);
+
+         return the_Geometry;
+      end new_Face;
+
+
+      front_Face : Geometry.colored.view;
+      rear_Face  : Geometry.colored.view;
+      upper_Face : Geometry.colored.view;
+      lower_Face : Geometry.colored.view;
+      left_Face  : Geometry.colored.view;
+      right_Face : Geometry.colored.view;
+
+   begin
+      --  Front
+      --
+      declare
+         the_Vertices : aliased Geometry.colored.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Lower_Front),  Color => +Self.Faces (Front).Colors (1)),
+               2 => (Site => the_Sites (Right_Lower_Front),  Color => +Self.Faces (Front).Colors (2)),
+               3 => (Site => the_Sites (Right_Upper_Front),  Color => +Self.Faces (Front).Colors (3)),
+               4 => (Site => the_Sites ( Left_Upper_Front),  Color => +Self.Faces (Front).Colors (4))];
+      begin
+         front_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+      --  Rear
+      --
+      declare
+         the_Vertices : aliased Geometry.colored.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Rear),   Color => +Self.Faces (Rear).Colors (1)),
+               2 => (Site => the_Sites ( Left_Lower_Rear),   Color => +Self.Faces (Rear).Colors (2)),
+               3 => (Site => the_Sites ( Left_Upper_Rear),   Color => +Self.Faces (Rear).Colors (3)),
+               4 => (Site => the_Sites (Right_Upper_Rear),   Color => +Self.Faces (Rear).Colors (4))];
+      begin
+         rear_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : aliased Geometry.colored.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Upper_Front),  Color => +Self.Faces (Upper).Colors (1)),
+               2 => (Site => the_Sites (Right_Upper_Front),  Color => +Self.Faces (Upper).Colors (2)),
+               3 => (Site => the_Sites (Right_Upper_Rear),   Color => +Self.Faces (Upper).Colors (3)),
+               4 => (Site => the_Sites ( Left_Upper_Rear),   Color => +Self.Faces (Upper).Colors (4))];
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : aliased Geometry.colored.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),  Color => +Self.Faces (Lower).Colors (1)),
+               2 => (Site => the_Sites ( Left_Lower_Front),  Color => +Self.Faces (Lower).Colors (2)),
+               3 => (Site => the_Sites ( Left_Lower_Rear),   Color => +Self.Faces (Lower).Colors (3)),
+               4 => (Site => the_Sites (Right_Lower_Rear),   Color => +Self.Faces (Lower).Colors (4))];
+      begin
+         lower_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+      --  Left
+      --
+      declare
+         the_Vertices : aliased Geometry.colored.Vertex_array
+           := [1 => (Site => the_Sites (Left_Lower_Rear),    Color => +Self.Faces (Left).Colors (1)),
+               2 => (Site => the_Sites (Left_Lower_Front),   Color => +Self.Faces (Left).Colors (2)),
+               3 => (Site => the_Sites (Left_Upper_Front),   Color => +Self.Faces (Left).Colors (3)),
+               4 => (Site => the_Sites (Left_Upper_Rear),    Color => +Self.Faces (Left).Colors (4))];
+      begin
+         left_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+      --  Right
+      --
+      declare
+         the_Vertices : aliased Geometry.colored.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),  Color => +Self.Faces (Right).Colors (1)),
+               2 => (Site => the_Sites (Right_Lower_Rear),   Color => +Self.Faces (Right).Colors (2)),
+               3 => (Site => the_Sites (Right_Upper_Rear),   Color => +Self.Faces (Right).Colors (3)),
+               4 => (Site => the_Sites (Right_Upper_Front),  Color => +Self.Faces (Right).Colors (4))];
+      begin
+         right_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+      return [Geometry.view (front_Face),
+              Geometry.view ( rear_Face),
+              Geometry.view (upper_Face),
+              Geometry.view (lower_Face),
+              Geometry.view ( left_Face),
+              Geometry.view (right_Face)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.box.colored;

3-mid/opengl/source/lean/model/opengl-model-box-colored.ads

@@ -0,0 +1,49 @@
+with
+     openGL.Font,
+     openGL.Geometry;
+
+
+package openGL.Model.box.colored
+--
+--  Models a colored box.
+--
+--  Each face may be separately colored via each of its 4 vertices.
+--
+is
+   type Item is new Model.box.item with private;
+   type View is access all Item'Class;
+
+
+   type Face is
+      record
+         Colors : lucid_Colors (1 .. 4);     -- The color of each of the faces 4 vertices.
+      end record;
+
+   type Faces is array (Side) of Face;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in colored.Faces) 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;
+
+
+private
+
+   type Item is new Model.box.item with
+      record
+         Faces : colored.Faces;
+      end record;
+
+end openGL.Model.box.colored;

3-mid/opengl/source/lean/model/opengl-model-box-lit_colored.adb

@@ -0,0 +1,151 @@
+with
+     openGL.Geometry.lit_colored,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.box.lit_colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in lit_colored.Faces) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Faces := Faces;
+      Self.Size  := Size;
+
+      return Self;
+   end new_Box;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts, Textures);
+
+      use Geometry.lit_colored;
+
+      the_Sites    :         constant box.Sites := Self.vertex_Sites;
+      the_Indices  : aliased constant Indices   := (1, 2, 3, 4);
+
+
+      function new_Face (Vertices : access geometry.lit_colored.Vertex_array) return Geometry.lit_colored.view
+      is
+         use openGL.Primitive;
+
+         the_Geometry  : constant Geometry.lit_colored.view := Geometry.lit_colored.new_Geometry;
+         the_Primitive : constant Primitive.view            := Primitive.indexed.new_Primitive
+                                                                 (triangle_Fan,
+                                                                  the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_Face;
+
+
+      front_Face : Geometry.lit_colored.view;
+      rear_Face  : Geometry.lit_colored.view;
+      upper_Face : Geometry.lit_colored.view;
+      lower_Face : Geometry.lit_colored.view;
+      left_Face  : Geometry.lit_colored.view;
+      right_Face : Geometry.lit_colored.view;
+
+   begin
+      --  Front
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := (1 => (Site => the_Sites ( Left_Lower_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (1),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Lower_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (2),   Shine => default_Shine),
+               3 => (Site => the_Sites (right_upper_front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (3),   Shine => default_Shine),
+               4 => (Site => the_Sites ( Left_Upper_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (4),   Shine => default_Shine));
+      begin
+         front_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+
+      --  Rear
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := (1 => (Site => the_Sites (Right_Lower_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (1),   Shine => default_Shine),
+               2 => (Site => the_Sites ( Left_Lower_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (2),   Shine => default_Shine),
+               3 => (Site => the_Sites ( Left_Upper_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (3),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Upper_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (4),   Shine => default_Shine));
+      begin
+         rear_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+
+      --  Upper
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := (1 => (Site => the_Sites ( Left_Upper_Front),   Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (1),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Upper_Front),   Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (2),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (3),   Shine => default_Shine),
+               4 => (Site => the_Sites ( Left_Upper_Rear),    Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (4),   Shine => default_Shine));
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+
+      --  Lower
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := (1 => (Site => the_Sites (Right_Lower_Front),   Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (1),   Shine => default_Shine),
+               2 => (Site => the_Sites ( Left_Lower_Front),   Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (2),   Shine => default_Shine),
+               3 => (Site => the_Sites ( Left_Lower_Rear),    Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (3),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Lower_Rear),    Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (4),   Shine => default_Shine));
+      begin
+         lower_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+
+      --  Left
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := (1 => (Site => the_Sites (Left_Lower_Rear),    Normal => left_Normal,   Color => +Self.Faces (Left).Colors (1),   Shine => default_Shine),
+               2 => (Site => the_Sites (Left_Lower_Front),   Normal => left_Normal,   Color => +Self.Faces (Left).Colors (2),   Shine => default_Shine),
+               3 => (Site => the_Sites (Left_Upper_Front),   Normal => left_Normal,   Color => +Self.Faces (Left).Colors (3),   Shine => default_Shine),
+               4 => (Site => the_Sites (Left_Upper_Rear),    Normal => left_Normal,   Color => +Self.Faces (Left).Colors (4),   Shine => default_Shine));
+      begin
+         left_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+
+      --  Right
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := (1 => (Site => the_Sites (Right_Lower_Front),   Normal => right_Normal,   Color => +Self.Faces (Right).Colors (1),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Lower_Rear),    Normal => right_Normal,   Color => +Self.Faces (Right).Colors (2),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Normal => right_Normal,   Color => +Self.Faces (Right).Colors (3),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Upper_Front),   Normal => right_Normal,   Color => +Self.Faces (Right).Colors (4),   Shine => default_Shine));
+      begin
+         right_Face := new_Face (Vertices => the_Vertices'Access);
+      end;
+
+
+      return (1 => front_Face.all'Access,
+              2 =>  rear_Face.all'Access,
+              3 => upper_Face.all'Access,
+              4 => lower_Face.all'Access,
+              5 =>  left_Face.all'Access,
+              6 => right_Face.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.box.lit_colored;

3-mid/opengl/source/lean/model/opengl-model-box-lit_colored.ads

@@ -0,0 +1,50 @@
+with
+     openGL.Geometry,
+     openGL.Font,
+     openGL.Texture;
+
+
+package openGL.Model.Box.lit_colored
+--
+--  Models a lit and colored box.
+--
+--  Each face may be separately colored via each of its 4 vertices.
+--
+is
+   type Item is new Model.box.item with private;
+   type View is access all Item'Class;
+
+
+   type Face is
+      record
+         Colors : lucid_Colors (1 .. 4);      -- The color of each faces 4 vertices.
+      end record;
+
+   type Faces is array (Side) of Face;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in lit_colored.Faces) 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;
+
+
+private
+
+   type Item is new Model.box.item with
+      record
+         Faces : lit_colored.Faces;
+      end record;
+
+end openGL.Model.Box.lit_colored;

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

@@ -0,0 +1,192 @@
+with
+     openGL.Geometry.lit_colored_textured,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.box.lit_colored_textured
+is
+   type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in lit_colored_textured.Faces) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Faces := Faces;
+      Self.Size  := Size;
+
+      return Self;
+   end new_Box;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.lit_colored_textured,
+          Texture;
+
+      the_Sites    :         constant box.Sites := Self.vertex_Sites;
+      the_Indices  : aliased constant Indices   := [1, 2, 3, 4];
+
+
+      function new_Face (Vertices : access geometry.lit_colored_textured.Vertex_array) return Geometry_view
+      is
+         use openGL.Primitive;
+
+         the_Geometry  : constant Geometry_view  := Geometry.lit_colored_textured.new_Geometry
+                                                      (texture_is_Alpha => False);
+         the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive
+                                                      (triangle_Fan,
+                                                       the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_Face;
+
+
+      front_Face : Geometry_view;
+      rear_Face  : Geometry_view;
+      upper_Face : Geometry_view;
+      lower_Face : Geometry_view;
+      left_Face  : Geometry_view;
+      right_Face : Geometry_view;
+
+   begin
+      --  Front
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Lower_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Lower_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (right_upper_front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites ( Left_Upper_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         front_Face := new_Face (Vertices => the_Vertices'Access);
+
+         if Self.Faces (Front).texture_Name /= null_Asset
+         then
+            front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
+            front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Rear
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites ( Left_Lower_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites ( Left_Upper_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Upper_Rear),   Normal => rear_Normal,   Color => +Self.Faces (Rear).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         rear_Face := new_Face (Vertices => the_Vertices'Access);
+
+         if Self.Faces (Rear).texture_Name /= null_Asset
+         then
+            rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
+            rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Upper
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Upper_Front),   Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Upper_Front),   Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites ( Left_Upper_Rear),    Normal => upper_Normal,   Color => +Self.Faces (Upper).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices'Access);
+
+         if Self.Faces (Upper).texture_Name /= null_Asset
+         then
+            upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
+            upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Lower
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),   Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites ( Left_Lower_Front),   Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites ( Left_Lower_Rear),    Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Lower_Rear),    Normal => lower_Normal,   Color => +Self.Faces (Lower).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         lower_Face := new_Face (Vertices => the_Vertices'Access);
+
+         if Self.Faces (Lower).texture_Name /= null_Asset
+         then
+            lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
+            lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Left
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := [1 => (Site => the_Sites (Left_Lower_Rear),    Normal => left_Normal,   Color => +Self.Faces (Left).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Left_Lower_Front),   Normal => left_Normal,   Color => +Self.Faces (Left).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Left_Upper_Front),   Normal => left_Normal,   Color => +Self.Faces (Left).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Left_Upper_Rear),    Normal => left_Normal,   Color => +Self.Faces (Left).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         left_Face := new_Face (Vertices => the_Vertices'Access);
+
+         if Self.Faces (Left).texture_Name /= null_Asset
+         then
+            left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
+            left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Right
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),   Normal => right_Normal,   Color => +Self.Faces (Right).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Lower_Rear),    Normal => right_Normal,   Color => +Self.Faces (Right).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Normal => right_Normal,   Color => +Self.Faces (Right).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Upper_Front),   Normal => right_Normal,   Color => +Self.Faces (Right).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         right_Face := new_Face (Vertices => the_Vertices'Access);
+
+         if Self.Faces (Right).texture_Name /= null_Asset
+         then
+            right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
+            right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      return [1 => front_Face.all'Access,
+              2 =>  rear_Face.all'Access,
+              3 => upper_Face.all'Access,
+              4 => lower_Face.all'Access,
+              5 =>  left_Face.all'Access,
+              6 => right_Face.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.box.lit_colored_textured;

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

@@ -0,0 +1,52 @@
+with
+     openGL.Geometry,
+     openGL.Font,
+     openGL.Texture;
+
+
+package openGL.Model.Box.lit_colored_textured
+--
+--  Models a lit, colored and textured box.
+--
+--  Each face may be separately colored via each of its 4 vertices.
+--  Each face may have a separate texture.
+--
+is
+   type Item is new Model.box.item with private;
+   type View is access all Item'Class;
+
+
+   type Face is
+      record
+         Colors       : lucid_Colors (1 .. 4);      -- The color of each faces 4 vertices.
+         texture_Name : asset_Name := null_Asset;   -- The texture applied to the face.
+      end record;
+
+   type Faces is array (Side) of Face;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in lit_colored_textured.Faces) 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;
+
+
+private
+
+   type Item is new Model.box.item with
+      record
+         Faces : lit_colored_textured.Faces;
+      end record;
+
+end openGL.Model.Box.lit_colored_textured;

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

@@ -0,0 +1,187 @@
+with
+     openGL.Geometry.lit_textured,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.box.lit_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in lit_textured.Faces) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Faces := Faces;
+      Self.Size  := Size;
+
+      return Self;
+   end new_Box;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.lit_textured;
+
+      the_Sites    :         constant box.Sites := Self.vertex_Sites;
+      the_Indices  : aliased constant Indices   := [1, 2, 3, 4];
+
+
+      function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
+      is
+         use openGL.Primitive;
+
+         the_Geometry  : constant Geometry.lit_textured.view  := Geometry.lit_textured.new_Geometry;
+         the_Primitive : constant Primitive.view              := Primitive.indexed.new_Primitive
+                                                                   (triangle_Fan,
+                                                                    the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_Face;
+
+
+      front_Face : Geometry.lit_textured.view;
+      rear_Face  : Geometry.lit_textured.view;
+      upper_Face : Geometry.lit_textured.view;
+      lower_Face : Geometry.lit_textured.view;
+      left_Face  : Geometry.lit_textured.view;
+      right_Face : Geometry.lit_textured.view;
+
+   begin
+      --  Front
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Lower_Front),   Normal => front_Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Lower_Front),   Normal => front_Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (right_upper_front),   Normal => front_Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites ( Left_Upper_Front),   Normal => front_Normal,   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         front_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Front).texture_Name /= null_Asset
+         then
+            front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
+            front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Rear
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Rear),   Normal => rear_Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites ( Left_Lower_Rear),   Normal => rear_Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites ( Left_Upper_Rear),   Normal => rear_Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Upper_Rear),   Normal => rear_Normal,   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         rear_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Rear).texture_Name /= null_Asset
+         then
+            rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
+            rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Upper
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Upper_Front),   Normal => upper_Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Upper_Front),   Normal => upper_Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Normal => upper_Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites ( Left_Upper_Rear),    Normal => upper_Normal,   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Upper).texture_Name /= null_Asset
+         then
+            upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
+            upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Lower
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),   Normal => lower_Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites ( Left_Lower_Front),   Normal => lower_Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites ( Left_Lower_Rear),    Normal => lower_Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Lower_Rear),    Normal => lower_Normal,   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         lower_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Lower).texture_Name /= null_Asset
+         then
+            lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
+            lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Left
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := [1 => (Site => the_Sites (Left_Lower_Rear),    Normal => left_Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Left_Lower_Front),   Normal => left_Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Left_Upper_Front),   Normal => left_Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Left_Upper_Rear),    Normal => left_Normal,   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         left_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Left).texture_Name /= null_Asset
+         then
+            left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
+            left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Right
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),   Normal => right_Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => the_Sites (Right_Lower_Rear),    Normal => right_Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Normal => right_Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               4 => (Site => the_Sites (Right_Upper_Front),   Normal => right_Normal,   Coords => (0.0, 1.0),   Shine => default_Shine)];
+      begin
+         right_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Right).texture_Name /= null_Asset
+         then
+            right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
+            right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      return [1 => front_Face.all'Access,
+              2 =>  rear_Face.all'Access,
+              3 => upper_Face.all'Access,
+              4 => lower_Face.all'Access,
+              5 =>  left_Face.all'Access,
+              6 => right_Face.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.box.lit_textured;

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

@@ -0,0 +1,49 @@
+with
+     openGL.Geometry,
+     openGL.Font;
+
+
+package openGL.Model.Box.lit_textured
+--
+--  Models a lit and textured box.
+--
+--  Each face may have a separate texture.
+--
+is
+   type Item is new Model.box.item with private;
+   type View is access all Item'Class;
+
+
+   type Face is
+      record
+         texture_Name : asset_Name := null_Asset;   -- The texture applied to the face.
+      end record;
+
+   type Faces is array (Side) of Face;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size  : in Vector_3;
+                     Faces : in lit_textured.Faces) 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;
+
+
+private
+
+   type Item is new Model.box.item with
+      record
+         Faces : lit_textured.Faces;
+      end record;
+
+end openGL.Model.Box.lit_textured;

3-mid/opengl/source/lean/model/opengl-model-box-textured.adb

@@ -0,0 +1,194 @@
+with
+     openGL.Geometry.textured,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.box.textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size      : in Vector_3;
+                     Faces     : in textured.Faces;
+                     is_Skybox : in Boolean := False) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Faces     := Faces;
+      Self.is_Skybox := is_Skybox;
+      Self.Size      := Size;
+
+      return Self;
+   end new_Box;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.textured,
+          Texture;
+
+      the_Sites    : constant box.Sites := Self.vertex_Sites;
+      the_Indices  : aliased  Indices   := [1, 2, 3, 4];
+
+
+      function new_Face (Vertices : in Geometry.textured.Vertex_array) return Geometry.textured.view
+      is
+         use Primitive;
+
+         the_Geometry  : constant Geometry.textured.view := Geometry.textured.new_Geometry;
+         the_Primitive : constant Primitive.view         := Primitive.indexed.new_Primitive (triangle_Fan,
+                                                                                             the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_Face;
+
+
+      front_Face : Geometry.textured.view;
+      rear_Face  : Geometry.textured.view;
+      upper_Face : Geometry.textured.view;
+      lower_Face : Geometry.textured.view;
+      left_Face  : Geometry.textured.view;
+      right_Face : Geometry.textured.view;
+
+   begin
+      if Self.is_Skybox
+      then
+         the_Indices := [4, 3, 2, 1];
+      end if;
+
+      --  Front
+      --
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (Site => the_Sites ( left_lower_front),   Coords => (0.0, 0.0)),
+               2 => (Site => the_Sites (right_lower_front),   Coords => (1.0, 0.0)),
+               3 => (Site => the_Sites (right_upper_front),   Coords => (1.0, 1.0)),
+               4 => (Site => the_Sites ( left_upper_front),   Coords => (0.0, 1.0))];
+      begin
+         front_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Front).texture_Name /= null_Asset
+         then
+            front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
+            front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Rear
+      --
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Rear),   Coords => (0.0, 0.0)),
+               2 => (Site => the_Sites ( Left_Lower_Rear),   Coords => (1.0, 0.0)),
+               3 => (Site => the_Sites ( Left_Upper_Rear),   Coords => (1.0, 1.0)),
+               4 => (Site => the_Sites (Right_Upper_Rear),   Coords => (0.0, 1.0))];
+      begin
+         rear_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Rear).texture_Name /= null_Asset
+         then
+            rear_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
+            rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Upper
+      --
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (Site => the_Sites ( Left_Upper_Front),    Coords => (0.0, 0.0)),
+               2 => (Site => the_Sites (Right_Upper_Front),   Coords => (1.0, 0.0)),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Coords => (1.0, 1.0)),
+               4 => (Site => the_Sites ( Left_Upper_Rear),     Coords => (0.0, 1.0))];
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Upper).texture_Name /= null_Asset
+         then
+            upper_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
+            upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Lower
+      --
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),   Coords => (0.0, 0.0)),
+               2 => (Site => the_Sites ( Left_Lower_Front),   Coords => (1.0, 0.0)),
+               3 => (Site => the_Sites ( Left_Lower_Rear),    Coords => (1.0, 1.0)),
+               4 => (Site => the_Sites (Right_Lower_Rear),    Coords => (0.0, 1.0))];
+      begin
+         lower_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Lower).texture_Name /= null_Asset
+         then
+            lower_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
+            lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Left
+      --
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (Site => the_Sites (Left_Lower_Rear),    Coords => (0.0, 0.0)),
+               2 => (Site => the_Sites (Left_Lower_Front),   Coords => (1.0, 0.0)),
+               3 => (Site => the_Sites (Left_Upper_Front),   Coords => (1.0, 1.0)),
+               4 => (Site => the_Sites (Left_Upper_Rear),    Coords => (0.0, 1.0))];
+      begin
+         left_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Left).texture_Name /= null_Asset
+         then
+            left_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
+            left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      --  Right
+      --
+      declare
+         the_Vertices : constant Geometry.textured.Vertex_array
+           := [1 => (Site => the_Sites (Right_Lower_Front),   Coords => (0.0, 0.0)),
+               2 => (Site => the_Sites (Right_Lower_Rear),    Coords => (1.0, 0.0)),
+               3 => (Site => the_Sites (Right_Upper_Rear),    Coords => (1.0, 1.0)),
+               4 => (Site => the_Sites (Right_Upper_Front),   Coords => (0.0, 1.0))];
+      begin
+         right_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Faces (Right).texture_Name /= null_Asset
+         then
+            right_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
+            right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
+         end if;
+      end;
+
+
+      return [1 => front_Face.all'Access,
+              2 =>  rear_Face.all'Access,
+              3 => upper_Face.all'Access,
+              4 => lower_Face.all'Access,
+              5 =>  left_Face.all'Access,
+              6 => right_Face.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.box.textured;

3-mid/opengl/source/lean/model/opengl-model-box-textured.ads

@@ -0,0 +1,52 @@
+with
+     openGL.Geometry,
+     openGL.Font,
+     openGL.Texture;
+
+
+package openGL.Model.Box.textured
+--
+--  Models a textured box.
+--
+--  Each face may have a separate texture.
+--
+is
+   type Item is new Model.box.item with private;
+   type View is access all Item'Class;
+
+
+   type Face is
+      record
+         texture_Name : asset_Name := null_Asset;
+      end record;
+
+   type Faces is array (Side) of Face;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Box (Size      : in Vector_3;
+                     Faces     : in textured.Faces;
+                     is_Skybox : in Boolean := False) 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;
+
+
+private
+
+   type Item is new Model.box.item with
+      record
+         Faces     : textured.Faces;
+         is_Skybox : Boolean := False;
+      end record;
+
+end openGL.Model.Box.textured;

3-mid/opengl/source/lean/model/opengl-model-box.adb

@@ -0,0 +1,37 @@
+package body openGL.Model.box
+is
+   --------------
+   --- Attributes
+   --
+
+   function vertex_Sites (Self : in Item'Class) return Sites
+   is
+      left_Offset  : constant Real := -0.5;
+      right_Offset : constant Real :=  0.5;
+
+      lower_Offset : constant Real := -0.5;
+      upper_Offset : constant Real :=  0.5;
+
+      front_Offset : constant Real :=  0.5;
+      rear_Offset  : constant Real := -0.5;
+   begin
+      return [Left_Lower_Front  => Scaled ([ left_Offset, lower_Offset, front_Offset],   by => Self.Size),
+              Right_Lower_Front => Scaled ([right_Offset, lower_Offset, front_Offset],   by => Self.Size),
+              Right_Upper_Front => Scaled ([right_Offset, upper_Offset, front_Offset],   by => Self.Size),
+              Left_Upper_Front  => Scaled ([ left_Offset, upper_Offset, front_Offset],   by => Self.Size),
+              Right_Lower_Rear  => Scaled ([right_Offset, lower_Offset,  rear_Offset],   by => Self.Size),
+              Left_Lower_Rear   => Scaled ([ left_Offset, lower_Offset,  rear_Offset],   by => Self.Size),
+              Left_Upper_Rear   => Scaled ([ left_Offset, upper_Offset,  rear_Offset],   by => Self.Size),
+              Right_Upper_Rear  => Scaled ([right_Offset, upper_Offset,  rear_Offset],   by => Self.Size)];
+   end vertex_Sites;
+
+
+
+   function Size (Self : in Item) return Vector_3
+   is
+   begin
+      return Self.Size;
+   end Size;
+
+
+end openGL.Model.box;

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

@@ -0,0 +1,41 @@
+package openGL.Model.box
+--
+--  Provides an abstract model of a box.
+--
+is
+   type Item is abstract new Model.item with private;
+
+   type Side is (Front, Rear,
+                 Upper, Lower,
+                 Left,  Right);
+
+   function Size (Self : in Item) return Vector_3;
+
+
+
+private
+
+   type Item is abstract new Model.item with
+      record
+         Size : Vector_3;
+      end record;
+
+
+   type site_Id is ( Left_Lower_Front, Right_Lower_Front,
+                    Right_Upper_Front,  Left_Upper_Front,
+                    Right_Lower_Rear,   Left_Lower_Rear,
+                     Left_Upper_Rear,  Right_Upper_Rear);
+
+   type Sites is array (site_Id) of Site;
+
+
+   front_Normal : constant Vector_3 := [ 0.0,  0.0,  1.0];
+   rear_Normal  : constant Vector_3 := [ 0.0,  0.0, -1.0];
+   upper_Normal : constant Vector_3 := [ 0.0,  1.0,  0.0];
+   lower_Normal : constant Vector_3 := [ 0.0, -1.0,  0.0];
+   left_Normal  : constant Vector_3 := [-1.0,  0.0,  0.0];
+   right_Normal : constant Vector_3 := [ 1.0,  0.0,  0.0];
+
+   function vertex_Sites (Self : in Item'Class) return Sites;
+
+end openGL.Model.box;

3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored.adb

@@ -0,0 +1,371 @@
+with
+     openGL.Geometry.lit_colored,
+     openGL.Texture,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.capsule.lit_colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Color  : in lucid_Color) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius :=  Radius;
+      Self.Height :=  Height;
+      Self.Color  := +Color;
+
+      return Self;
+   end new_Capsule;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry,
+          Geometry.lit_colored,
+          real_Functions;
+
+      Length        : constant Real    := Self.Height;
+      Radius        : constant Real    := Self.Radius;
+
+      quality_Level : constant Index_t := 4;
+      sides_Count   : constant Index_t := Index_t (quality_Level * 4);     -- Number of sides to the cylinder (divisible by 4):
+
+      type Edge is   -- A 'shaft' edge.
+         record
+            Fore : Site;
+            Aft  : Site;
+         end record;
+
+      type      Edges is array (Index_t range 1 .. sides_Count)   of Edge;
+      type arch_Edges is array (Index_t range 1 .. quality_Level) of Sites (1 .. sides_Count);
+
+      tmp,
+      nx, ny, nz,
+      start_nx,
+      start_ny   :          Real;
+      a          : constant Real := Pi * 2.0 / Real (sides_Count);
+      ca         : constant Real := Cos (a);
+      sa         : constant Real := Sin (a);
+      L          : constant Real := Length * 0.5;
+
+      the_Edges  : Edges;
+
+      the_shaft_Geometry : constant Geometry.lit_colored.view
+        := Geometry.lit_colored.new_Geometry;
+
+
+      cap_1_Geometry : Geometry.lit_colored.view;
+      cap_2_Geometry : Geometry.lit_colored.view;
+
+   begin
+      --  Define capsule shaft,
+      --
+      declare
+         vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
+         indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
+
+         the_Vertices  : aliased Geometry.lit_colored.Vertex_array := (1 .. vertex_Count  => <>);
+         the_Indices   : aliased Indices                           := (1 .. indices_Count => <>);
+
+      begin
+         ny := 1.0;
+         nz := 0.0;              -- Normal vector = (0.0, ny, nz)
+
+         -- Set vertices.
+         --
+         declare
+            use linear_Algebra;
+
+            S       :          Real    := 0.0;
+            S_delta : constant Real    := 1.0 / Real (sides_Count);
+
+            i       :          Index_t := 1;
+         begin
+            for Each in 1 .. Index_t (Edges'Length)
+            loop
+               the_Edges (Each).Fore (1) :=  ny * Radius;
+               the_Edges (Each).Fore (2) :=  nz * Radius;
+               the_Edges (Each).Fore (3) :=  L;
+
+               the_Edges (Each).Aft  (1) :=  ny * Radius;
+               the_Edges (Each).Aft  (2) :=  nz * Radius;
+               the_Edges (Each).Aft  (3) := -L;
+
+               --  Rotate ny, nz.
+               --
+               tmp := ca * ny  -  sa * nz;
+               nz  := sa * ny  +  ca * nz;
+               ny  := tmp;
+
+               the_Vertices (i).Site   := the_Edges (Each).Fore;
+               the_Vertices (i).Normal := Normalised ((the_Vertices (i).Site (1),
+                                                       the_Vertices (i).Site (2),
+                                                       0.0));
+               the_Vertices (i).Color  := Self.Color;
+               the_Vertices (i).Shine  := 0.5;
+               i := i + 1;
+
+               the_Vertices (i).Site   := the_Edges (Each).Aft;
+               the_Vertices (i).Normal := the_Vertices (i - 1).Normal;
+               the_Vertices (i).Color  := Self.Color;
+               the_Vertices (i).Shine  := 0.5;
+               i := i + 1;
+
+               S := S + S_delta;
+            end loop;
+
+            the_Vertices (i).Site   := the_Edges (1).Fore;
+            the_Vertices (i).Normal := Normalised ((the_Vertices (i).Site (1),
+                                                    the_Vertices (i).Site (2),
+                                                    0.0));
+            the_Vertices (i).Color  := Self.Color;
+            the_Vertices (i).Shine  := 0.5;
+            i := i + 1;
+
+            the_Vertices (i).Site   := the_Edges (1).Aft;
+            the_Vertices (i).Normal := the_Vertices (i - 1).Normal;
+            the_Vertices (i).Color  := Self.Color;
+            the_Vertices (i).Shine  := 0.5;
+         end;
+
+         -- Set indices.
+         --
+         declare
+            i     : long_Index_t := 1;
+            Start :      Index_t := 1;
+         begin
+            for Each in 1 .. long_Index_t (sides_Count)
+            loop
+               the_Indices (i) := Start;       i := i + 1;
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 3;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               Start := Start + 2;
+            end loop;
+         end;
+
+         Vertices_are (the_shaft_Geometry.all, the_Vertices);
+
+         declare
+            the_Primitive : constant Primitive.indexed.view
+              := Primitive.indexed.new_Primitive (primitive.Triangles,
+                                                  the_Indices);
+         begin
+            the_shaft_Geometry.add (Primitive.view (the_Primitive));
+         end;
+      end;
+
+
+      declare
+         function new_Cap (is_Fore : Boolean) return Geometry.lit_colored.view
+         is
+            use linear_Algebra;
+
+            cap_Geometry   : constant Geometry.lit_colored.view
+              := Geometry.lit_colored.new_Geometry;
+
+            hoop_Count     : constant      Index_t := quality_Level;
+            vertex_Count   : constant      Index_t :=      Index_t (Edges'Length * hoop_Count + 1);             -- A vertex for each edge of each hoop, + 1 for the pole.
+            indices_Count  : constant long_Index_t := long_Index_t (  (hoop_count - 1) * sides_Count * 2 * 3    -- For each hoop, 2 triangles per side with 3 vertices per triangle
+                                                                   + sides_Count * 3);                         -- plus the extra indices for the pole triangles.
+
+            the_Vertices   : aliased Geometry.lit_colored.Vertex_array := (1 ..  vertex_Count => <>);
+            the_Indices    : aliased Indices                           := (1 .. indices_Count => <>);
+
+            the_arch_Edges : arch_Edges;
+            i              : Index_t   := 1;
+
+            pole_Site      : constant Site := (if is_Fore then (0.0, 0.0,  L + Radius)
+                                                          else (0.0, 0.0, -L - Radius));
+
+            Degrees_90        : constant := Pi / 2.0;
+            Degrees_360       : constant := Pi * 2.0;
+
+            latitude_Count    : constant :=  hoop_Count + 1;
+            longitude_Count   : constant :=  Edges'Length;
+
+            latitude_Spacing  : constant Real := Degrees_90  / Real (latitude_Count - 1);
+            longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
+
+            a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+         begin
+            if not is_Fore
+            then
+               a := Degrees_360;
+            end if;
+
+            -- Set the vertices.
+            --
+            start_nx := 0.0;
+            start_ny := 1.0;
+
+            for each_Hoop in 1 .. quality_Level
+            loop
+               --  Get n=start_n.
+               --
+               nx := start_nx;
+               ny := start_ny;
+               nz := 0.0;
+
+               for Each in 1 .. sides_Count
+               loop
+                  the_arch_Edges (each_Hoop) (Each) (1) :=  ny * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (2) :=  nz * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (3) :=  (if is_Fore then nx * Radius + L
+                                                                        else nx * Radius - L);
+                  --  Rotate ny, nz.
+                  --
+                  tmp := ca * ny  -  sa * nz;
+                  nz  := sa * ny  +  ca * nz;
+                  ny  := tmp;
+
+                  the_Vertices (i).Site   := the_arch_Edges (each_Hoop) (Each);
+                  the_Vertices (i).Normal := Normalised ((the_Vertices (i).Site (1),
+                                                          the_Vertices (i).Site (2),
+                                                          (if is_Fore then the_Vertices (i).Site (3) - L
+                                                                      else the_Vertices (i).Site (3) + L)));
+                  the_Vertices (i).Color  := Self.Color;
+                  the_Vertices (i).Shine  := 0.5;
+                  i := i + 1;
+                  a := (if is_Fore then a + longitude_Spacing
+                                   else a - longitude_Spacing);
+               end loop;
+
+               declare
+                  tmp : constant Real := start_nx;
+               begin
+                  if is_Fore
+                  then
+                     start_nx :=  ca * start_nx  +  sa * start_ny;
+                     start_ny := -sa * tmp       +  ca * start_ny;
+                  else
+                     start_nx :=  ca * start_nx  -  sa * start_ny;
+                     start_ny :=  sa * tmp       +  ca * start_ny;
+                  end if;
+               end;
+
+               a := (if is_Fore then 0.0
+                                else Degrees_360);
+               b := b + latitude_Spacing;
+            end loop;
+
+            -- Add pole vertex.
+            --
+            the_Vertices (i).Site   := pole_Site;
+            the_Vertices (i).Normal := Normalised (pole_Site);
+            the_Vertices (i).Color  := Self.Color;
+            the_Vertices (i).Shine  := 0.5;
+
+            -- Set indices.
+            --
+            declare
+               i          :     long_Index_t := 1;
+               Start      :          Index_t := 1;
+               hoop_Start :          Index_t := 1;
+               pole_Index : constant Index_t := vertex_Count;
+
+            begin
+               for each_Hoop in 1 .. quality_Level
+               loop
+                  for Each in 1 .. sides_Count
+                  loop
+                     declare
+                        function next_hoop_Vertex return Index_t
+                        is
+                        begin
+                           if Each = sides_Count then return hoop_Start;
+                           else                       return Start + 1;
+                           end if;
+                        end next_hoop_Vertex;
+                     begin
+                        if each_Hoop = quality_Level
+                        then
+                           if is_Fore
+                           then
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                           else
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                           end if;
+                        else
+                           declare
+                              v1 : constant Index_t := Start;
+                              v2 : constant Index_t := next_hoop_Vertex;
+                              v3 : constant Index_t := v1 + sides_Count;
+                              v4 : constant Index_t := v2 + sides_Count;
+                           begin
+                              if is_Fore
+                              then
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                              else
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                              end if;
+                           end;
+                        end if;
+
+                        Start := Start + 1;
+                     end;
+                  end loop;
+
+                  hoop_Start := hoop_Start + sides_Count;
+               end loop;
+
+               Vertices_are (cap_Geometry.all, the_Vertices);
+
+               declare
+                  the_Primitive : constant Primitive.indexed.view
+                    := Primitive.indexed.new_Primitive (Primitive.Triangles,
+                                                        the_Indices);
+               begin
+                  cap_Geometry.add (Primitive.view (the_Primitive));
+               end;
+            end;
+
+            return cap_Geometry;
+         end new_Cap;
+
+      begin
+         cap_1_Geometry := new_Cap (is_Fore => True);
+         cap_2_Geometry := new_Cap (is_Fore => False);
+      end;
+
+      return (1 => the_shaft_Geometry.all'Access,
+              2 =>     cap_1_Geometry.all'Access,
+              3 =>     cap_2_Geometry.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.capsule.lit_colored;

3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored.ads

@@ -0,0 +1,41 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.capsule.lit_colored
+--
+--  Models a lit and colored capsule.
+--
+is
+   type Item is new Model.capsule.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Color  : in lucid_Color) 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;
+
+
+
+private
+
+   type Item is new Model.capsule.item with
+      record
+         Radius : Real;
+         Height : Real;
+         Color  : rgba_Color;
+      end record;
+
+end openGL.Model.capsule.lit_colored;

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

@@ -0,0 +1,412 @@
+with
+     openGL.Geometry.lit_colored_textured,
+     openGL.Texture,
+     openGL.IO,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.capsule.lit_colored_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Color  : in lucid_Color;
+                         Image  : in asset_Name := null_Asset) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Height := Height;
+
+      Self.Color := +Color;
+      Self.Image := Image;
+
+      return Self;
+   end new_Capsule;
+
+
+   --------------
+   --- Attributes
+   --
+
+   type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
+
+
+   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 (Textures, Fonts);
+
+      use Geometry,
+          Geometry.lit_colored_textured,
+          real_Functions;
+
+      Length        : constant Real    := Self.Height;
+      Radius        : constant Real    := Self.Radius;
+
+      quality_Level : constant Index_t := 4;
+      sides_Count   : constant Index_t := Index_t (quality_Level * 4);     -- Number of sides to the cylinder (divisible by 4):
+
+      type Edge is   -- A 'shaft' edge.
+         record
+            Fore : Site;
+            Aft  : Site;
+         end record;
+
+      type      Edges is array (Index_t range 1 .. sides_Count)   of Edge;
+      type arch_Edges is array (Index_t range 1 .. quality_Level) of Sites (1 .. sides_Count);
+
+      tmp,
+      nx, ny, nz,
+      start_nx,
+      start_ny   :          Real;
+      a          : constant Real := Pi * 2.0 / Real (sides_Count);
+      ca         : constant Real := Cos (a);
+      sa         : constant Real := Sin (a);
+      L          : constant Real := Length * 0.5;
+
+      the_Edges  : Edges;
+
+      the_shaft_Geometry  : constant Geometry_view
+        := Geometry_view (Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False));
+
+      cap_1_Geometry : Geometry_view;
+      cap_2_Geometry : Geometry_view;
+
+   begin
+      --  Define capsule shaft,
+      --
+      declare
+         vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
+         indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
+
+         the_Vertices  : aliased Geometry.lit_colored_textured.Vertex_array := [1 .. vertex_Count  => <>];
+         the_Indices   : aliased Indices                                    := [1 .. indices_Count => <>];
+
+      begin
+         ny := 1.0;
+         nz := 0.0;              -- Normal vector = (0.0, ny, nz)
+
+         -- Set vertices.
+         --
+         declare
+            use linear_Algebra;
+
+            S       :          Real    := 0.0;
+            S_delta : constant Real    := 1.0 / Real (sides_Count);
+
+            i       :          Index_t := 1;
+         begin
+            for Each in 1 .. Index_t (Edges'Length)
+            loop
+               the_Edges (Each).Fore (1) :=  ny * Radius;
+               the_Edges (Each).Fore (2) :=  nz * Radius;
+               the_Edges (Each).Fore (3) :=  L;
+
+               the_Edges (Each).Aft  (1) :=  ny * Radius;
+               the_Edges (Each).Aft  (2) :=  nz * Radius;
+               the_Edges (Each).Aft  (3) := -L;
+
+               --  Rotate ny, nz.
+               --
+               tmp := ca * ny  -  sa * nz;
+               nz  := sa * ny  +  ca * nz;
+               ny  := tmp;
+
+               the_Vertices (i).Site   := the_Edges (Each).Fore;
+               the_Vertices (i).Normal := Normalised ([the_Vertices (i).Site (1),
+                                                       the_Vertices (i).Site (2),
+                                                       0.0]);
+               the_Vertices (i).Color  := Self.Color;
+               the_Vertices (i).Shine  := 0.5;
+               the_Vertices (i).Coords := (s => S,
+                                           t => 1.0);
+               i := i + 1;
+
+               the_Vertices (i).Site   := the_Edges (Each).Aft;
+               the_Vertices (i).Normal := the_Vertices (i - 1).Normal;
+               the_Vertices (i).Color  := Self.Color;
+               the_Vertices (i).Shine  := 0.5;
+               the_Vertices (i).Coords := (s => S,
+                                           t => 0.0);
+               i := i + 1;
+
+               S := S + S_delta;
+            end loop;
+
+            the_Vertices (i).Site   := the_Edges (1).Fore;
+            the_Vertices (i).Normal := Normalised ([the_Vertices (i).Site (1),
+                                                    the_Vertices (i).Site (2),
+                                                    0.0]);
+            the_Vertices (i).Color  := Self.Color;
+            the_Vertices (i).Shine  := 0.5;
+            the_Vertices (i).Coords := (s => S,
+                                        t => 1.0);
+            i := i + 1;
+
+            the_Vertices (i).Site   := the_Edges (1).Aft;
+            the_Vertices (i).Normal := the_Vertices (i - 1).Normal;
+            the_Vertices (i).Color  := Self.Color;
+            the_Vertices (i).Shine  := 0.5;
+            the_Vertices (i).Coords := (s => S,
+                                        t => 0.0);
+         end;
+
+         -- Set indices.
+         --
+         declare
+            i     : long_Index_t := 1;
+            Start :      Index_t := 1;
+         begin
+            for Each in 1 .. long_Index_t (sides_Count)
+            loop
+               the_Indices (i) := Start;       i := i + 1;
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 3;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               Start := Start + 2;
+            end loop;
+         end;
+
+         if Self.Image /= null_Asset
+         then
+            set_Texture:
+            declare
+               use Texture;
+               the_Image   : constant Image          := IO.to_Image      (Self.Image);
+               the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+            begin
+               the_shaft_Geometry.Texture_is (the_Texture);
+            end set_Texture;
+         end if;
+
+         Vertices_are (the_shaft_Geometry.all, the_Vertices);
+
+         declare
+            the_Primitive : constant Primitive.indexed.view
+              := Primitive.indexed.new_Primitive (primitive.Triangles,
+                                                  the_Indices);
+         begin
+            the_shaft_Geometry.add (Primitive.view (the_Primitive));
+         end;
+      end;
+
+
+      declare
+         function new_Cap (is_Fore : Boolean) return Geometry_view
+         is
+            use linear_Algebra;
+
+            cap_Geometry  : constant Geometry_view
+              := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+            hoop_Count    : constant      Index_t := quality_Level;
+            vertex_Count  : constant      Index_t :=      Index_t (Edges'Length * hoop_Count + 1);             -- A vertex for each edge of each hoop, + 1 for the pole.
+            indices_Count : constant long_Index_t := long_Index_t (  (hoop_count - 1) * sides_Count * 2 * 3    -- For each hoop, 2 triangles per side with 3 vertices per triangle
+                                                                   + sides_Count * 3);                         -- plus the extra indices for the pole triangles.
+
+            the_Vertices  : aliased Geometry.lit_colored_textured.Vertex_array := [1 ..  vertex_Count => <>];
+            the_Indices   : aliased Indices                                    := [1 .. indices_Count => <>];
+
+            the_arch_Edges : arch_Edges;
+            i              : Index_t   := 1;
+
+            pole_Site      : constant Site := (if is_Fore then [0.0, 0.0,  L + Radius]
+                                                          else [0.0, 0.0, -L - Radius]);
+
+            Degrees_90        : constant := Pi / 2.0;
+            Degrees_360       : constant := Pi * 2.0;
+
+            latitude_Count    : constant :=  hoop_Count + 1;
+            longitude_Count   : constant :=  Edges'Length;
+
+            latitude_Spacing  : constant Real := Degrees_90  / Real (latitude_Count - 1);
+            longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
+
+            a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+         begin
+            if not is_Fore
+            then
+               a := Degrees_360;
+            end if;
+
+            -- Set the vertices.
+            --
+            start_nx := 0.0;
+            start_ny := 1.0;
+
+            for each_Hoop in 1 .. quality_Level
+            loop
+               --  Get n=start_n.
+               --
+               nx := start_nx;
+               ny := start_ny;
+               nz := 0.0;
+
+               for Each in 1 .. sides_Count
+               loop
+                  the_arch_Edges (each_Hoop) (Each) (1) :=  ny * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (2) :=  nz * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (3) :=  (if is_Fore then nx * Radius + L
+                                                                        else nx * Radius - L);
+                  --  Rotate ny, nz.
+                  --
+                  tmp := ca * ny  -  sa * nz;
+                  nz  := sa * ny  +  ca * nz;
+                  ny  := tmp;
+
+                  the_Vertices (i).Site   := the_arch_Edges (each_Hoop) (Each);
+                  the_Vertices (i).Normal := Normalised ([the_Vertices (i).Site (1),
+                                                          the_Vertices (i).Site (2),
+                                                          (if is_Fore then the_Vertices (i).Site (3) - L
+                                                                      else the_Vertices (i).Site (3) + L)]);
+                  the_Vertices (i).Color  := Self.Color;
+                  the_Vertices (i).Shine  := 0.5;
+                  the_Vertices (i).Coords :=  (s => a / Degrees_360,
+                                               t => b / Degrees_90);
+                  i := i + 1;
+                  a := (if is_Fore then a + longitude_Spacing
+                                   else a - longitude_Spacing);
+               end loop;
+
+               declare
+                  tmp : constant Real := start_nx;
+               begin
+                  if is_Fore
+                  then
+                     start_nx :=  ca * start_nx  +  sa * start_ny;
+                     start_ny := -sa * tmp       +  ca * start_ny;
+                  else
+                     start_nx :=  ca * start_nx  -  sa * start_ny;
+                     start_ny :=  sa * tmp       +  ca * start_ny;
+                  end if;
+               end;
+
+               a := (if is_Fore then 0.0
+                                else Degrees_360);
+               b := b + latitude_Spacing;
+            end loop;
+
+            -- Add pole vertex.
+            --
+            the_Vertices (i).Site   := pole_Site;
+            the_Vertices (i).Normal := Normalised (pole_Site);
+            the_Vertices (i).Color  := Self.Color;
+            the_Vertices (i).Shine  := 0.5;
+            the_Vertices (i).Coords := (s => 0.5,
+                                        t => 1.0);
+            -- Set indices.
+            --
+            declare
+               i          :     long_Index_t := 1;
+               Start      :          Index_t := 1;
+               hoop_Start :          Index_t := 1;
+               pole_Index : constant Index_t := vertex_Count;
+
+            begin
+               for each_Hoop in 1 .. quality_Level
+               loop
+                  for Each in 1 .. sides_Count
+                  loop
+                     declare
+                        function next_hoop_Vertex return Index_t
+                        is
+                        begin
+                           if Each = sides_Count then return hoop_Start;
+                           else                       return Start + 1;
+                           end if;
+                        end next_hoop_Vertex;
+                     begin
+                        if each_Hoop = quality_Level
+                        then
+                           if is_Fore
+                           then
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                           else
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                           end if;
+                        else
+                           declare
+                              v1 : constant Index_t := Start;
+                              v2 : constant Index_t := next_hoop_Vertex;
+                              v3 : constant Index_t := v1 + sides_Count;
+                              v4 : constant Index_t := v2 + sides_Count;
+                           begin
+                              if is_Fore
+                              then
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                              else
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                              end if;
+                           end;
+                        end if;
+
+                        Start := Start + 1;
+                     end;
+                  end loop;
+
+                  hoop_Start := hoop_Start + sides_Count;
+               end loop;
+
+               if Self.Image /= null_Asset
+               then
+                  set_the_Texture:
+                  declare
+                     use Texture;
+                     the_Image   : constant Image          := IO.to_Image      (Self.Image);
+                     the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+                  begin
+                     cap_Geometry.Texture_is (the_Texture);
+                  end set_the_Texture;
+               end if;
+
+               Vertices_are (cap_Geometry.all, the_Vertices);
+
+               declare
+                  the_Primitive : constant Primitive.indexed.view
+                    := Primitive.indexed.new_Primitive (Primitive.Triangles,
+                                                        the_Indices);
+               begin
+                  cap_Geometry.add (Primitive.view (the_Primitive));
+               end;
+            end;
+
+            return cap_Geometry;
+         end new_Cap;
+
+      begin
+         cap_1_Geometry := new_Cap (is_Fore => True);
+         cap_2_Geometry := new_Cap (is_Fore => False);
+      end;
+
+      return [1 => the_shaft_Geometry.all'Access,
+              2 =>     cap_1_Geometry.all'Access,
+              3 =>     cap_2_Geometry.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.capsule.lit_colored_textured;

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

@@ -0,0 +1,44 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.capsule.lit_colored_textured
+--
+--  Models a lit, colored and textured capsule.
+--
+is
+   type Item is new Model.capsule.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Color  : in lucid_Color;
+                         Image  : in asset_Name := null_Asset) 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;
+
+
+
+private
+
+   type Item is new Model.capsule.item with
+      record
+         Radius : Real;
+         Height : Real;
+
+         Color  : rgba_Color;
+         Image  : asset_Name := null_Asset;
+      end record;
+
+end openGL.Model.capsule.lit_colored_textured;

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

@@ -0,0 +1,403 @@
+with
+     openGL.Geometry.lit_textured,
+     openGL.Texture,
+     openGL.IO,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.capsule.lit_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Image  : in asset_Name := null_Asset) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Height := Height;
+      Self.Image  := Image;
+
+      return Self;
+   end new_Capsule;
+
+
+   --------------
+   --- Attributes
+   --
+
+--     type Geometry_view is access all Geometry.lit_textured.item'Class;
+
+
+   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 (Textures, Fonts);
+
+      use Geometry,
+          Geometry.lit_textured,
+          real_Functions;
+
+      Length        : constant Real    := Self.Height;
+      Radius        : constant Real    := Self.Radius;
+
+      quality_Level : constant Index_t := 4;
+      sides_Count   : constant Index_t := Index_t (quality_Level * 4);     -- Number of sides to the cylinder (divisible by 4):
+
+      type Edge is   -- A 'shaft' edge.
+         record
+            Fore : Site;
+            Aft  : Site;
+         end record;
+
+      type      Edges is array (Index_t range 1 .. sides_Count)   of Edge;
+      type arch_Edges is array (Index_t range 1 .. quality_Level) of Sites (1 .. sides_Count);
+
+      tmp,
+      nx, ny, nz,
+      start_nx,
+      start_ny   :          Real;
+      a          : constant Real := Pi * 2.0 / Real (sides_Count);
+      ca         : constant Real := Cos (a);
+      sa         : constant Real := Sin (a);
+      L          : constant Real := Length * 0.5;
+
+      the_Edges  : Edges;
+
+      the_shaft_Geometry  : constant Geometry.lit_textured.view
+        := Geometry.lit_textured.new_Geometry;
+
+      cap_1_Geometry : Geometry.lit_textured.view;
+      cap_2_Geometry : Geometry.lit_textured.view;
+
+   begin
+      --  Define capsule shaft,
+      --
+      declare
+         vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
+         indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
+
+         the_Vertices  : aliased Geometry.lit_textured.Vertex_array := [1 .. vertex_Count  => <>];
+         the_Indices   : aliased Indices                            := [1 .. indices_Count => <>];
+
+      begin
+         ny := 1.0;
+         nz := 0.0;              -- Normal vector = (0.0, ny, nz)
+
+         -- Set vertices.
+         --
+         declare
+            use linear_Algebra;
+
+            S       :          Real    := 0.0;
+            S_delta : constant Real    := 1.0 / Real (sides_Count);
+
+            i       :          Index_t := 1;
+         begin
+            for Each in 1 .. Index_t (Edges'Length)
+            loop
+               the_Edges (Each).Fore (1) :=  ny * Radius;
+               the_Edges (Each).Fore (2) :=  nz * Radius;
+               the_Edges (Each).Fore (3) :=  L;
+
+               the_Edges (Each).Aft  (1) :=  ny * Radius;
+               the_Edges (Each).Aft  (2) :=  nz * Radius;
+               the_Edges (Each).Aft  (3) := -L;
+
+               --  Rotate ny, nz.
+               --
+               tmp := ca * ny  -  sa * nz;
+               nz  := sa * ny  +  ca * nz;
+               ny  := tmp;
+
+               the_Vertices (i).Site   := the_Edges (Each).Fore;
+               the_Vertices (i).Shine  := 0.5;
+               the_Vertices (i).Normal := Normalised ([the_Vertices (i).Site (1),
+                                                       the_Vertices (i).Site (2),
+                                                       0.0]);
+               the_Vertices (i).Coords := (s => S,
+                                           t => 1.0);
+               i := i + 1;
+
+               the_Vertices (i).Site   := the_Edges (Each).Aft;
+               the_Vertices (i).Shine  := 0.5;
+               the_Vertices (i).Normal := the_Vertices (i - 1).Normal;
+               the_Vertices (i).Coords := (s => S,
+                                           t => 0.0);
+               i := i + 1;
+
+               S := S + S_delta;
+            end loop;
+
+            the_Vertices (i).Site   := the_Edges (1).Fore;
+            the_Vertices (i).Shine  := 0.5;
+            the_Vertices (i).Normal := Normalised ([the_Vertices (i).Site (1),
+                                                    the_Vertices (i).Site (2),
+                                                    0.0]);
+            the_Vertices (i).Coords := (s => S,
+                                        t => 1.0);
+            i := i + 1;
+
+            the_Vertices (i).Site   := the_Edges (1).Aft;
+            the_Vertices (i).Shine  := 0.5;
+            the_Vertices (i).Normal := the_Vertices (i - 1).Normal;
+            the_Vertices (i).Coords := (s => S,
+                                        t => 0.0);
+         end;
+
+         -- Set indices.
+         --
+         declare
+            i     : long_Index_t := 1;
+            Start :      Index_t := 1;
+         begin
+            for Each in 1 .. long_Index_t (sides_Count)
+            loop
+               the_Indices (i) := Start;       i := i + 1;
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 3;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               Start := Start + 2;
+            end loop;
+         end;
+
+         if Self.Image /= null_Asset
+         then
+            set_Texture:
+            declare
+               use Texture;
+               the_Image   : constant Image          := IO.to_Image      (Self.Image);
+               the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+            begin
+               the_shaft_Geometry.Texture_is (the_Texture);
+            end set_Texture;
+         end if;
+
+         Vertices_are (the_shaft_Geometry.all, the_Vertices);
+
+         declare
+            the_Primitive : constant Primitive.indexed.view
+              := Primitive.indexed.new_Primitive (primitive.Triangles,
+                                                  the_Indices);
+         begin
+            the_shaft_Geometry.add (Primitive.view (the_Primitive));
+         end;
+      end;
+
+
+      declare
+         function new_Cap (is_Fore : Boolean) return Geometry.lit_textured.view
+         is
+            use linear_Algebra;
+
+            cap_Geometry  : constant Geometry.lit_textured.view
+              := Geometry.lit_textured.new_Geometry;
+
+            hoop_Count    : constant      Index_t := quality_Level;
+            vertex_Count  : constant      Index_t :=      Index_t (Edges'Length * hoop_Count + 1);             -- A vertex for each edge of each hoop, + 1 for the pole.
+            indices_Count : constant long_Index_t := long_Index_t (  (hoop_count - 1) * sides_Count * 2 * 3    -- For each hoop, 2 triangles per side with 3 vertices per triangle
+                                                                   + sides_Count * 3);                         -- plus the extra indices for the pole triangles.
+
+            the_Vertices  : aliased Geometry.lit_textured.Vertex_array := [1 ..  vertex_Count => <>];
+            the_Indices   : aliased Indices                            := [1 .. indices_Count => <>];
+
+            the_arch_Edges : arch_Edges;
+            i              : Index_t   := 1;
+
+            pole_Site      : constant Site := (if is_Fore then [0.0, 0.0,  L + Radius]
+                                                          else [0.0, 0.0, -L - Radius]);
+
+            Degrees_90        : constant := Pi / 2.0;
+            Degrees_360       : constant := Pi * 2.0;
+
+            latitude_Count    : constant :=  hoop_Count + 1;
+            longitude_Count   : constant :=  Edges'Length;
+
+            latitude_Spacing  : constant Real := Degrees_90  / Real (latitude_Count - 1);
+            longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
+
+            a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+         begin
+            if not is_Fore
+            then
+               a := Degrees_360;
+            end if;
+
+            -- Set the vertices.
+            --
+            start_nx := 0.0;
+            start_ny := 1.0;
+
+            for each_Hoop in 1 .. quality_Level
+            loop
+               --  Get n=start_n.
+               --
+               nx := start_nx;
+               ny := start_ny;
+               nz := 0.0;
+
+               for Each in 1 .. sides_Count
+               loop
+                  the_arch_Edges (each_Hoop) (Each) (1) :=  ny * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (2) :=  nz * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (3) :=  (if is_Fore then nx * Radius + L
+                                                                        else nx * Radius - L);
+                  --  Rotate ny, nz.
+                  --
+                  tmp := ca * ny  -  sa * nz;
+                  nz  := sa * ny  +  ca * nz;
+                  ny  := tmp;
+
+                  the_Vertices (i).Site   := the_arch_Edges (each_Hoop) (Each);
+                  the_Vertices (i).Shine  := 0.5;
+                  the_Vertices (i).Normal := Normalised ([the_Vertices (i).Site (1),
+                                                          the_Vertices (i).Site (2),
+                                                          (if is_Fore then the_Vertices (i).Site (3) - L
+                                                                      else the_Vertices (i).Site (3) + L)]);
+                  the_Vertices (i).Coords :=  (s => a / Degrees_360,
+                                               t => b / Degrees_90);
+                  i := i + 1;
+                  a := (if is_Fore then a + longitude_Spacing
+                                   else a - longitude_Spacing);
+               end loop;
+
+               declare
+                  tmp : constant Real := start_nx;
+               begin
+                  if is_Fore
+                  then
+                     start_nx :=  ca * start_nx  +  sa * start_ny;
+                     start_ny := -sa * tmp       +  ca * start_ny;
+                  else
+                     start_nx :=  ca * start_nx  -  sa * start_ny;
+                     start_ny :=  sa * tmp       +  ca * start_ny;
+                  end if;
+               end;
+
+               a := (if is_Fore then 0.0
+                                else Degrees_360);
+               b := b + latitude_Spacing;
+            end loop;
+
+            -- Add pole vertex.
+            --
+            the_Vertices (i).Site   := pole_Site;
+            the_Vertices (i).Shine  := 0.5;
+            the_Vertices (i).Normal := Normalised (pole_Site);
+            the_Vertices (i).Coords := (s => 0.5,
+                                        t => 1.0);
+            -- Set indices.
+            --
+            declare
+               i          :     long_Index_t := 1;
+               Start      :          Index_t := 1;
+               hoop_Start :          Index_t := 1;
+               pole_Index : constant Index_t := vertex_Count;
+
+            begin
+               for each_Hoop in 1 .. quality_Level
+               loop
+                  for Each in 1 .. sides_Count
+                  loop
+                     declare
+                        function next_hoop_Vertex return Index_t
+                        is
+                        begin
+                           if Each = sides_Count then return hoop_Start;
+                           else                       return Start + 1;
+                           end if;
+                        end next_hoop_Vertex;
+                     begin
+                        if each_Hoop = quality_Level
+                        then
+                           if is_Fore
+                           then
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                           else
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                           end if;
+                        else
+                           declare
+                              v1 : constant Index_t := Start;
+                              v2 : constant Index_t := next_hoop_Vertex;
+                              v3 : constant Index_t := v1 + sides_Count;
+                              v4 : constant Index_t := v2 + sides_Count;
+                           begin
+                              if is_Fore
+                              then
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                              else
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                              end if;
+                           end;
+                        end if;
+
+                        Start := Start + 1;
+                     end;
+                  end loop;
+
+                  hoop_Start := hoop_Start + sides_Count;
+               end loop;
+
+               if Self.Image /= null_Asset
+               then
+                  set_the_Texture:
+                  declare
+                     use Texture;
+                     the_Image   : constant Image          := IO.to_Image      (Self.Image);
+                     the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+                  begin
+                     cap_Geometry.Texture_is (the_Texture);
+                  end set_the_Texture;
+               end if;
+
+               Vertices_are (cap_Geometry.all, the_Vertices);
+
+               declare
+                  the_Primitive : constant Primitive.indexed.view
+                    := Primitive.indexed.new_Primitive (Primitive.Triangles,
+                                                        the_Indices);
+               begin
+                  cap_Geometry.add (Primitive.view (the_Primitive));
+               end;
+            end;
+
+            return cap_Geometry;
+         end new_Cap;
+
+      begin
+         cap_1_Geometry := new_Cap (is_Fore => True);
+         cap_2_Geometry := new_Cap (is_Fore => False);
+      end;
+
+      return [1 => the_shaft_Geometry.all'Access,
+              2 =>     cap_1_Geometry.all'Access,
+              3 =>     cap_2_Geometry.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.capsule.lit_textured;

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

@@ -0,0 +1,42 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.capsule.lit_textured
+--
+--  Models a lit and textured capsule.
+--
+is
+   type Item is new Model.capsule.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Image  : in asset_Name := null_Asset) 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;
+
+
+
+private
+
+   type Item is new Model.capsule.item with
+      record
+         Radius : Real;
+         Height : Real;
+
+         Image  : asset_Name := null_Asset;
+      end record;
+
+end openGL.Model.capsule.lit_textured;

3-mid/opengl/source/lean/model/opengl-model-capsule-textured.adb

@@ -0,0 +1,377 @@
+with
+     openGL.Geometry.textured,
+     openGL.Texture,
+     openGL.IO,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.capsule.textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Image  : in asset_Name := null_Asset) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Height := Height;
+      Self.Image  := Image;
+
+      return Self;
+   end new_Capsule;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use --Geometry,
+          Geometry.textured,
+          real_Functions;
+
+      Length        : constant Real    := Self.Height;
+      Radius        : constant Real    := Self.Radius;
+
+      quality_Level : constant Index_t := 4;
+      sides_Count   : constant Index_t := Index_t (quality_Level * 4);     -- Number of sides to the cylinder (divisible by 4):
+
+      type Edge is   -- A 'shaft' edge.
+         record
+            Fore : Site;
+            Aft  : Site;
+         end record;
+
+      type      Edges is array (Index_t range 1 .. sides_Count)   of Edge;
+      type arch_Edges is array (Index_t range 1 .. quality_Level) of Sites (1 .. sides_Count);
+
+      tmp,
+      nx, ny, nz,
+      start_nx,
+      start_ny   :          Real;
+      a          : constant Real := Pi * 2.0 / Real (sides_Count);
+      ca         : constant Real := Cos (a);
+      sa         : constant Real := Sin (a);
+      L          : constant Real := Length * 0.5;
+
+      the_Edges  : Edges;
+
+      the_shaft_Geometry  : constant Geometry.textured.view
+        := Geometry.textured.new_Geometry;
+
+      cap_1_Geometry : Geometry.textured.view;
+      cap_2_Geometry : Geometry.textured.view;
+
+   begin
+      --  Define capsule shaft,
+      --
+      declare
+         vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
+         indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
+
+         the_Vertices  : aliased Geometry.textured.Vertex_array := (1 .. vertex_Count  => <>);
+         the_Indices   : aliased Indices                        := (1 .. indices_Count => <>);
+
+      begin
+         ny := 1.0;
+         nz := 0.0;              -- Normal vector = (0.0, ny, nz)
+
+         -- Set vertices.
+         --
+         declare
+            S       :          Real    := 0.0;
+            S_delta : constant Real    := 1.0 / Real (sides_Count);
+
+            i       :          Index_t := 1;
+         begin
+            for Each in 1 .. Index_t (Edges'Length)
+            loop
+               the_Edges (Each).Fore (1) :=  ny * Radius;
+               the_Edges (Each).Fore (2) :=  nz * Radius;
+               the_Edges (Each).Fore (3) :=  L;
+
+               the_Edges (Each).Aft  (1) :=  ny * Radius;
+               the_Edges (Each).Aft  (2) :=  nz * Radius;
+               the_Edges (Each).Aft  (3) := -L;
+
+               --  Rotate ny, nz.
+               --
+               tmp := ca * ny  -  sa * nz;
+               nz  := sa * ny  +  ca * nz;
+               ny  := tmp;
+
+               the_Vertices (i).Site   := the_Edges (Each).Fore;
+               the_Vertices (i).Coords := (s => S,
+                                           t => 1.0);
+               i := i + 1;
+
+               the_Vertices (i).Site   := the_Edges (Each).Aft;
+               the_Vertices (i).Coords := (s => S,
+                                           t => 0.0);
+               i := i + 1;
+
+               S := S + S_delta;
+            end loop;
+
+            the_Vertices (i).Site   := the_Edges (1).Fore;
+            the_Vertices (i).Coords := (s => S,
+                                        t => 1.0);
+            i := i + 1;
+
+            the_Vertices (i).Site   := the_Edges (1).Aft;
+            the_Vertices (i).Coords := (s => S,
+                                        t => 0.0);
+         end;
+
+         -- Set indices.
+         --
+         declare
+            i     : long_Index_t := 1;
+            Start :      Index_t := 1;
+         begin
+            for Each in 1 .. long_Index_t (sides_Count)
+            loop
+               the_Indices (i) := Start;       i := i + 1;
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               the_Indices (i) := Start + 1;   i := i + 1;
+               the_Indices (i) := Start + 3;   i := i + 1;
+               the_Indices (i) := Start + 2;   i := i + 1;
+
+               Start := Start + 2;
+            end loop;
+         end;
+
+         if Self.Image /= null_Asset
+         then
+            set_Texture:
+            declare
+               use Texture;
+               the_Image   : constant Image          := IO.to_Image      (Self.Image);
+               the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+            begin
+               the_shaft_Geometry.Texture_is (the_Texture);
+            end set_Texture;
+         end if;
+
+         Vertices_are (the_shaft_Geometry.all, the_Vertices);
+
+         declare
+            the_Primitive : constant Primitive.indexed.view
+              := Primitive.indexed.new_Primitive (primitive.Triangles,
+                                                  the_Indices);
+         begin
+            the_shaft_Geometry.add (Primitive.view (the_Primitive));
+         end;
+      end;
+
+
+      declare
+         function new_Cap (is_Fore : Boolean) return Geometry.textured.view
+         is
+            cap_Geometry  : constant Geometry.textured.view
+              := Geometry.textured.new_Geometry;
+
+            hoop_Count    : constant      Index_t := quality_Level;
+            vertex_Count  : constant      Index_t :=      Index_t (Edges'Length * hoop_Count + 1);             -- A vertex for each edge of each hoop, + 1 for the pole.
+            indices_Count : constant long_Index_t := long_Index_t (  (hoop_count - 1) * sides_Count * 2 * 3    -- For each hoop, 2 triangles per side with 3 vertices per triangle
+                                                                   + sides_Count * 3);                         -- plus the extra indices for the pole triangles.
+
+            the_Vertices  : aliased Geometry.textured.Vertex_array := (1 ..  vertex_Count => <>);
+            the_Indices   : aliased Indices                        := (1 .. indices_Count => <>);
+
+            the_arch_Edges : arch_Edges;
+            i              : Index_t   := 1;
+
+            pole_Site      : constant Site := (if is_Fore then (0.0, 0.0,  L + Radius)
+                                                          else (0.0, 0.0, -L - Radius));
+
+            Degrees_90        : constant := Pi / 2.0;
+            Degrees_360       : constant := Pi * 2.0;
+
+            latitude_Count    : constant :=  hoop_Count + 1;
+            longitude_Count   : constant :=  Edges'Length;
+
+            latitude_Spacing  : constant Real := Degrees_90  / Real (latitude_Count - 1);
+            longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
+
+            a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+         begin
+            if not is_Fore
+            then
+               a := Degrees_360;
+            end if;
+
+            -- Set the vertices.
+            --
+            start_nx := 0.0;
+            start_ny := 1.0;
+
+            for each_Hoop in 1 .. quality_Level
+            loop
+               --  Get n=start_n.
+               --
+               nx := start_nx;
+               ny := start_ny;
+               nz := 0.0;
+
+               for Each in 1 .. sides_Count
+               loop
+                  the_arch_Edges (each_Hoop) (Each) (1) :=  ny * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (2) :=  nz * Radius;
+                  the_arch_Edges (each_Hoop) (Each) (3) :=  (if is_Fore then nx * Radius + L
+                                                                        else nx * Radius - L);
+                  --  Rotate ny, nz.
+                  --
+                  tmp := ca * ny  -  sa * nz;
+                  nz  := sa * ny  +  ca * nz;
+                  ny  := tmp;
+
+                  the_Vertices (i).Site   := the_arch_Edges (each_Hoop) (Each);
+                  the_Vertices (i).Coords :=  (s => a / Degrees_360,
+                                               t => b / Degrees_90);
+                  i := i + 1;
+                  a := (if is_Fore then a + longitude_Spacing
+                                   else a - longitude_Spacing);
+               end loop;
+
+               declare
+                  tmp : constant Real := start_nx;
+               begin
+                  if is_Fore
+                  then
+                     start_nx :=  ca * start_nx  +  sa * start_ny;
+                     start_ny := -sa * tmp       +  ca * start_ny;
+                  else
+                     start_nx :=  ca * start_nx  -  sa * start_ny;
+                     start_ny :=  sa * tmp       +  ca * start_ny;
+                  end if;
+               end;
+
+               a := (if is_Fore then 0.0
+                                else Degrees_360);
+               b := b + latitude_Spacing;
+            end loop;
+
+            -- Add pole vertex.
+            --
+            the_Vertices (i).Site   := pole_Site;
+            the_Vertices (i).Coords := (s => 0.5,
+                                        t => 1.0);
+            -- Set indices.
+            --
+            declare
+               i          :     long_Index_t := 1;
+               Start      :          Index_t := 1;
+               hoop_Start :          Index_t := 1;
+               pole_Index : constant Index_t := vertex_Count;
+
+            begin
+               for each_Hoop in 1 .. quality_Level
+               loop
+                  for Each in 1 .. sides_Count
+                  loop
+                     declare
+                        function next_hoop_Vertex return Index_t
+                        is
+                        begin
+                           if Each = sides_Count then return hoop_Start;
+                           else                       return Start + 1;
+                           end if;
+                        end next_hoop_Vertex;
+                     begin
+                        if each_Hoop = quality_Level
+                        then
+                           if is_Fore
+                           then
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                           else
+                              the_Indices (i) := Start;              i := i + 1;
+                              the_Indices (i) := pole_Index;         i := i + 1;
+                              the_Indices (i) := next_hoop_Vertex;   i := i + 1;
+                           end if;
+                        else
+                           declare
+                              v1 : constant Index_t := Start;
+                              v2 : constant Index_t := next_hoop_Vertex;
+                              v3 : constant Index_t := v1 + sides_Count;
+                              v4 : constant Index_t := v2 + sides_Count;
+                           begin
+                              if is_Fore
+                              then
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                              else
+                                 the_Indices (i) := v1;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v2;   i := i + 1;
+
+                                 the_Indices (i) := v2;   i := i + 1;
+                                 the_Indices (i) := v3;   i := i + 1;
+                                 the_Indices (i) := v4;   i := i + 1;
+                              end if;
+                           end;
+                        end if;
+
+                        Start := Start + 1;
+                     end;
+                  end loop;
+
+                  hoop_Start := hoop_Start + sides_Count;
+               end loop;
+
+               if Self.Image /= null_Asset
+               then
+                  set_the_Texture:
+                  declare
+                     use Texture;
+                     the_Image   : constant Image          := IO.to_Image      (Self.Image);
+                     the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
+                  begin
+                     cap_Geometry.Texture_is (the_Texture);
+                  end set_the_Texture;
+               end if;
+
+               Vertices_are (cap_Geometry.all, the_Vertices);
+
+               declare
+                  the_Primitive : constant Primitive.indexed.view
+                    := Primitive.indexed.new_Primitive (Primitive.Triangles,
+                                                        the_Indices);
+               begin
+                  cap_Geometry.add (Primitive.view (the_Primitive));
+               end;
+            end;
+
+            return cap_Geometry;
+         end new_Cap;
+
+      begin
+         cap_1_Geometry := new_Cap (is_Fore => True);
+         cap_2_Geometry := new_Cap (is_Fore => False);
+      end;
+
+      return (1 => the_shaft_Geometry.all'Access,
+              2 =>     cap_1_Geometry.all'Access,
+              3 =>     cap_2_Geometry.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.capsule.textured;

3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads

@@ -0,0 +1,42 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.capsule.textured
+--
+--  Models a lit and textured capsule.
+--
+is
+   type Item is new Model.capsule.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Capsule (Radius : in Real;
+                         Height : in Real;
+                         Image  : in asset_Name := null_Asset) 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;
+
+
+
+private
+
+   type Item is new Model.capsule.item with
+      record
+         Radius : Real;
+         Height : Real;
+
+         Image  : asset_Name := null_Asset;
+      end record;
+
+end openGL.Model.capsule.textured;

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

@@ -0,0 +1,9 @@
+package openGL.Model.capsule
+--
+--  Provides an abstract base class for capsule models.
+--
+is
+
+   type Item is abstract new openGL.Model.item with null record;
+
+end openGL.Model.capsule;

3-mid/opengl/source/lean/model/opengl-model-grid.adb

@@ -0,0 +1,172 @@
+with
+     openGL.Palette,
+     openGL.Primitive.non_indexed;
+
+
+package body openGL.Model.grid
+is
+
+   function Line_Count (Extent : in Positive) return Positive
+   is
+   begin
+      if Extent mod 2  /=  0
+      then
+         return Extent;
+      else
+         return Extent + 1;
+      end if;
+   end Line_Count;
+
+
+   ---------
+   --- Forge
+   --
+
+   function to_grid_Model (Color  : openGL.Color;
+                           Width  : Integer;
+                           Height : Integer) return Item
+   is
+      Self : Item;
+
+      vertex_Count : constant Positive := (  line_Count (Width)
+                                           + line_Count (Height))  *  2;
+
+      half_Width   : constant Real := Real (Width)  / 2.0;
+      half_Height  : constant Real := Real (Height) / 2.0;
+   begin
+      Self.Color  := +Color;
+      Self.Width  := Width;
+      Self.Height := Height;
+      Self.Bounds := (Ball => <>,
+                      Box  => (lower => [-half_Width, -half_Height, -0.01],
+                               upper => [ half_Width,  half_Height,  0.01]));
+      set_Ball_from_Box (Self.Bounds);
+
+      Self.Vertices := new Geometry.colored.Vertex_array (1 .. Index_t (vertex_Count));
+
+      return Self;
+   end to_grid_Model;
+
+
+   function new_grid_Model (Color  : openGL.Color;
+                            Width  : Integer;
+                            Height : Integer) return View
+   is
+   begin
+      return new Item' (to_grid_Model (Color, Width, Height));
+   end new_grid_Model;
+
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Palette,
+          Geometry.colored;
+
+      the_Primitive : Primitive.non_indexed.view;
+
+   begin
+      if Self.Geometry = null
+      then
+         Self.Geometry := Geometry.colored.new_Geometry;
+      end if;
+
+      set_Sites :
+      declare
+         row_Count    : constant Positive := line_Count (Self.Height);
+         col_Count    : constant Positive := line_Count (Self.Width);
+         vertex_Count :          Index_t  := 0;
+
+         half_Width   : constant Real     := Real (Self.Width)  / 2.0;
+         half_Height  : constant Real     := Real (Self.Height) / 2.0;
+
+         x_Adjust,
+         y_Adjust : Real;
+
+         Color : openGL.rgb_Color := Self.Color;
+
+      begin
+         if Self.Width  mod 2 = 0
+         then   x_Adjust := 0.0;
+         else   x_Adjust := 0.5;
+         end if;
+
+         if Self.Height mod 2 = 0
+         then   y_Adjust := 0.0;
+         else   y_Adjust := 0.5;
+         end if;
+
+         for Row in 1 .. row_Count
+         loop
+            if Row = row_Count / 2 + 1
+            then
+               Color := +White;
+            end if;
+
+            vertex_Count                       := vertex_Count + 1;
+            Self.Vertices (vertex_Count).Site  := [-half_Width,
+                                                   Real (Row - 1) - half_Height + y_Adjust,
+                                                   0.16];
+            Self.Vertices (vertex_Count).Color := (primary => Color,
+                                                   Alpha => opaque_Value);
+
+            vertex_Count                       := vertex_Count + 1;
+            Self.Vertices (vertex_Count).Site  := [half_Width,
+                                                   Real (Row - 1) - half_Height + y_Adjust,
+                                                   0.16];
+            Self.Vertices (vertex_Count).Color := (primary => Color,
+                                                   Alpha   => opaque_Value);
+            if Row = row_Count / 2 + 1
+            then
+               Color := Self.Color;
+            end if;
+         end loop;
+
+         for Col in 1 .. col_Count
+         loop
+            if Col = col_Count / 2 + 1
+            then
+               Color := +White;
+            end if;
+
+            vertex_Count                       := vertex_Count + 1;
+            Self.Vertices (vertex_Count).Site  := [Real (Col - 1) - half_Width + x_Adjust,
+                                                   -half_Height,
+                                                   0.16];
+            Self.Vertices (vertex_Count).Color := (primary => Color,
+                                                   Alpha   => opaque_Value);
+
+            vertex_Count                       := vertex_Count + 1;
+            Self.Vertices (vertex_Count).Site  := [Real (Col - 1) - half_Width + x_Adjust,
+                                                   half_Height,
+                                                   0.16];
+            Self.Vertices (vertex_Count).Color := (primary => Color,
+                                                   Alpha => opaque_Value);
+            if Col = col_Count / 2 + 1
+            then
+               Color := Self.Color;
+            end if;
+         end loop;
+      end set_Sites;
+
+      Self.Geometry.is_Transparent (False);
+      Vertices_are (Self.Geometry.all,
+                    Self.Vertices.all);
+
+      the_Primitive := Primitive.non_indexed.new_Primitive (openGL.primitive.Lines,
+                                                            Self.Vertices'Length);
+      Self.Geometry.add (Primitive.view (the_Primitive));
+
+      return [1 => Self.Geometry.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.grid;

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

@@ -0,0 +1,43 @@
+with
+     openGL.Geometry.colored;
+
+
+package openGL.Model.grid
+--
+--  Models a grid.
+--
+--  TODO: Rename to 'line_Grid'.
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_grid_Model (Color  : openGL.Color;
+                            Width  : Integer;
+                            Height : Integer) 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;
+
+
+private
+
+   type Item is new Model.item with
+      record
+         Color    : openGL.rgb_Color;
+         Vertices : openGL.Geometry.colored.Vertex_array_view;
+         Geometry : openGL.Geometry.colored.view;
+         Width,
+         Height   : Positive;
+      end record;
+
+end openGL.Model.grid;

3-mid/opengl/source/lean/model/opengl-model-hex_grid.adb

@@ -0,0 +1,552 @@
+with
+     openGL.Geometry.colored,
+     openGL.Primitive.indexed,
+
+     float_Math.Geometry.d2.Hexagon,
+
+     ada.Containers.hashed_Maps,
+     ada.unchecked_Deallocation;
+
+
+package body openGL.Model.hex_grid
+is
+   --------
+   -- Forge
+   --
+
+   function new_Grid (heights_Asset : in asset_Name;
+                      Heights       : in height_Map_view;
+                      Color         : in lucid_Color    := (palette.White,
+                                                            Opaque)) return View
+   is
+      the_Model : constant View := new Item' (Model.item with
+                                              heights_Asset => heights_Asset,
+                                              Heights       => Heights,
+                                              Color         => +Color);
+   begin
+      the_Model.set_Bounds;
+      return the_Model;
+   end new_Grid;
+
+
+
+   overriding
+   procedure destroy (Self : in out Item)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (height_Map,
+                                                              height_Map_view);
+   begin
+      destroy    (Model.item (Self));
+      deallocate (Self.Heights);
+   end destroy;
+
+
+
+   -------------
+   -- Attributes
+   --
+
+   package hexagon_Geometry renames Geometry_2d.Hexagon;
+
+
+   -- site_Map_of_vertex_Id
+   --
+
+   function Hash (From : in Geometry_2d.Site) return ada.Containers.Hash_type
+   is
+      use ada.Containers;
+
+      type Fix is delta 0.00_1 range 0.0 .. 1000.0;
+
+      cell_Size  : constant Fix := 0.5;
+      grid_Width : constant     := 10;
+   begin
+      return   Hash_type (Fix (From (1)) / cell_Size)
+             + Hash_type (Fix (From (2)) / cell_Size) * grid_Width;
+   end Hash;
+
+
+
+   function Equivalent (S1, S2 : Geometry_2d.Site) return Boolean
+   is
+      Tolerance : constant := 0.1;
+   begin
+      return     abs (S2 (1) - S1 (1)) < Tolerance
+             and abs (S2 (2) - S1 (2)) < Tolerance;
+   end Equivalent;
+
+
+
+   type Coordinates_array is array (Index_t range <>) of hexagon_Geometry.Coordinates;
+
+   type hex_Vertex is
+      record
+         shared_Hexes : Coordinates_array (1 .. 3);
+         shared_Count : Index_t := 0;
+
+         Site         : Geometry_3d.Site;
+      end record;
+
+   type hex_Vertices is array (Index_t range <>) of hex_Vertex;
+
+
+
+   package site_Maps_of_vertex_Id is new ada.Containers.hashed_Maps (Key_type        => Geometry_2d.Site,
+                                                                     Element_type    => Index_t,
+                                                                     Hash            => Hash,
+                                                                     equivalent_Keys => Equivalent,
+                                                                     "="             => "=");
+
+   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 (Textures, Fonts);
+
+      use Geometry,
+          Geometry.colored,
+          Geometry_2d;
+
+      site_Map_of_vertex_Id : site_Maps_of_vertex_Id.Map;
+        next_free_vertex_Id : Index_t := 0;
+
+
+      function fetch_Id (S : in geometry_2d.Site) return Index_t
+      is
+         use site_Maps_of_vertex_Id;
+         C : constant Cursor := site_Map_of_vertex_Id.Find (S);
+      begin
+         if has_Element (C)
+         then
+            return Element (C);
+         else
+            next_free_vertex_Id := @ + 1;
+            site_Map_of_vertex_Id.insert (S, next_free_vertex_Id);
+
+            return next_free_vertex_Id;
+         end if;
+      end fetch_Id;
+
+
+      Heights   : height_Map_view renames Self.Heights;
+
+      row_Count : constant Index_t := Heights'Length (1);
+      col_Count : constant Index_t := Heights'Length (2);
+
+      the_Grid  : constant hexagon_Geometry.Grid := Hexagon.to_Grid (Rows         => Positive (row_Count),
+                                                                     Cols         => Positive (col_Count),
+                                                                     circumRadius => 1.0);
+      zigzag_Count : constant Index_t := col_Count + 1;
+
+      first_zigzag_vertex_Count  : constant Index_t := row_Count * 2 + 1;
+        mid_zigzag_vertex_Count  : constant Index_t := row_Count * 2 + 2;
+       last_zigzag_vertex_Count  : constant Index_t := row_Count * 2 + 1;
+
+      zigzags_vertex_Count       : constant Index_t :=   first_zigzag_vertex_Count
+                                                       + (mid_zigzag_vertex_Count) * (zigzag_Count - 2)
+                                                       + last_zigzag_vertex_Count;
+      zigzag_joiner_vertex_Count : constant Index_t := col_Count * 2;
+
+
+      vertex_Count  : constant Index_t :=         zigzags_vertex_Count
+                                          + zigzag_joiner_vertex_Count;
+
+      hex_Vertices  : hex_Grid.hex_Vertices (1 .. zigzags_vertex_Count);
+
+      zigzags_indices_Count : constant long_Index_t := long_Index_t (vertex_Count);
+
+      gl_Vertices      : aliased  Geometry.colored.Vertex_array (1 .. vertex_Count);
+
+      hex_Count        : constant long_Index_t := long_Index_t (col_Count * row_Count * 2);
+
+      zigzags_Indices  : aliased  Indices (1 .. zigzags_indices_Count);
+      tops_Indices     : aliased  Indices (1 ..   hex_Count
+                                                + long_Index_t (col_Count * 2));
+
+      zigzags_Geometry : constant Geometry.colored.view := Geometry.colored.new_Geometry;
+         tops_Geometry : constant Geometry.colored.view := Geometry.colored.new_Geometry;
+
+
+      min_Site : Site := [Real'Last,  Real'Last,  Real'Last];
+      max_Site : Site := [Real'First, Real'First, Real'First];
+
+   begin
+
+      find_shared_Hexes_per_Vertex:
+      begin
+         for Row in 1 .. row_Count
+         loop
+
+            for Col in 1 .. col_Count
+            loop
+
+               for Which in hexagon_Geometry.vertex_Id
+               loop
+                  declare
+                     use hexagon_Geometry;
+                     Site       : constant Geometry_2d.Site := vertex_Site (the_Grid,
+                                                                            hex_Id => [Positive (Row),
+                                                                                       Positive (Col)],
+                                                                            Which  => Which);
+
+                     vertex_Id  : constant Index_t    :=      fetch_Id (S => Site);
+                     the_Vertex :          hex_Vertex renames hex_Vertices (vertex_Id);
+                     C          : constant Index_t    :=      the_Vertex.shared_Count + 1;
+                  begin
+                     the_Vertex.shared_Count     := C;
+                     the_Vertex.shared_Hexes (C) := [Positive (Row),
+                                                     Positive (Col)];
+                     the_Vertex.Site := [Site (1),
+                                         0.0,
+                                         Site (2)];
+                  end;
+               end loop;
+
+            end loop;
+
+         end loop;
+      end find_shared_Hexes_per_Vertex;
+
+
+      set_Height_for_each_Vertex:
+      begin
+         for Row in 1 .. row_Count
+         loop
+
+            for Col in 1 .. col_Count
+            loop
+
+               for Which in hexagon_Geometry.vertex_Id
+               loop
+                  declare
+                     use hexagon_Geometry;
+                     Site       : constant Geometry_2d.Site := vertex_Site (the_Grid,
+                                                                            hex_Id => [Positive (Row),
+                                                                                       Positive (Col)],
+                                                                            Which  => Which);
+                     Height     :          Real       :=      0.0;
+                     vertex_Id  : constant Index_t    :=      fetch_Id (S => Site);
+                     the_Vertex :          hex_Vertex renames hex_Vertices (vertex_Id);
+                  begin
+                     for Each in 1 .. the_Vertex.shared_Count
+                     loop
+                        Height := Height + Heights (Row, Col);
+                     end loop;
+
+                     Height          := Height / Real (the_Vertex.shared_Count);
+                     the_Vertex.Site := [Site (1),
+                                         Height,
+                                         Site (2)];
+
+                     min_Site := [Real'Min (min_Site (1), the_Vertex.Site (1)),
+                                  Real'Min (min_Site (2), the_Vertex.Site (2)),
+                                  Real'Min (min_Site (3), the_Vertex.Site (3))];
+
+                     max_Site := [Real'Max (min_Site (1), the_Vertex.Site (1)),
+                                  Real'Max (min_Site (2), the_Vertex.Site (2)),
+                                  Real'Max (min_Site (3), the_Vertex.Site (3))];
+                  end;
+               end loop;
+
+            end loop;
+
+         end loop;
+      end set_Height_for_each_Vertex;
+
+
+      set_GL_Vertices:
+      declare
+         Center    : constant Site := [(max_Site (1) - min_Site (1)) / 2.0,
+                                       (max_Site (2) - min_Site (2)) / 2.0,
+                                       (max_Site (3) - min_Site (3)) / 2.0];
+
+         vertex_Id :          Index_t    := 0;
+         Color     : constant rgba_Color := Self.Color;
+      begin
+         --- Add hex vertices.
+         --
+         for i in hex_Vertices'Range
+         loop
+            vertex_Id := vertex_Id + 1;
+
+            gl_Vertices (vertex_Id).Site  := hex_Vertices (vertex_Id).Site - Center;
+            gl_Vertices (vertex_Id).Color := Color;
+         end loop;
+
+         --- Add joiner vertices.
+         --
+         for i in 1 .. col_Count
+         loop
+            declare
+               use hexagon_Geometry;
+
+               Site : Geometry_2d.Site := vertex_Site (the_Grid,
+                                                       hex_Id => [Row => Positive (row_Count),
+                                                                  Col => Positive (i)],
+                                                       Which  => 3);
+               hex_vertex_Id : Index_t := fetch_Id (Site);
+            begin
+               vertex_Id               := vertex_Id + 1;
+               gl_Vertices (vertex_Id) := (Site  => hex_Vertices (hex_vertex_Id).Site - Center,
+                                           Color => (Primary => Color.Primary,
+                                                     Alpha   => 0));
+
+               Site                    := vertex_Site (the_Grid,
+                                                       hex_Id => [Row => 1,
+                                                                  Col => Positive (i)],
+                                                       Which  => 6);
+
+               hex_vertex_Id           := fetch_Id (Site);
+               vertex_Id               := vertex_Id + 1;
+               gl_Vertices (vertex_Id) := (Site  => hex_Vertices (hex_vertex_Id).Site - Center,
+                                           Color => (Primary => Color.Primary,
+                                                     Alpha   => 0));
+            end;
+         end loop;
+      end set_GL_Vertices;
+
+
+      set_zigzags_GL_Indices:
+      declare
+         Cursor            : long_Index_t := 0;
+         joiners_vertex_Id :      Index_t := zigzags_vertex_Count;
+
+
+         procedure add_zigzag_Vertex (Row, Col   : in Positive;
+                                      hex_Vertex : in Hexagon.vertex_Id)
+         is
+            use hexagon_Geometry;
+
+            Site : constant Geometry_2d.Site := vertex_Site (the_Grid,
+                                                             hex_Id => [Row, Col],
+                                                             Which  => hex_Vertex);
+         begin
+            Cursor                   := Cursor + 1;
+            zigzags_Indices (Cursor) := fetch_Id (S => Site);
+         end add_zigzag_Vertex;
+
+
+         procedure add_joiner_vertex_Pair
+         is
+         begin
+            Cursor                   := Cursor + 1;
+            joiners_vertex_Id        := joiners_vertex_Id + 1;
+            zigzags_Indices (Cursor) := joiners_vertex_Id;
+
+            Cursor                   := Cursor + 1;
+            joiners_vertex_Id        := joiners_vertex_Id + 1;
+            zigzags_Indices (Cursor) := joiners_vertex_Id;
+         end add_joiner_vertex_Pair;
+
+
+      begin
+         --- Fist zigzag
+         --
+         add_zigzag_Vertex (Row => 1, Col => 1, hex_Vertex => 5);
+
+         for Row in 1 .. Positive (row_Count)
+         loop
+            add_zigzag_Vertex (Row, Col => 1, hex_Vertex => 4);
+            add_zigzag_Vertex (Row, Col => 1, hex_Vertex => 3);
+         end loop;
+
+         add_joiner_vertex_Pair;
+
+
+         --- Middles zigzags
+         --
+
+         for zz in 2 .. Positive (zigzag_Count) - 1
+         loop
+            declare
+               odd_Zigzag : constant Boolean := zz mod 2 = 1;
+            begin
+               if odd_Zigzag
+               then
+                  add_zigzag_Vertex (Row => 1, Col => Positive (zz),     hex_Vertex => 5);
+
+               else -- Even zigzag.
+                  add_zigzag_Vertex (Row => 1, Col => Positive (zz - 1), hex_Vertex => 6);
+               end if;
+
+
+               for Row in 1 .. Positive (row_Count)
+               loop
+                  if odd_Zigzag
+                  then
+                     add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 4);
+                     add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 3);
+
+                     if Row = Positive (row_Count)     -- Last row.
+                     then
+                        add_zigzag_Vertex (Row, Col => zz - 1, hex_Vertex => 2);
+                     end if;
+
+                  else -- Even zigzag.
+                     add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 5);
+                     add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 4);
+
+                     if Row = Positive (row_Count)     -- Last row.
+                     then
+                        add_zigzag_Vertex (Row, Col => zz, hex_Vertex => 3);
+                     end if;
+                  end if;
+               end loop;
+            end;
+
+            add_joiner_vertex_Pair;
+         end loop;
+
+
+         --- Last zigzag
+         --
+         add_zigzag_Vertex (Row => 1, Col => Positive (col_Count), hex_Vertex => 6);
+
+         for Row in 1 .. Positive (row_Count)
+         loop
+            add_zigzag_Vertex (Row, Positive (col_Count), hex_Vertex => 1);
+            add_zigzag_Vertex (Row, Positive (col_Count), hex_Vertex => 2);
+         end loop;
+
+      end set_zigzags_GL_Indices;
+
+
+      zigzags_Geometry.is_Transparent (False);
+      zigzags_Geometry.Vertices_are   (gl_Vertices);
+
+
+      set_tops_GL_Indices:
+      declare
+         Cursor : long_Index_t := 0;
+      begin
+         for Col in 1 .. col_Count
+         loop
+            for Row in 1 .. row_Count
+            loop
+               declare
+                  use hexagon_Geometry;
+                  Site : Geometry_2d.Site := vertex_Site (the_Grid,
+                                                          hex_Id => [Positive (Row),
+                                                                     Positive (Col)],
+                                                          Which  => 5);
+               begin
+                  Cursor                := Cursor + 1;
+                  tops_Indices (Cursor) := fetch_Id (Site);
+
+                  Site := vertex_Site (the_Grid,
+                                       hex_Id => [Positive (Row),
+                                                  Positive (Col)],
+                                       Which  => 6);
+
+                  Cursor                := Cursor + 1;
+                  tops_Indices (Cursor) := fetch_Id (Site);
+
+                  if Row = row_Count     -- Last row, so do bottoms.
+                  then
+                     Site := vertex_Site (the_Grid,
+                                          hex_Id => [Positive (Row),
+                                                     Positive (Col)],
+                                          Which  => 3);
+
+                     Cursor                := Cursor + 1;
+                     tops_Indices (Cursor) := fetch_Id (Site);
+
+                     Site := vertex_Site (the_Grid,
+                                          hex_Id => [Positive (Row),
+                                                     Positive (Col)],
+                                          Which  => 2);
+
+                     Cursor                := Cursor + 1;
+                     tops_Indices (Cursor) := fetch_Id (Site);
+                  end if;
+               end;
+            end loop;
+         end loop;
+      end set_tops_GL_Indices;
+
+
+      tops_Geometry.is_Transparent (False);
+      tops_Geometry.Vertices_are   (gl_Vertices);
+
+
+      add_zigzag_Geometry:
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.line_Strip,
+                                               zigzags_Indices);
+      begin
+         zigzags_Geometry.add (Primitive.view (the_Primitive));
+      end add_zigzag_Geometry;
+
+
+      add_tops_Geometry:
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.Lines,
+                                               tops_Indices);
+      begin
+         tops_Geometry.add (Primitive.view (the_Primitive));
+      end add_tops_Geometry;
+
+
+      return [1 => Geometry.view (zigzags_Geometry),
+              2 => Geometry.view (   tops_Geometry)];
+   end to_GL_Geometries;
+
+
+
+   -- TODO: This is an approximation based on a rectangular grid.
+   --       Do a correct calculation based on the hexagon grid vertices.
+   --
+   overriding
+   procedure set_Bounds (Self : in out Item)
+   is
+      Heights      : height_Map_view renames Self.Heights;
+
+      row_Count    : constant Index_t := Heights'Length (1) - 1;
+      col_Count    : constant Index_t := Heights'Length (2) - 1;
+
+      vertex_Count : constant Index_t := Heights'Length (1) * Heights'Length (2);
+
+      the_Sites    : aliased  Sites (1 .. vertex_Count);
+
+      the_Bounds   : openGL.Bounds    := null_Bounds;
+
+   begin
+      set_Sites:
+      declare
+         vert_Id          :          Index_t  := 0;
+         the_height_Range : constant Vector_2 := height_Extent (Heights.all);
+         Middle           : constant Real     :=   (the_height_Range (1) + the_height_Range (2))
+                                                 / 2.0;
+      begin
+         for Row in 1 .. row_Count + 1
+         loop
+            for Col in 1 .. col_Count + 1
+            loop
+               vert_Id             := vert_Id + 1;
+               the_Sites (vert_Id) := [Real (Col)         - Real (col_Count) / 2.0 - 1.0,
+                                       Heights (Row, Col) - Middle,
+                                       Real (Row)         - Real (row_Count) / 2.0 - 1.0];
+
+               the_Bounds.Box.Lower (1) := Real'Min (the_Bounds.Box.Lower (1),  the_Sites (vert_Id) (1));
+               the_Bounds.Box.Lower (2) := Real'Min (the_Bounds.Box.Lower (2),  the_Sites (vert_Id) (2));
+               the_Bounds.Box.Lower (3) := Real'Min (the_Bounds.Box.Lower (3),  the_Sites (vert_Id) (3));
+
+               the_Bounds.Box.Upper (1) := Real'Max (the_Bounds.Box.Upper (1),  the_Sites (vert_Id) (1));
+               the_Bounds.Box.Upper (2) := Real'Max (the_Bounds.Box.Upper (2),  the_Sites (vert_Id) (2));
+               the_Bounds.Box.Upper (3) := Real'Max (the_Bounds.Box.Upper (3),  the_Sites (vert_Id) (3));
+
+               the_Bounds.Ball := Real'Max (the_Bounds.Ball,
+                                            abs (the_Sites (vert_Id)));
+            end loop;
+         end loop;
+
+         the_Bounds.Ball := the_Bounds.Ball * 1.1;     -- TODO: Why the '* 1.1' ?
+      end set_Sites;
+
+      Self.Bounds := the_Bounds;
+   end set_Bounds;
+
+
+end openGL.Model.hex_grid;

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

@@ -0,0 +1,53 @@
+with
+     openGL.Geometry,
+     openGL.Palette;
+
+
+package openGL.Model.hex_grid
+--
+--  Models a regular hexagon grid.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+
+   type height_Map_view is access all height_Map;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Grid (heights_Asset : in asset_Name;
+                      Heights       : in height_Map_view;
+                      Color         : in lucid_Color := (palette.White,
+                                                         Opaque)) return View;
+   overriding
+   procedure destroy (Self : in out Item);
+
+
+   --------------
+   --- 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;
+
+
+private
+
+   type Item is new Model.item with
+      record
+         heights_Asset : asset_Name     := null_Asset;
+         Heights       : height_Map_view;
+         Color         : rgba_Color;
+      end record;
+
+
+   overriding
+   procedure set_Bounds (Self : in out Item);
+
+
+end openGL.Model.hex_grid;

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

@@ -0,0 +1,79 @@
+with
+     openGL.Geometry.lit_colored,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.hexagon.lit_colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Hexagon (Radius : in Real;
+                         Face   : in lit_colored.Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Face   := Face;
+
+      return Self;
+   end new_Hexagon;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry.lit_colored;
+
+      the_Sites    :         constant hexagon.Sites := vertex_Sites (Self.Radius);
+      the_Indices  : aliased constant Indices       := [1, 2, 3, 4, 5, 6, 7, 2];
+
+
+      function new_Face (Vertices : in geometry.lit_colored.Vertex_array) return Geometry.lit_colored.view
+      is
+         use Primitive;
+
+         the_Geometry  : constant Geometry.lit_colored.view
+           := Geometry.lit_colored.new_Geometry;
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_Face;
+
+
+      upper_Face : Geometry.lit_colored.view;
+
+   begin
+      --  Upper Face
+      --
+      declare
+         the_Vertices : constant Geometry.lit_colored.Vertex_array
+           := [1 => (Site => [0.0, 0.0, 0.0],  Normal => Normal,  Color => +Self.Face.center_Color, Shine => default_Shine),
+               2 => (Site =>   the_Sites (1),  Normal => Normal,  Color => +Self.Face.Colors (1),   Shine => default_Shine),
+               3 => (Site =>   the_Sites (2),  Normal => Normal,  Color => +Self.Face.Colors (2),   Shine => default_Shine),
+               4 => (Site =>   the_Sites (3),  Normal => Normal,  Color => +Self.Face.Colors (3),   Shine => default_Shine),
+               5 => (Site =>   the_Sites (4),  Normal => Normal,  Color => +Self.Face.Colors (4),   Shine => default_Shine),
+               6 => (Site =>   the_Sites (5),  Normal => Normal,  Color => +Self.Face.Colors (5),   Shine => default_Shine),
+               7 => (Site =>   the_Sites (6),  Normal => Normal,  Color => +Self.Face.Colors (6),   Shine => default_Shine)];
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices);
+      end;
+
+      return [1 => upper_Face.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.hexagon.lit_colored;

3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored.ads

@@ -0,0 +1,45 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon.lit_colored
+--
+--  Models a lit and colored hexagon.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+   type Face is
+      record
+         center_Color : lucid_Color;                                           --  The color at the center of the hex.
+         Colors       : lucid_Colors (1 .. 6);                                 --  The color at each of the hexes 6 vertices.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Hexagon (Radius : in Real;
+                         Face   : in lit_colored.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;
+
+
+private
+
+   type Item is new Model.hexagon.item with
+      record
+         Face : lit_colored.Face;
+      end record;
+
+end openGL.Model.hexagon.lit_colored;

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

@@ -0,0 +1,89 @@
+with
+     openGL.Geometry.lit_colored_textured,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.hexagon.lit_colored_textured
+is
+
+   type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Hexagon (Radius : in Real;
+                         Face   : in lit_colored_textured.Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Face   := Face;
+
+      return Self;
+   end new_Hexagon;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry.lit_colored_textured,
+          Texture;
+
+      the_Sites    :         constant hexagon.Sites := vertex_Sites (Self.Radius);
+      the_Indices  : aliased constant Indices       := (1, 2, 3, 4, 5, 6, 7, 2);
+
+
+      function new_Face (Vertices : in geometry.lit_colored_textured.Vertex_array) return Geometry_view
+      is
+         use Primitive;
+
+         the_Geometry  : constant Geometry_view
+           := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_Face;
+
+
+      upper_Face : Geometry_view;
+
+   begin
+      --  Upper Face
+      --
+      declare
+         the_Vertices : constant Geometry.lit_colored_textured.Vertex_array
+           := (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site =>   the_Sites (1), Normal => Normal, Color => +Self.Face.Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site =>   the_Sites (2), Normal => Normal, Color => +Self.Face.Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site =>   the_Sites (3), Normal => Normal, Color => +Self.Face.Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site =>   the_Sites (4), Normal => Normal, Color => +Self.Face.Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site =>   the_Sites (5), Normal => Normal, color => +Self.Face.Colors (5),   Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site =>   the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6),   Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Face.Texture /= null_Object
+         then
+            upper_Face.Texture_is (Self.Face.Texture);
+         end if;
+      end;
+
+      return (1 => upper_Face.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.hexagon.lit_colored_textured;

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

@@ -0,0 +1,46 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon.lit_colored_textured
+--
+--  Models a lit, colored and textured hexagon.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+   type Face is
+      record
+         center_Color : lucid_Color;                                           --  The color at the center of the hex.
+         Colors       : lucid_Colors (1 .. 6);                                 --  The color at each of the hexes 6 vertices.
+         Texture      : openGL.Texture.Object := openGL.Texture.null_Object;   --  The texture to be applied to the hex..
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Hexagon (Radius : in Real;
+                         Face   : in lit_colored_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;
+
+
+private
+
+   type Item is new Model.hexagon.item with
+      record
+         Face : lit_colored_textured.Face;
+      end record;
+
+end openGL.Model.hexagon.lit_colored_textured;

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

@@ -0,0 +1,85 @@
+with
+     openGL.Geometry.lit_textured,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.hexagon.lit_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Hexagon (Radius : in Real;
+                         Face   : in lit_textured.Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Face   := Face;
+
+      return Self;
+   end new_Hexagon;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry.lit_textured,
+          Texture;
+
+      the_Sites    :         constant hexagon.Sites := vertex_Sites (Self.Radius);
+      the_Indices  : aliased constant Indices       := (1, 2, 3, 4, 5, 6, 7, 2);
+
+
+      function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
+      is
+         use Primitive;
+
+         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);
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_Face;
+
+
+      upper_Face : Geometry.lit_textured.view;
+
+   begin
+      --  Upper Face
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := (1 => (Site => (0.0, 0.0, 0.0),  Normal => Normal,  Coords => (0.0, 0.0),  Shine => default_Shine),
+               2 => (Site =>   the_Sites (1),  Normal => Normal,  Coords => (0.0, 0.0),  Shine => default_Shine),
+               3 => (Site =>   the_Sites (2),  Normal => Normal,  Coords => (1.0, 0.0),  Shine => default_Shine),
+               4 => (Site =>   the_Sites (3),  Normal => Normal,  Coords => (1.0, 1.0),  Shine => default_Shine),
+               5 => (Site =>   the_Sites (4),  Normal => Normal,  Coords => (0.0, 1.0),  Shine => default_Shine),
+               6 => (Site =>   the_Sites (5),  Normal => Normal,  Coords => (0.0, 1.0),  Shine => default_Shine),
+               7 => (Site =>   the_Sites (6),  Normal => Normal,  Coords => (0.0, 1.0),  Shine => default_Shine));
+      begin
+         upper_Face := new_Face (Vertices => the_Vertices);
+
+         if Self.Face.Texture /= null_Object
+         then
+            upper_Face.Texture_is (Self.Face.Texture);
+         end if;
+      end;
+
+      return (1 => upper_Face.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.hexagon.lit_textured;

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

@@ -0,0 +1,44 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon.lit_textured
+--
+--  Models a lit, colored and textured hexagon.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+   type Face is
+      record
+         Texture : openGL.Texture.Object := openGL.Texture.null_Object;   -- The texture to be applied to the hex.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Hexagon (Radius : in Real;
+                         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;
+
+
+private
+
+   type Item is new Model.hexagon.item with
+      record
+         Face : lit_textured.Face;
+      end record;
+
+end openGL.Model.hexagon.lit_textured;

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

@@ -0,0 +1,24 @@
+package body openGL.Model.hexagon
+is
+
+   function vertex_Sites (Radius : in Real) return Sites
+   is
+      use linear_Algebra_3d;
+
+      the_Site  :          Vector_3   := [Radius, 0.0, 0.0];
+      Rotation  : constant Matrix_3x3 := y_Rotation_from (to_Radians (60.0));
+
+      the_Sites :          Sites;
+
+   begin
+      for i in the_Sites'Range
+      loop
+         the_Sites (i) := the_Site;
+         the_Site      := Rotation * the_Site;
+      end loop;
+
+      return the_Sites;
+   end vertex_Sites;
+
+
+end openGL.Model.hexagon;

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

@@ -0,0 +1,25 @@
+package openGL.Model.hexagon
+--
+--  Provides an abstract model of a hexagon.
+--
+is
+   type Item is abstract new Model.item with private;
+
+
+   subtype site_Id is Integer range 1 .. 6;
+   type    Sites   is array (site_Id) of Vector_3;
+
+   function vertex_Sites (Radius : in Real) return Sites;
+
+
+
+private
+
+   type Item is abstract new Model.item with
+      record
+         Radius : Real := 1.0;
+      end record;
+
+   Normal : constant Vector_3 := [0.0, 0.0, 1.0];
+
+end openGL.Model.Hexagon;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.adb

@@ -0,0 +1,244 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.lit_colored,
+     openGL.Model.hexagon;
+
+
+package body openGL.Model.Hexagon_Column.lit_colored_faceted
+is
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in   hex_Face;
+                                Shaft  : in shaft_Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius     := Radius;
+      Self.Height     := Height;
+      Self.upper_Face := Upper;
+      Self.lower_Face := Lower;
+      Self.Shaft      := Shaft;
+
+      return Self;
+   end new_hexagon_Column;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts, Textures);
+
+      use Geometry.lit_colored,
+          Model.hexagon;
+
+      shaft_Height  : constant Real     := Self.Height;
+      height_Offset : constant Vector_3 := [0.0, shaft_Height / 2.0, 0.0];
+
+      mid_Sites     : constant hexagon.Sites := vertex_Sites (Self.Radius);
+      upper_Sites   :          hexagon.Sites := mid_Sites;
+      lower_Sites   :          hexagon.Sites := mid_Sites;
+
+
+      function new_hexagon_Face (Vertices : access Geometry.lit_colored.Vertex_array;
+                                 Flip     : in     Boolean := False) return Geometry.lit_colored.view
+      is
+         use Primitive;
+
+         function the_Indices return Indices
+         is
+         begin
+            if Flip
+            then   return [1, 7, 6, 5, 4, 3, 2, 7];
+            else   return [1, 2, 3, 4, 5, 6, 7, 2];
+            end if;
+         end the_Indices;
+
+         the_Geometry  : constant Geometry.lit_colored.view
+           := Geometry.lit_colored.new_Geometry;
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Fan,
+                                               the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_hexagon_Face;
+
+
+      function new_shaft_Face (Vertices : access Geometry.lit_colored.Vertex_array)
+                               return Geometry.lit_colored.view
+      is
+         use Primitive;
+
+         the_Indices   : constant Indices := [1, 2, 3, 4];
+
+         the_Geometry  : constant Geometry.lit_colored.view
+           := Geometry.lit_colored.new_Geometry;
+
+         the_Primitive : constant Primitive.view
+           := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_shaft_Face;
+
+
+      upper_Face  : Geometry.lit_colored.view;
+      lower_Face  : Geometry.lit_colored.view;
+
+      shaft_Faces : array (1 .. 6) of Geometry.lit_colored.view;
+
+   begin
+      for Each in mid_Sites'Range
+      loop
+         upper_Sites (Each) := upper_Sites (Each) + height_Offset;
+         lower_Sites (Each) := lower_Sites (Each) - height_Offset;
+      end loop;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := [1 => (Site => height_Offset,     Normal => Normal,   Color => +Self.upper_Face.center_Color,   Shine => default_Shine),
+               2 => (Site => upper_Sites (1),   Normal => Normal,   Color => +Self.upper_Face.Colors (1),     Shine => default_Shine),
+               3 => (Site => upper_Sites (2),   Normal => Normal,   Color => +Self.upper_Face.Colors (2),     Shine => default_Shine),
+               4 => (Site => upper_Sites (3),   Normal => Normal,   Color => +Self.upper_Face.Colors (3),     Shine => default_Shine),
+               5 => (Site => upper_Sites (4),   Normal => Normal,   Color => +Self.upper_Face.Colors (4),     Shine => default_Shine),
+               6 => (Site => upper_Sites (5),   Normal => Normal,   Color => +Self.upper_Face.Colors (5),     Shine => default_Shine),
+               7 => (Site => upper_Sites (6),   Normal => Normal,   Color => +Self.upper_Face.Colors (6),     Shine => default_Shine)];
+      begin
+         upper_Face := new_hexagon_Face (Vertices => the_Vertices'Access);
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored.Vertex_array
+           := [1 => (Site => -height_Offset,    Normal => -Normal,   Color => +Self.upper_Face.center_Color,   Shine => default_Shine),
+               2 => (Site =>  lower_Sites (1),  Normal => -Normal,   Color => +Self.upper_Face.Colors (1),     Shine => default_Shine),
+               3 => (Site =>  lower_Sites (2),  Normal => -Normal,   Color => +Self.upper_Face.Colors (2),     Shine => default_Shine),
+               4 => (Site =>  lower_Sites (3),  Normal => -Normal,   Color => +Self.upper_Face.Colors (3),     Shine => default_Shine),
+               5 => (Site =>  lower_Sites (4),  Normal => -Normal,   Color => +Self.upper_Face.Colors (4),     Shine => default_Shine),
+               6 => (Site =>  lower_Sites (5),  Normal => -Normal,   Color => +Self.upper_Face.Colors (5),     Shine => default_Shine),
+               7 => (Site =>  lower_Sites (6),  Normal => -Normal,   Color => +Self.upper_Face.Colors (6),     Shine => default_Shine)];
+      begin
+         lower_Face := new_hexagon_Face (Vertices => the_Vertices'Access,
+                                         Flip     => True);
+      end;
+
+
+      --  Shaft
+      --
+      declare
+         type shaft_Normals is array (1 .. 6) of Vector_3;
+
+
+         function get_Normals return shaft_Normals
+         is
+            use linear_Algebra_3D;
+
+            Rotation   : constant Matrix_3x3   := y_Rotation_from (to_Radians (60.0));
+            the_Normal :          Vector_3     := [0.0, 0.0, -1.0];
+            Result     :          shaft_Normals;
+         begin
+            Result (2) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (3) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (4) := the_Normal;
+
+            the_Normal := [0.0, 0.0, 1.0];
+            Result (5) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (6) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (1) := the_Normal;
+
+            return Result;
+         end get_Normals;
+
+
+         Normals     : constant shaft_Normals :=  get_Normals;
+         shaft_Color : constant rgba_Color    := +Self.Shaft.Color;
+
+         the_Vertices_1 : aliased Geometry.lit_colored.Vertex_array
+           := [1  => (Site => upper_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Shine => default_Shine),
+               2  => (Site => lower_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Shine => default_Shine),
+               3  => (Site => upper_Sites (2),   Normal => Normals (1),   Color => shaft_Color,   Shine => default_Shine),
+               4  => (Site => lower_Sites (2),   Normal => Normals (1),   Color => shaft_Color,   Shine => default_Shine)];
+
+         the_Vertices_2 : aliased Geometry.lit_colored.Vertex_array
+           := [1  => (Site => upper_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Shine => default_Shine),
+               2  => (Site => lower_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Shine => default_Shine),
+               3  => (Site => upper_Sites (3),   Normal => Normals (2),   Color => shaft_Color,   Shine => default_Shine),
+               4  => (Site => lower_Sites (3),   Normal => Normals (2),   Color => shaft_Color,   Shine => default_Shine)];
+
+         the_Vertices_3 : aliased Geometry.lit_colored.Vertex_array
+           := [1  => (Site => upper_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Shine => default_Shine),
+               2  => (Site => lower_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Shine => default_Shine),
+               3  => (Site => upper_Sites (4),   Normal => Normals (3),   Color => shaft_Color,   Shine => default_Shine),
+               4  => (Site => lower_Sites (4),   Normal => Normals (3),   Color => shaft_Color,   Shine => default_Shine)];
+
+         the_Vertices_4 : aliased Geometry.lit_colored.Vertex_array
+           := [1  => (Site => upper_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Shine => default_Shine),
+               2  => (Site => lower_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Shine => default_Shine),
+               3  => (Site => upper_Sites (5),   Normal => Normals (4),   Color => shaft_Color,   Shine => default_Shine),
+               4  => (Site => lower_Sites (5),   Normal => Normals (4),   Color => shaft_Color,   Shine => default_Shine)];
+
+         the_Vertices_5 : aliased Geometry.lit_colored.Vertex_array
+           := [1  => (Site => upper_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Shine => default_Shine),
+               2  => (Site => lower_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Shine => default_Shine),
+               3  => (Site => upper_Sites (6),   Normal => Normals (5),   Color => shaft_Color,   Shine => default_Shine),
+               4  => (Site => lower_Sites (6),   Normal => Normals (5),   Color => shaft_Color,   Shine => default_Shine)];
+
+         the_Vertices_6 : aliased Geometry.lit_colored.Vertex_array
+           := [1  => (Site => upper_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Shine => default_Shine),
+               2  => (Site => lower_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Shine => default_Shine),
+               3  => (Site => upper_Sites (1),   Normal => Normals (6),   Color => shaft_Color,   Shine => default_Shine),
+               4  => (Site => lower_Sites (1),   Normal => Normals (6),   Color => shaft_Color,   Shine => default_Shine)];
+
+         the_Vertices  : constant array (1 .. 6) of access Geometry.lit_colored.Vertex_array
+           := [the_Vertices_1'Access,
+               the_Vertices_2'Access,
+               the_Vertices_3'Access,
+               the_Vertices_4'Access,
+               the_Vertices_5'Access,
+               the_Vertices_6'Access];
+      begin
+         for i in shaft_Faces'Range
+         loop
+            shaft_Faces (i) := new_shaft_Face (vertices => the_Vertices (i));
+         end loop;
+      end;
+
+      return [1 => upper_Face     .all'Access,
+              2 => lower_Face     .all'Access,
+              3 => shaft_Faces (1).all'Access,
+              4 => shaft_Faces (2).all'Access,
+              5 => shaft_Faces (3).all'Access,
+              6 => shaft_Faces (4).all'Access,
+              7 => shaft_Faces (5).all'Access,
+              8 => shaft_Faces (6).all'Access];
+
+   end to_GL_Geometries;
+
+
+end openGL.Model.Hexagon_Column.lit_colored_faceted;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.ads

@@ -0,0 +1,59 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon_Column.lit_colored_faceted
+--
+--  Models a lit, colored and textured column with 6 faceted shaft sides.
+--
+is
+   type Item is new Model.hexagon_Column.Item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Faces
+   --
+
+   type hex_Face is
+      record
+         center_Color : lucid_Color;                         -- The color of the center of the hex.
+         Colors       : lucid_Colors (1 .. 6);               -- The color of each of the faces 4 vertices.
+      end record;
+
+   type shaft_Face is
+      record
+         Color : lucid_Color;                              -- The color of the shaft.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in   hex_Face;
+                                Shaft  : in shaft_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;
+
+
+private
+
+   type Item is new Model.hexagon_Column.item with
+      record
+         upper_Face,
+         lower_Face : hex_Face;
+         Shaft      : shaft_Face;
+      end record;
+
+end openGL.Model.hexagon_Column.lit_colored_faceted;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_rounded.adb

@@ -0,0 +1,205 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.lit_colored,
+     openGL.Model.hexagon;
+
+
+package body openGL.Model.hexagon_Column.lit_colored_rounded
+is
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in hex_Face;
+                                Shaft  : in shaft_Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Height := Height;
+
+      Self.upper_Face := Upper;
+      Self.lower_Face := Lower;
+      Self.Shaft      := Shaft;
+
+      return Self;
+   end new_hexagon_Column;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry.lit_colored,
+          Model.hexagon;
+
+      shaft_Height  : constant Real     := Self.Height;
+      height_Offset : constant Vector_3 := [0.0,  shaft_Height / 2.0,  0.0];
+
+      mid_Sites     : constant hexagon.Sites   := vertex_Sites (Self.Radius);
+      upper_Sites   :          hexagon.Sites   := mid_Sites;
+      lower_Sites   :          hexagon.Sites   := mid_Sites;
+
+
+      function new_hexagon_Face (Vertices : in Geometry.lit_colored.Vertex_array;
+                                 Flip     : in Boolean := False) return Geometry.lit_colored.view
+      is
+         use Primitive;
+
+         function the_Indices return Indices
+         is
+         begin
+            if Flip
+            then   return [1, 7, 6, 5, 4, 3, 2, 7];
+            else   return [1, 2, 3, 4, 5, 6, 7, 2];
+            end if;
+         end the_Indices;
+
+         the_Geometry  : constant Geometry.lit_colored.view
+           := Geometry.lit_colored.new_Geometry;
+
+         the_Primitive : constant Primitive.view
+           := Primitive.indexed.new_Primitive (triangle_Fan,
+                                               the_Indices).all'Access;
+
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_hexagon_Face;
+
+
+
+      function new_shaft_Face (Vertices : in Geometry.lit_colored.Vertex_array)
+                               return Geometry.lit_colored.view
+      is
+         use Primitive;
+
+         the_Indices   : constant Indices := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2];
+
+         the_Geometry  : constant Geometry.lit_colored.view
+           := Geometry.lit_colored.new_Geometry;
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_shaft_Face;
+
+
+      upper_Face  : Geometry.lit_colored.view;
+      lower_Face  : Geometry.lit_colored.view;
+      shaft_Face  : Geometry.lit_colored.view;
+
+   begin
+      for i in mid_Sites'Range
+      loop
+         upper_Sites (i) := upper_Sites (i) + height_Offset;
+         lower_Sites (i) := lower_Sites (i) - height_Offset;
+      end loop;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : constant Geometry.lit_colored.Vertex_array
+           := [1 => (Site => height_Offset,    Normal => Normal,  Color => +Self.upper_Face.center_Color,  Shine => default_Shine),
+               2 => (Site => upper_Sites (1),  Normal => Normal,  Color => +Self.upper_Face.Colors (1),    Shine => default_Shine),
+               3 => (Site => upper_Sites (2),  Normal => Normal,  Color => +Self.upper_Face.Colors (2),    Shine => default_Shine),
+               4 => (Site => upper_Sites (3),  Normal => Normal,  Color => +Self.upper_Face.Colors (3),    Shine => default_Shine),
+               5 => (Site => upper_Sites (4),  Normal => Normal,  Color => +Self.upper_Face.Colors (4),    Shine => default_Shine),
+               6 => (Site => upper_Sites (5),  Normal => Normal,  Color => +Self.upper_Face.Colors (5),    Shine => default_Shine),
+               7 => (Site => upper_Sites (6),  Normal => Normal,  Color => +Self.upper_Face.Colors (6),    Shine => default_Shine)];
+      begin
+         upper_Face := new_hexagon_Face (Vertices => the_Vertices);
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : constant Geometry.lit_colored.Vertex_array
+           := [1 => (Site => -height_Offset,     Normal => -Normal,   Color => +Self.lower_Face.center_Color,   Shine => default_Shine),
+               2 => (Site =>  lower_Sites (1),   Normal => -Normal,   Color => +Self.lower_Face.Colors (1),     Shine => default_Shine),
+               3 => (Site =>  lower_Sites (2),   Normal => -Normal,   Color => +Self.lower_Face.Colors (2),     Shine => default_Shine),
+               4 => (Site =>  lower_Sites (3),   Normal => -Normal,   Color => +Self.lower_Face.Colors (3),     Shine => default_Shine),
+               5 => (Site =>  lower_Sites (4),   Normal => -Normal,   Color => +Self.lower_Face.Colors (4),     Shine => default_Shine),
+               6 => (Site =>  lower_Sites (5),   Normal => -Normal,   Color => +Self.lower_Face.Colors (5),     Shine => default_Shine),
+               7 => (Site =>  lower_Sites (6),   Normal => -Normal,   Color => +Self.lower_Face.Colors (6),     Shine => default_Shine)];
+      begin
+         lower_Face := new_hexagon_Face (Vertices => the_Vertices,
+                                         Flip     => True);
+      end;
+
+      --- Shaft
+      --
+      declare
+         type shaft_Normals is array (1 .. 6) of Vector_3;
+
+         function get_Normals return shaft_Normals
+         is
+            use linear_Algebra_3D;
+
+            Rotation   : constant Matrix_3x3 := y_Rotation_from (-math.to_Radians (60.0));
+            the_Normal :          Vector_3   := [1.0, 0.0, 0.0];
+            Result     :          shaft_Normals;
+         begin
+            Result (1) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (2) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (3) := the_Normal;
+
+            the_Normal := [0.0, 0.0, 1.0];
+            Result (4) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (5) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (6) := the_Normal;
+
+            return Result;
+         end get_Normals;
+
+         Normals      : constant shaft_Normals := get_Normals;
+         shaft_Color  : constant rgba_Color    := +Self.Shaft.Color;
+
+         the_Vertices : constant Geometry.lit_colored.Vertex_array
+           := [ 1 => (Site => upper_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Shine => default_Shine),
+                2 => (Site => lower_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Shine => default_Shine),
+                3 => (Site => upper_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Shine => default_Shine),
+                4 => (Site => lower_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Shine => default_Shine),
+                5 => (Site => upper_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Shine => default_Shine),
+                6 => (Site => lower_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Shine => default_Shine),
+                7 => (Site => upper_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Shine => default_Shine),
+                8 => (Site => lower_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Shine => default_Shine),
+                9 => (Site => upper_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Shine => default_Shine),
+               10 => (Site => lower_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Shine => default_Shine),
+               11 => (Site => upper_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Shine => default_Shine),
+               12 => (Site => lower_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Shine => default_Shine)];
+      begin
+         shaft_Face := new_shaft_Face (Vertices => the_Vertices);
+      end;
+
+      return [1 => upper_Face.all'Access,
+              2 => lower_Face.all'Access,
+              3 => shaft_Face.all'Access];
+   end to_GL_Geometries;
+
+
+end openGL.Model.hexagon_Column.lit_colored_rounded;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_rounded.ads

@@ -0,0 +1,62 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon_Column.lit_colored_rounded
+--
+--  Models a lit and colored column with six rounded sides.
+--
+--  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;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Faces
+   --
+
+   type hex_Face is
+      record
+         center_Color : lucid_Color;                  -- The color of the center of the hex.
+         Colors       : lucid_Colors (1 .. 6);        -- The color of each of the faces 4 vertices.
+      end record;
+
+
+   type shaft_Face is
+      record
+         Color   : lucid_Color;                       -- The color of the shaft.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in hex_Face;
+                                Shaft  : in shaft_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;
+
+
+private
+
+   type Item is new Model.hexagon_Column.item with
+      record
+         upper_Face,
+         lower_Face : hex_Face;
+         Shaft      : shaft_Face;
+      end record;
+
+end openGL.Model.hexagon_Column.lit_colored_rounded;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.adb

@@ -0,0 +1,266 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.lit_colored_textured,
+     openGL.Model.hexagon;
+
+
+package body openGL.Model.Hexagon_Column.lit_colored_textured_faceted
+is
+
+   type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in   hex_Face;
+                                Shaft  : in shaft_Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius     := Radius;
+      Self.Height     := Height;
+      Self.upper_Face := Upper;
+      Self.lower_Face := Lower;
+      Self.Shaft      := Shaft;
+
+      return Self;
+   end new_hexagon_Column;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.lit_colored_textured,
+          Model.hexagon,
+          Texture;
+
+      shaft_Height  : constant Real     := Self.Height;
+      height_Offset : constant Vector_3 := (0.0, shaft_Height / 2.0, 0.0);
+
+      mid_Sites     : constant hexagon.Sites := vertex_Sites (Self.Radius);
+      upper_Sites   :          hexagon.Sites := mid_Sites;
+      lower_Sites   :          hexagon.Sites := mid_Sites;
+
+
+      function new_hexagon_Face (Vertices : access Geometry.lit_colored_textured.Vertex_array;
+                                 Flip     : in     Boolean := False) return Geometry_view
+      is
+         use Primitive;
+
+         function the_Indices return Indices
+         is
+         begin
+            if Flip
+            then   return (1, 7, 6, 5, 4, 3, 2, 7);
+            else   return (1, 2, 3, 4, 5, 6, 7, 2);
+            end if;
+         end the_Indices;
+
+         the_Geometry  : constant Geometry_view
+           := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Fan,
+                                               the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_hexagon_Face;
+
+
+      function new_shaft_Face (Vertices : access Geometry.lit_colored_textured.Vertex_array)
+                               return Geometry_view
+      is
+         use Primitive;
+
+         the_Indices   : constant Indices := (1, 2, 3, 4);
+
+         the_Geometry  : constant Geometry_view
+           := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+         the_Primitive : constant Primitive.view
+           := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_shaft_Face;
+
+
+      upper_Face  : Geometry_view;
+      lower_Face  : Geometry_view;
+
+      shaft_Faces : array (1 .. 6) of Geometry_view;
+
+   begin
+      for Each in mid_Sites'Range
+      loop
+         upper_Sites (Each) := upper_Sites (Each) + height_Offset;
+         lower_Sites (Each) := lower_Sites (Each) - height_Offset;
+      end loop;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1 => (Site => height_Offset,     Normal => Normal,   Color => +Self.upper_Face.center_Color,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => upper_Sites (1),   Normal => Normal,   Color => +Self.upper_Face.Colors (1),     Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site => upper_Sites (2),   Normal => Normal,   Color => +Self.upper_Face.Colors (2),     Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site => upper_Sites (3),   Normal => Normal,   Color => +Self.upper_Face.Colors (3),     Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site => upper_Sites (4),   Normal => Normal,   Color => +Self.upper_Face.Colors (4),     Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site => upper_Sites (5),   Normal => Normal,   Color => +Self.upper_Face.Colors (5),     Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site => upper_Sites (6),   Normal => Normal,   Color => +Self.upper_Face.Colors (6),     Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         upper_Face := new_hexagon_Face (Vertices => the_Vertices'Access);
+
+         if Self.upper_Face.Texture /= null_Asset
+         then
+            upper_Face.Texture_is (Textures.fetch (Self.upper_Face.Texture));
+         end if;
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1 => (Site => -height_Offset,    Normal => -Normal,   Color => +Self.upper_Face.center_Color,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site =>  lower_Sites (1),  Normal => -Normal,   Color => +Self.upper_Face.Colors (1),     Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site =>  lower_Sites (2),  Normal => -Normal,   Color => +Self.upper_Face.Colors (2),     Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site =>  lower_Sites (3),  Normal => -Normal,   Color => +Self.upper_Face.Colors (3),     Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site =>  lower_Sites (4),  Normal => -Normal,   Color => +Self.upper_Face.Colors (4),     Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site =>  lower_Sites (5),  Normal => -Normal,   Color => +Self.upper_Face.Colors (5),     Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site =>  lower_Sites (6),  Normal => -Normal,   Color => +Self.upper_Face.Colors (6),     Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         lower_Face := new_hexagon_Face (vertices => the_Vertices'Access,
+                                         flip     => True);
+
+         if Self.upper_Face.Texture /= null_Asset
+         then
+            lower_Face.Texture_is (Textures.fetch (Self.lower_Face.Texture));
+         end if;
+      end;
+
+
+      --  Shaft
+      --
+      declare
+         type shaft_Normals is array (1 .. 6) of Vector_3;
+
+
+         function get_Normals return shaft_Normals
+         is
+            use linear_Algebra_3D;
+
+            Rotation   : constant Matrix_3x3   := y_Rotation_from (to_Radians (60.0));
+            the_Normal :          Vector_3     := (0.0, 0.0, -1.0);
+            Result     :          shaft_Normals;
+         begin
+            Result (2) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (3) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (4) := the_Normal;
+
+            the_Normal := (0.0, 0.0, 1.0);
+            Result (5) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (6) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (1) := the_Normal;
+
+            return Result;
+         end get_Normals;
+
+
+         Normals : constant shaft_Normals  := get_Normals;
+         s_Delta : constant                := 1.0 / 6.0;
+
+         shaft_Color : constant rgba_Color := +Self.Shaft.Color;
+
+         the_Vertices_1 : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1  => (Site => upper_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Coords => (0.0,           1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Coords => (0.0,           0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (2),   Normal => Normals (1),   Color => shaft_Color,   Coords => (s_Delta,       1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (2),   Normal => Normals (1),   Color => shaft_Color,   Coords => (s_Delta,       0.0),   Shine => default_Shine));
+
+         the_Vertices_2 : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1  => (Site => upper_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Coords => (s_Delta,       1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Coords => (s_Delta,       0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (3),   Normal => Normals (2),   Color => shaft_Color,   Coords => (s_Delta * 2.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (3),   Normal => Normals (2),   Color => shaft_Color,   Coords => (s_Delta * 2.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_3 : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1  => (Site => upper_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Coords => (s_Delta * 2.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Coords => (s_Delta * 2.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (4),   Normal => Normals (3),   Color => shaft_Color,   Coords => (s_Delta * 3.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (4),   Normal => Normals (3),   Color => shaft_Color,   Coords => (s_Delta * 3.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_4 : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1  => (Site => upper_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Coords => (s_Delta * 3.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Coords => (s_Delta * 3.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (5),   Normal => Normals (4),   Color => shaft_Color,   Coords => (s_Delta * 4.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (5),   Normal => Normals (4),   Color => shaft_Color,   Coords => (s_Delta * 4.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_5 : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1  => (Site => upper_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Coords => (s_Delta * 4.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Coords => (s_Delta * 4.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (6),   Normal => Normals (5),   Color => shaft_Color,   Coords => (s_Delta * 5.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (6),   Normal => Normals (5),   Color => shaft_Color,   Coords => (s_Delta * 5.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_6 : aliased Geometry.lit_colored_textured.Vertex_array
+           := (1  => (Site => upper_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Coords => (s_Delta * 5.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Coords => (s_Delta * 5.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (1),   Normal => Normals (6),   Color => shaft_Color,   Coords => (1.0,           1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (1),   Normal => Normals (6),   Color => shaft_Color,   Coords => (1.0,           0.0),   Shine => default_Shine));
+
+         the_Vertices  : constant array (1 .. 6) of access Geometry.lit_colored_textured.Vertex_array
+           := (the_Vertices_1'Access,
+               the_Vertices_2'Access,
+               the_Vertices_3'Access,
+               the_Vertices_4'Access,
+               the_Vertices_5'Access,
+               the_Vertices_6'Access);
+      begin
+         for i in shaft_Faces'Range
+         loop
+            shaft_Faces (i) := new_shaft_Face (vertices => the_Vertices (i));
+
+            if Self.shaft.Texture /= null_Asset
+            then
+               shaft_Faces (i).Texture_is (Textures.fetch (Self.shaft.Texture));
+            end if;
+         end loop;
+      end;
+
+      return (1 => upper_Face     .all'Access,
+              2 => lower_Face     .all'Access,
+              3 => shaft_Faces (1).all'Access,
+              4 => shaft_Faces (2).all'Access,
+              5 => shaft_Faces (3).all'Access,
+              6 => shaft_Faces (4).all'Access,
+              7 => shaft_Faces (5).all'Access,
+              8 => shaft_Faces (6).all'Access);
+
+   end to_GL_Geometries;
+
+
+end openGL.Model.Hexagon_Column.lit_colored_textured_faceted;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.ads

@@ -0,0 +1,61 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon_Column.lit_colored_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;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Faces
+   --
+
+   type hex_Face is
+      record
+         center_Color : lucid_Color;                         -- The color of the center of the hex.
+         Colors       : lucid_Colors (1 .. 6);               -- The color of each of the faces 4 vertices.
+         Texture      : asset_Name := openGL.null_Asset;     -- The texture to be applied to the face.
+      end record;
+
+   type shaft_Face is
+      record
+         Color   : lucid_Color;                              -- The color of the shaft.
+         Texture : asset_Name := null_Asset;                 -- The texture to be applied to the shaft.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in   hex_Face;
+                                Shaft  : in shaft_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;
+
+
+private
+
+   type Item is new Model.hexagon_Column.item with
+      record
+         upper_Face,
+         lower_Face : hex_Face;
+         Shaft      : shaft_Face;
+      end record;
+
+end openGL.Model.hexagon_Column.lit_colored_textured_faceted;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.adb

@@ -0,0 +1,225 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.lit_colored_textured,
+     openGL.Model.hexagon;
+
+
+package body openGL.Model.hexagon_Column.lit_colored_textured_rounded
+is
+
+   type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in hex_Face;
+                                Shaft  : in shaft_Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Height := Height;
+
+      Self.upper_Face := Upper;
+      Self.lower_Face := Lower;
+      Self.Shaft      := Shaft;
+
+      return Self;
+   end new_hexagon_Column;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.lit_colored_textured,
+          Model.hexagon,
+          Texture;
+
+      shaft_Height  : constant Real     := Self.Height;
+      height_Offset : constant Vector_3 := (0.0,  shaft_Height / 2.0,  0.0);
+
+      mid_Sites     : constant hexagon.Sites   := vertex_Sites (Self.Radius);
+      upper_Sites   :          hexagon.Sites   := mid_Sites;
+      lower_Sites   :          hexagon.Sites   := mid_Sites;
+
+
+      function new_hexagon_Face (Vertices : in Geometry.lit_colored_textured.Vertex_array;
+                                 Flip     : in Boolean := False) return Geometry_view
+      is
+         use Primitive;
+
+         function the_Indices return Indices
+         is
+         begin
+            if Flip
+            then   return (1, 7, 6, 5, 4, 3, 2, 7);
+            else   return (1, 2, 3, 4, 5, 6, 7, 2);
+            end if;
+         end the_Indices;
+
+         the_Geometry  : constant Geometry_view
+           := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+         the_Primitive : constant Primitive.view
+           := Primitive.indexed.new_Primitive (triangle_Fan,
+                                               the_Indices).all'Access;
+
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_hexagon_Face;
+
+
+
+      function new_shaft_Face (Vertices : in Geometry.lit_colored_textured.Vertex_array)
+                               return Geometry_view
+      is
+         use Primitive;
+
+         the_Indices   : constant Indices := (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2);
+
+         the_Geometry  : constant Geometry_view
+           := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_shaft_Face;
+
+
+      upper_Face  : Geometry_view;
+      lower_Face  : Geometry_view;
+      shaft_Face  : Geometry_view;
+
+   begin
+      for i in mid_Sites'Range
+      loop
+         upper_Sites (i) := upper_Sites (i) + height_Offset;
+         lower_Sites (i) := lower_Sites (i) - height_Offset;
+      end loop;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : constant Geometry.lit_colored_textured.Vertex_array
+           := (1 => (Site => height_Offset,    Normal => Normal,  Color => +Self.upper_Face.center_Color,  Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => upper_Sites (1),  Normal => Normal,  Color => +Self.upper_Face.Colors (1),    Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site => upper_Sites (2),  Normal => Normal,  Color => +Self.upper_Face.Colors (2),    Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site => upper_Sites (3),  Normal => Normal,  Color => +Self.upper_Face.Colors (3),    Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site => upper_Sites (4),  Normal => Normal,  Color => +Self.upper_Face.Colors (4),    Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site => upper_Sites (5),  Normal => Normal,  Color => +Self.upper_Face.Colors (5),    Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site => upper_Sites (6),  Normal => Normal,  Color => +Self.upper_Face.Colors (6),    Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         upper_Face := new_hexagon_Face (Vertices => the_Vertices);
+
+         if Self.upper_Face.Texture /= null_Asset
+         then
+            upper_Face.Texture_is (Textures.fetch (Self.upper_Face.Texture));
+         end if;
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : constant Geometry.lit_colored_textured.Vertex_array
+           := (1 => (Site => -height_Offset,     Normal => -Normal,   Color => +Self.lower_Face.center_Color,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site =>  lower_Sites (1),   Normal => -Normal,   Color => +Self.lower_Face.Colors (1),     Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site =>  lower_Sites (2),   Normal => -Normal,   Color => +Self.lower_Face.Colors (2),     Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site =>  lower_Sites (3),   Normal => -Normal,   Color => +Self.lower_Face.Colors (3),     Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site =>  lower_Sites (4),   Normal => -Normal,   Color => +Self.lower_Face.Colors (4),     Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site =>  lower_Sites (5),   Normal => -Normal,   Color => +Self.lower_Face.Colors (5),     Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site =>  lower_Sites (6),   Normal => -Normal,   Color => +Self.lower_Face.Colors (6),     Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         lower_Face := new_hexagon_Face (Vertices => the_Vertices,
+                                         flip     => True);
+
+         if Self.lower_Face.Texture /= null_Asset
+         then
+            lower_Face.Texture_is (Textures.fetch (Self.lower_Face.Texture));
+         end if;
+      end;
+
+      --- Shaft
+      --
+      declare
+         type shaft_Normals is array (1 .. 6) of Vector_3;
+
+         function get_Normals return shaft_Normals
+         is
+            use linear_Algebra_3D;
+
+            Rotation   : constant Matrix_3x3 := y_Rotation_from (-math.to_Radians (60.0));
+            the_Normal :          Vector_3   := (1.0, 0.0, 0.0);
+            Result     :          shaft_Normals;
+         begin
+            Result (1) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (2) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (3) := the_Normal;
+
+            the_Normal := (0.0, 0.0, 1.0);
+            Result (4) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (5) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (6) := the_Normal;
+
+            return Result;
+         end get_Normals;
+
+         Normals      : constant shaft_Normals := get_Normals;
+         shaft_Color  : constant rgba_Color    := +Self.Shaft.Color;
+
+         the_Vertices : constant Geometry.lit_colored_textured.Vertex_array
+           := ( 1 => (Site => upper_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Coords => (0.0, 1.0),   Shine => default_Shine),
+                2 => (Site => lower_Sites (1),   Normal => Normals (1),   Color => shaft_Color,   Coords => (0.0, 0.0),   Shine => default_Shine),
+                3 => (Site => upper_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Coords => (0.2, 1.0),   Shine => default_Shine),
+                4 => (Site => lower_Sites (2),   Normal => Normals (2),   Color => shaft_Color,   Coords => (0.2, 0.0),   Shine => default_Shine),
+                5 => (Site => upper_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Coords => (0.4, 1.0),   Shine => default_Shine),
+                6 => (Site => lower_Sites (3),   Normal => Normals (3),   Color => shaft_Color,   Coords => (0.4, 0.0),   Shine => default_Shine),
+                7 => (Site => upper_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Coords => (0.6, 1.0),   Shine => default_Shine),
+                8 => (Site => lower_Sites (4),   Normal => Normals (4),   Color => shaft_Color,   Coords => (0.6, 0.0),   Shine => default_Shine),
+                9 => (Site => upper_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Coords => (0.8, 1.0),   Shine => default_Shine),
+               10 => (Site => lower_Sites (5),   Normal => Normals (5),   Color => shaft_Color,   Coords => (0.8, 0.0),   Shine => default_Shine),
+               11 => (Site => upper_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               12 => (Site => lower_Sites (6),   Normal => Normals (6),   Color => shaft_Color,   Coords => (1.0, 0.0),   Shine => default_Shine));
+      begin
+         shaft_Face := new_shaft_Face (Vertices => the_Vertices);
+
+         if Self.Shaft.Texture /= null_Asset
+         then
+            shaft_Face.Texture_is (Textures.fetch (Self.Shaft.Texture));
+         end if;
+      end;
+
+      return (1 => upper_Face.all'Access,
+              2 => lower_Face.all'Access,
+              3 => shaft_Face.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.hexagon_Column.lit_colored_textured_rounded;

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

@@ -0,0 +1,64 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon_Column.lit_colored_textured_rounded
+--
+--  Models a lit, colored and textured column with six rounded sides.
+--
+--  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;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Faces
+   --
+
+   type hex_Face is
+      record
+         center_Color : lucid_Color;                  -- The color of the center of the hex.
+         Colors       : lucid_Colors (1 .. 6);        -- The color of each of the faces 4 vertices.
+         Texture      : asset_Name := null_Asset;     -- The texture to be applied to the face.
+      end record;
+
+
+   type shaft_Face is
+      record
+         Color   : lucid_Color;                       -- The color of the shaft.
+         Texture : asset_Name := openGL.null_Asset;   -- The texture to be applied to the shaft.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in hex_Face;
+                                Shaft  : in shaft_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;
+
+
+private
+
+   type Item is new Model.hexagon_Column.item with
+      record
+         upper_Face,
+         lower_Face : hex_Face;
+         Shaft      : shaft_Face;
+      end record;
+
+end openGL.Model.hexagon_Column.lit_colored_textured_rounded;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.adb

@@ -0,0 +1,260 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.lit_textured,
+     openGL.Model.hexagon;
+
+
+package body openGL.Model.Hexagon_Column.lit_textured_faceted
+is
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in   hex_Face;
+                                Shaft  : in shaft_Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius     := Radius;
+      Self.Height     := Height;
+      Self.upper_Face := Upper;
+      Self.lower_Face := Lower;
+      Self.Shaft      := Shaft;
+
+      return Self;
+   end new_hexagon_Column;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.lit_textured,
+          Model.hexagon,
+          Texture;
+
+      shaft_Height  : constant Real     := Self.Height;
+      height_Offset : constant Vector_3 := (0.0, shaft_Height / 2.0, 0.0);
+
+      mid_Sites     : constant hexagon.Sites := vertex_Sites (Self.Radius);
+      upper_Sites   :          hexagon.Sites := mid_Sites;
+      lower_Sites   :          hexagon.Sites := mid_Sites;
+
+
+      function new_hexagon_Face (Vertices : access Geometry.lit_textured.Vertex_array;
+                                 Flip     : in     Boolean := False) return Geometry.lit_textured.view
+      is
+         use Primitive;
+
+         function the_Indices return Indices
+         is
+         begin
+            if Flip
+            then   return (1, 7, 6, 5, 4, 3, 2, 7);
+            else   return (1, 2, 3, 4, 5, 6, 7, 2);
+            end if;
+         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);
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_hexagon_Face;
+
+
+      function new_shaft_Face (Vertices : access Geometry.lit_textured.Vertex_array)
+                               return Geometry.lit_textured.view
+      is
+         use Primitive;
+
+         the_Indices   : constant Indices := (1, 2, 3, 4);
+
+         the_Geometry  : constant Geometry.lit_textured.view
+           := Geometry.lit_textured.new_Geometry;
+
+         the_Primitive : constant Primitive.view
+           := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
+      begin
+         the_Geometry.Vertices_are (Vertices.all);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_shaft_Face;
+
+
+      upper_Face  : Geometry.lit_textured.view;
+      lower_Face  : Geometry.lit_textured.view;
+
+      shaft_Faces : array (1 .. 6) of Geometry.lit_textured.view;
+
+   begin
+      for Each in mid_Sites'Range
+      loop
+         upper_Sites (Each) := upper_Sites (Each) + height_Offset;
+         lower_Sites (Each) := lower_Sites (Each) - height_Offset;
+      end loop;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_textured.Vertex_array
+           := (1 => (Site => height_Offset,     Normal => Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => upper_Sites (1),   Normal => Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site => upper_Sites (2),   Normal => Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site => upper_Sites (3),   Normal => Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site => upper_Sites (4),   Normal => Normal,   Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site => upper_Sites (5),   Normal => Normal,   Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site => upper_Sites (6),   Normal => Normal,   Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         upper_Face := new_hexagon_Face (Vertices => the_Vertices'Access);
+
+         if Self.upper_Face.Texture /= null_Asset
+         then
+            upper_Face.Texture_is (Textures.fetch (Self.upper_Face.Texture));
+         end if;
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : aliased Geometry.lit_textured.Vertex_array
+           := (1 => (Site => -height_Offset,    Normal => -Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site =>  lower_Sites (1),  Normal => -Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site =>  lower_Sites (2),  Normal => -Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site =>  lower_Sites (3),  Normal => -Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site =>  lower_Sites (4),  Normal => -Normal,   Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site =>  lower_Sites (5),  Normal => -Normal,   Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site =>  lower_Sites (6),  Normal => -Normal,   Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         lower_Face := new_hexagon_Face (vertices => the_Vertices'Access,
+                                         flip     => True);
+
+         if Self.upper_Face.Texture /= null_Asset
+         then
+            lower_Face.Texture_is (Textures.fetch (Self.lower_Face.Texture));
+         end if;
+      end;
+
+
+      --  Shaft
+      --
+      declare
+         type shaft_Normals is array (1 .. 6) of Vector_3;
+
+
+         function get_Normals return shaft_Normals
+         is
+            use linear_Algebra_3D;
+
+            Rotation   : constant Matrix_3x3   := y_Rotation_from (to_Radians (60.0));
+            the_Normal :          Vector_3     := (0.0, 0.0, -1.0);
+            Result     :          shaft_Normals;
+         begin
+            Result (2) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (3) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (4) := the_Normal;
+
+            the_Normal := (0.0, 0.0, 1.0);
+            Result (5) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (6) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (1) := the_Normal;
+
+            return Result;
+         end get_Normals;
+
+
+         Normals : constant shaft_Normals  := get_Normals;
+         s_Delta : constant                := 1.0 / 6.0;
+
+         the_Vertices_1 : aliased Geometry.lit_textured.Vertex_array
+           := (1  => (Site => upper_Sites (1),   Normal => Normals (1),   Coords => (0.0,           1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (1),   Normal => Normals (1),   Coords => (0.0,           0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (2),   Normal => Normals (1),   Coords => (s_Delta,       1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (2),   Normal => Normals (1),   Coords => (s_Delta,       0.0),   Shine => default_Shine));
+
+         the_Vertices_2 : aliased Geometry.lit_textured.Vertex_array
+           := (1  => (Site => upper_Sites (2),   Normal => Normals (2),   Coords => (s_Delta,       1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (2),   Normal => Normals (2),   Coords => (s_Delta,       0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (3),   Normal => Normals (2),   Coords => (s_Delta * 2.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (3),   Normal => Normals (2),   Coords => (s_Delta * 2.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_3 : aliased Geometry.lit_textured.Vertex_array
+           := (1  => (Site => upper_Sites (3),   Normal => Normals (3),   Coords => (s_Delta * 2.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (3),   Normal => Normals (3),   Coords => (s_Delta * 2.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (4),   Normal => Normals (3),   Coords => (s_Delta * 3.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (4),   Normal => Normals (3),   Coords => (s_Delta * 3.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_4 : aliased Geometry.lit_textured.Vertex_array
+           := (1  => (Site => upper_Sites (4),   Normal => Normals (4),   Coords => (s_Delta * 3.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (4),   Normal => Normals (4),   Coords => (s_Delta * 3.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (5),   Normal => Normals (4),   Coords => (s_Delta * 4.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (5),   Normal => Normals (4),   Coords => (s_Delta * 4.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_5 : aliased Geometry.lit_textured.Vertex_array
+           := (1  => (Site => upper_Sites (5),   Normal => Normals (5),   Coords => (s_Delta * 4.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (5),   Normal => Normals (5),   Coords => (s_Delta * 4.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (6),   Normal => Normals (5),   Coords => (s_Delta * 5.0, 1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (6),   Normal => Normals (5),   Coords => (s_Delta * 5.0, 0.0),   Shine => default_Shine));
+
+         the_Vertices_6 : aliased Geometry.lit_textured.Vertex_array
+           := (1  => (Site => upper_Sites (6),   Normal => Normals (6),   Coords => (s_Delta * 5.0, 1.0),   Shine => default_Shine),
+               2  => (Site => lower_Sites (6),   Normal => Normals (6),   Coords => (s_Delta * 5.0, 0.0),   Shine => default_Shine),
+               3  => (Site => upper_Sites (1),   Normal => Normals (6),   Coords => (1.0,           1.0),   Shine => default_Shine),
+               4  => (Site => lower_Sites (1),   Normal => Normals (6),   Coords => (1.0,           0.0),   Shine => default_Shine));
+
+         the_Vertices  : constant array (1 .. 6) of access Geometry.lit_textured.Vertex_array
+           := (the_Vertices_1'Access,
+               the_Vertices_2'Access,
+               the_Vertices_3'Access,
+               the_Vertices_4'Access,
+               the_Vertices_5'Access,
+               the_Vertices_6'Access);
+      begin
+         for i in shaft_Faces'Range
+         loop
+            shaft_Faces (i) := new_shaft_Face (vertices => the_Vertices (i));
+
+            if Self.shaft.Texture /= null_Asset
+            then
+               shaft_Faces (i).Texture_is (Textures.fetch (Self.shaft.Texture));
+            end if;
+         end loop;
+      end;
+
+      return (1 => upper_Face     .all'Access,
+              2 => lower_Face     .all'Access,
+              3 => shaft_Faces (1).all'Access,
+              4 => shaft_Faces (2).all'Access,
+              5 => shaft_Faces (3).all'Access,
+              6 => shaft_Faces (4).all'Access,
+              7 => shaft_Faces (5).all'Access,
+              8 => shaft_Faces (6).all'Access);
+
+   end to_GL_Geometries;
+
+
+end openGL.Model.Hexagon_Column.lit_textured_faceted;

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

@@ -0,0 +1,58 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+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;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Faces
+   --
+
+   type hex_Face is
+      record
+         Texture      : asset_Name := openGL.null_Asset;     -- The texture to be applied to the face.
+      end record;
+
+   type shaft_Face is
+      record
+         Texture : asset_Name := null_Asset;                 -- The texture to be applied to the shaft.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in   hex_Face;
+                                Shaft  : in shaft_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;
+
+
+private
+
+   type Item is new Model.hexagon_Column.item with
+      record
+         upper_Face,
+         lower_Face : hex_Face;
+         Shaft      : shaft_Face;
+      end record;
+
+end openGL.Model.hexagon_Column.lit_textured_faceted;

3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.adb

@@ -0,0 +1,220 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Geometry.lit_textured,
+     openGL.Model.hexagon;
+
+
+package body openGL.Model.hexagon_Column.lit_textured_rounded
+is
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in hex_Face;
+                                Shaft  : in shaft_Face) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Radius := Radius;
+      Self.Height := Height;
+
+      Self.upper_Face := Upper;
+      Self.lower_Face := Lower;
+      Self.Shaft      := Shaft;
+
+      return Self;
+   end new_hexagon_Column;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Fonts);
+
+      use Geometry.lit_textured,
+          Model.hexagon,
+          Texture;
+
+      shaft_Height  : constant Real     := Self.Height;
+      height_Offset : constant Vector_3 := (0.0,  shaft_Height / 2.0,  0.0);
+
+      mid_Sites     : constant hexagon.Sites   := vertex_Sites (Self.Radius);
+      upper_Sites   :          hexagon.Sites   := mid_Sites;
+      lower_Sites   :          hexagon.Sites   := mid_Sites;
+
+
+      function new_hexagon_Face (Vertices : in Geometry.lit_textured.Vertex_array;
+                                 Flip     : in Boolean := False) return Geometry.lit_textured.view
+      is
+         use Primitive;
+
+         function the_Indices return Indices
+         is
+         begin
+            if Flip
+            then   return (1, 7, 6, 5, 4, 3, 2, 7);
+            else   return (1, 2, 3, 4, 5, 6, 7, 2);
+            end if;
+         end the_Indices;
+
+         the_Geometry  : constant Geometry.lit_textured.view
+           := Geometry.lit_textured.new_Geometry;
+
+         the_Primitive : constant Primitive.view
+           := Primitive.indexed.new_Primitive (triangle_Fan,
+                                               the_Indices).all'Access;
+
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (the_Primitive);
+
+         return the_Geometry;
+      end new_hexagon_Face;
+
+
+
+      function new_shaft_Face (Vertices : in Geometry.lit_textured.Vertex_array)
+                               return Geometry.lit_textured.view
+      is
+         use Primitive;
+
+         the_Indices   : constant Indices := (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2);
+
+         the_Geometry  : constant Geometry.lit_textured.view
+           := Geometry.lit_textured.new_Geometry;
+
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.Vertices_are (Vertices);
+         the_Geometry.add          (Primitive.view (the_Primitive));
+
+         return the_Geometry;
+      end new_shaft_Face;
+
+
+      upper_Face  : Geometry.lit_textured.view;
+      lower_Face  : Geometry.lit_textured.view;
+      shaft_Face  : Geometry.lit_textured.view;
+
+   begin
+      for i in mid_Sites'Range
+      loop
+         upper_Sites (i) := upper_Sites (i) + height_Offset;
+         lower_Sites (i) := lower_Sites (i) - height_Offset;
+      end loop;
+
+      --  Upper
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := (1 => (Site => height_Offset,    Normal => Normal,  Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site => upper_Sites (1),  Normal => Normal,  Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site => upper_Sites (2),  Normal => Normal,  Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site => upper_Sites (3),  Normal => Normal,  Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site => upper_Sites (4),  Normal => Normal,  Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site => upper_Sites (5),  Normal => Normal,  Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site => upper_Sites (6),  Normal => Normal,  Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         upper_Face := new_hexagon_Face (Vertices => the_Vertices);
+
+         if Self.upper_Face.Texture /= null_Asset
+         then
+            upper_Face.Texture_is (Textures.fetch (Self.upper_Face.Texture));
+         end if;
+      end;
+
+      --  Lower
+      --
+      declare
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := (1 => (Site => -height_Offset,     Normal => -Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               2 => (Site =>  lower_Sites (1),   Normal => -Normal,   Coords => (0.0, 0.0),   Shine => default_Shine),
+               3 => (Site =>  lower_Sites (2),   Normal => -Normal,   Coords => (1.0, 0.0),   Shine => default_Shine),
+               4 => (Site =>  lower_Sites (3),   Normal => -Normal,   Coords => (1.0, 1.0),   Shine => default_Shine),
+               5 => (Site =>  lower_Sites (4),   Normal => -Normal,   Coords => (0.0, 1.0),   Shine => default_Shine),
+               6 => (Site =>  lower_Sites (5),   Normal => -Normal,   Coords => (0.0, 1.0),   Shine => default_Shine),
+               7 => (Site =>  lower_Sites (6),   Normal => -Normal,   Coords => (0.0, 1.0),   Shine => default_Shine));
+      begin
+         lower_Face := new_hexagon_Face (Vertices => the_Vertices,
+                                         flip     => True);
+
+         if Self.lower_Face.Texture /= null_Asset
+         then
+            lower_Face.Texture_is (Textures.fetch (Self.lower_Face.Texture));
+         end if;
+      end;
+
+      --- Shaft
+      --
+      declare
+         type shaft_Normals is array (1 .. 6) of Vector_3;
+
+         function get_Normals return shaft_Normals
+         is
+            use linear_Algebra_3D;
+
+            Rotation   : constant Matrix_3x3 := y_Rotation_from (-math.to_Radians (60.0));
+            the_Normal :          Vector_3   := (1.0, 0.0, 0.0);
+            Result     :          shaft_Normals;
+         begin
+            Result (1) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (2) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (3) := the_Normal;
+
+            the_Normal := (0.0, 0.0, 1.0);
+            Result (4) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (5) := the_Normal;
+
+            the_Normal := Rotation * the_Normal;
+            Result (6) := the_Normal;
+
+            return Result;
+         end get_Normals;
+
+         Normals      : constant shaft_Normals := get_Normals;
+
+         the_Vertices : constant Geometry.lit_textured.Vertex_array
+           := ( 1 => (Site => upper_Sites (1),   Normal => Normals (1),   Coords => (0.0, 1.0),   Shine => default_Shine),
+                2 => (Site => lower_Sites (1),   Normal => Normals (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
+                3 => (Site => upper_Sites (2),   Normal => Normals (2),   Coords => (0.2, 1.0),   Shine => default_Shine),
+                4 => (Site => lower_Sites (2),   Normal => Normals (2),   Coords => (0.2, 0.0),   Shine => default_Shine),
+                5 => (Site => upper_Sites (3),   Normal => Normals (3),   Coords => (0.4, 1.0),   Shine => default_Shine),
+                6 => (Site => lower_Sites (3),   Normal => Normals (3),   Coords => (0.4, 0.0),   Shine => default_Shine),
+                7 => (Site => upper_Sites (4),   Normal => Normals (4),   Coords => (0.6, 1.0),   Shine => default_Shine),
+                8 => (Site => lower_Sites (4),   Normal => Normals (4),   Coords => (0.6, 0.0),   Shine => default_Shine),
+                9 => (Site => upper_Sites (5),   Normal => Normals (5),   Coords => (0.8, 1.0),   Shine => default_Shine),
+               10 => (Site => lower_Sites (5),   Normal => Normals (5),   Coords => (0.8, 0.0),   Shine => default_Shine),
+               11 => (Site => upper_Sites (6),   Normal => Normals (6),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               12 => (Site => lower_Sites (6),   Normal => Normals (6),   Coords => (1.0, 0.0),   Shine => default_Shine));
+      begin
+         shaft_Face := new_shaft_Face (Vertices => the_Vertices);
+
+         if Self.Shaft.Texture /= null_Asset
+         then
+            shaft_Face.Texture_is (Textures.fetch (Self.Shaft.Texture));
+         end if;
+      end;
+
+      return (1 => upper_Face.all'Access,
+              2 => lower_Face.all'Access,
+              3 => shaft_Face.all'Access);
+   end to_GL_Geometries;
+
+
+end openGL.Model.hexagon_Column.lit_textured_rounded;

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

@@ -0,0 +1,61 @@
+with
+     openGL.Geometry,
+     openGL.Texture;
+
+
+package openGL.Model.hexagon_Column.lit_textured_rounded
+--
+--  Models a lit, colored and textured column with six rounded sides.
+--
+--  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;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Faces
+   --
+
+   type hex_Face is
+      record
+         Texture : asset_Name := null_Asset;          -- The texture to be applied to the face.
+      end record;
+
+
+   type shaft_Face is
+      record
+         Texture : asset_Name := openGL.null_Asset;   -- The texture to be applied to the shaft.
+      end record;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_hexagon_Column (Radius : in Real;
+                                Height : in Real;
+                                Upper,
+                                Lower  : in hex_Face;
+                                Shaft  : in shaft_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;
+
+
+private
+
+   type Item is new Model.hexagon_Column.item with
+      record
+         upper_Face,
+         lower_Face : hex_Face;
+         Shaft      : shaft_Face;
+      end record;
+
+end openGL.Model.hexagon_Column.lit_textured_rounded;

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

@@ -0,0 +1,21 @@
+package openGL.Model.hexagon_Column
+--
+--  Models a column with six sides.
+--
+is
+
+   type Item is abstract new Model.item with private;
+
+
+
+private
+
+   type Item is abstract new Model.item with
+      record
+         Radius : Real := 1.0;
+         Height : Real := 1.0;
+      end record;
+
+   Normal : constant Vector_3 := [0.0, 0.0, 1.0];
+
+end openGL.Model.hexagon_Column;

3-mid/opengl/source/lean/model/opengl-model-line-colored.adb

@@ -0,0 +1,96 @@
+with
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.line.colored
+is
+   ---------
+   --- Forge
+   --
+
+   function to_line_Model (Color : in openGL.Color;
+                           End_1,
+                           End_2 : in Vector_3 := Origin_3D) return Item
+   is
+      Self : Item;
+   begin
+      Self.Color             := +Color;
+      Self.Vertices (1).Site := End_1;
+      Self.Vertices (2).Site := End_2;
+
+      Self.set_Bounds;
+
+      return Self;
+   end to_line_Model;
+
+
+
+   function new_line_Model (Color : in openGL.Color;
+                            End_1,
+                            End_2 : in Vector_3 := Origin_3D) return View
+   is
+   begin
+      return new Item' (to_line_Model (Color, End_1, End_2));
+   end new_line_Model;
+
+
+   --------------
+   --- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+      use Geometry.colored;
+
+      indices_Count : constant long_Index_t := 2;
+      the_Indices   : aliased  Indices      := [1 .. indices_Count => <>];
+      the_Primitive :          Primitive.indexed.view;
+
+   begin
+      if Self.Geometry = null
+      then
+         Self.Geometry := Geometry.colored.new_Geometry;
+      end if;
+
+      set_Sites:
+      begin
+         Self.Vertices (1).Color := (Primary => Self.Color,  Alpha => opaque_Value);
+         Self.Vertices (2).Color := (Primary => Self.Color,  Alpha => opaque_Value);
+      end set_Sites;
+
+      the_Indices := [1, 2];
+
+      Self.Geometry.is_Transparent (False);
+      Self.Geometry.Vertices_are   (Self.Vertices);
+
+      the_Primitive := Primitive.indexed.new_Primitive (Primitive.Lines, the_Indices);
+      Self.Geometry.add (Primitive.view (the_Primitive));
+
+      return [1 => Self.Geometry];
+   end to_GL_Geometries;
+
+
+
+   function Site (Self : in Item;   for_End : in end_Id) return Vector_3
+   is
+   begin
+      return Self.Vertices (for_End).Site;
+   end Site;
+
+
+   procedure Site_is (Self : in out Item;   Now     : in Vector_3;
+                                            for_End : in end_Id)
+   is
+      use Geometry.colored;
+   begin
+      Self.Vertices (for_End).Site := Now;
+      Self.Geometry.Vertices_are (Self.Vertices);
+
+      Self.set_Bounds;
+   end Site_is;
+
+
+end openGL.Model.line.colored;

3-mid/opengl/source/lean/model/opengl-model-line-colored.ads

@@ -0,0 +1,49 @@
+private
+with
+     openGL.Geometry.colored;
+
+
+package openGL.Model.line.colored
+--
+--  Models a colored line.
+--
+is
+   type Item is new Model.line.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_line_Model (Color : in openGL.Color;
+                            End_1,
+                            End_2 : in Vector_3 := Origin_3D) 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;
+
+   subtype end_Id is Index_t range 1 .. 2;
+
+   procedure Site_is (Self : in out Item;   Now     : in Vector_3;
+                                            for_End : in end_Id);
+   function  Site    (Self : in     Item;   for_End : in end_Id) return Vector_3;
+
+
+
+private
+
+   type Item is new Model.line.item with
+      record
+         Color    :        openGL.rgb_Color;
+         Vertices :        Geometry.colored.Vertex_array (end_Id);
+         Geometry : access Geometry.colored.item'Class;
+      end record;
+
+end openGL.Model.line.colored;

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

@@ -0,0 +1,14 @@
+package openGL.Model.line
+--
+--  Provides an abstract class for line models.
+--
+is
+   type Item is abstract new Model.item with private;
+
+
+
+private
+
+   type Item is abstract new Model.item with null record;
+
+end openGL.Model.line;

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

@@ -0,0 +1,76 @@
+with
+     openGL.Geometry.lit_colored,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.polygon.lit_colored
+is
+
+   function new_Polygon (Vertices : in Vector_2_array;
+                         Color    : in lucid_Color) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Color := Color;
+
+      Self.Vertices (Vertices'Range) := Vertices;
+      Self.vertex_Count              := Vertices'Length;
+
+      return Self;
+   end new_Polygon;
+
+
+
+   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 (Textures, Fonts);
+
+      use Geometry,
+          Geometry.lit_colored;
+
+      vertex_Count  : constant      Index_t :=      Index_t (Self.vertex_Count);
+      indices_Count : constant long_Index_t := long_Index_t (Self.vertex_Count);
+
+      the_Vertices  : aliased  Geometry.lit_colored.Vertex_array := [1 .. vertex_Count  => <>];
+      the_Indices   : aliased  Indices                           := [1 .. indices_Count => <>];
+
+      Color         : constant rgba_Color                := +Self.Color;
+      the_Geometry  : constant Geometry.lit_colored.view := Geometry.lit_colored.new_Geometry;
+
+   begin
+      set_Vertices:
+      begin
+         for i in 1 .. vertex_Count
+         loop
+            the_Vertices (i).Site   := Vector_3 (Self.Vertices (Integer (i)) & 0.0);
+            the_Vertices (i).Normal := [0.0, 0.0, 1.0];
+            the_Vertices (i).Color  := Color;
+            the_Vertices (i).Shine  := 0.5;
+         end loop;
+      end set_Vertices;
+
+      --- Set Indices.
+      --
+      for i in the_Indices'Range
+      loop
+         the_Indices (i) := Index_t (i);
+      end loop;
+
+      the_Geometry.is_Transparent (False);
+      the_Geometry.Vertices_are   (the_Vertices);
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Fan,
+                                               the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.polygon.lit_colored;

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

@@ -0,0 +1,39 @@
+with
+     openGL.Font,
+     openGL.Geometry;
+
+
+package openGL.Model.polygon.lit_colored
+--
+--  Models a lit, colored polygon.
+--
+is
+   type Item is new Model.polygon.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+   function new_Polygon (Vertices : in Vector_2_array;
+                         Color    : in lucid_Color) 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;
+
+
+private
+
+   type Item is new Model.polygon.item with
+      record
+         Color        : lucid_Color;
+
+         Vertices     : Vector_2_array (1 .. 8);
+         vertex_Count : Natural := 0;
+      end record;
+
+end openGL.Model.polygon.lit_colored;

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

@@ -0,0 +1,8 @@
+package openGL.Model.polygon
+--
+--  Provides an abstract class for polygon models.
+--
+is
+   type Item is abstract new Model.item with null record;
+
+end openGL.Model.polygon;

3-mid/opengl/source/lean/model/opengl-model-segment_line.adb

@@ -0,0 +1,189 @@
+with
+     openGL.Primitive.indexed,
+     openGL.Primitive,
+
+     ada.unchecked_Deallocation;
+
+
+package body openGL.Model.segment_line
+is
+
+   function to_segment_line_Model (Color : in openGL.Color) return Item
+   is
+      Self : constant Item := (Model.item with
+                               +Color,
+                               site_Vectors.empty_Vector,
+                               others => <>);
+   begin
+      return Self;
+   end to_segment_line_Model;
+
+
+
+   function new_segment_line_Model (Color : in openGL.Color) return View
+   is
+   begin
+      return new Item' (to_segment_line_Model (Color));
+   end new_segment_line_Model;
+
+
+
+   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 (Textures, Fonts);
+
+      use Geometry.colored,
+          Primitive,
+          Primitive.indexed,
+          ada.Containers;
+
+      vertex_Count  : constant      Index_t :=      Index_t (Self.Points.Length);
+      indices_Count : constant long_Index_t := long_Index_t (vertex_Count);
+      the_Indices   : aliased       Indices := [1 .. indices_Count => <>];
+
+   begin
+      if Self.Points.Length <= 2
+      then
+         return [1..0 => <>];
+      end if;
+
+      for i in the_Indices'Range
+      loop
+         the_Indices (i) := Index_t (i);
+      end loop;
+
+      Self.Geometry := Geometry.colored.new_Geometry;
+
+      Self.Geometry.is_Transparent (False);
+      Self.Geometry.Vertices_are (Self.Vertices (1 .. Index_t (Self.vertex_Count)));
+      Self.Geometry.add (Primitive.view (new_Primitive (Line_Strip,
+                                                        the_Indices)));
+      return [1 => Self.Geometry.all'Access];
+   end to_GL_Geometries;
+
+
+
+   function Site (Self : in  Item;   for_End : in Integer) return Vector_3
+   is
+   begin
+      return Self.Vertices (Index_t (for_End)).Site;
+   end Site;
+
+
+
+   function segment_Count (Self : in Item) return Natural
+   is
+   begin
+      return Natural (Self.Points.Length) - 1;
+   end segment_Count;
+
+
+
+   procedure add_1st_Segment (Self : in out Item;   start_Site : in Vector_3;
+                                                    end_Site   : in Vector_3)
+   is
+      use site_Vectors;
+   begin
+      pragma assert (Self.Points.Is_Empty);
+
+      Self.Points.append (start_Site);
+      Self.Points.append (end_Site);
+
+      Self.vertex_Count := Self.vertex_Count + 1;
+
+      Self.Vertices (Index_t (Self.vertex_Count)).Site  := start_Site;
+      Self.Vertices (Index_t (Self.vertex_Count)).Color := (Self.Color, opaque_Value);
+
+      Self.vertex_Count := Self.vertex_Count + 1;
+
+      Self.Vertices (Index_t (Self.vertex_Count)).Site  := end_Site;
+      Self.Vertices (Index_t (Self.vertex_Count)).Color := (Self.Color, opaque_Value);
+
+      Self.needs_Rebuild := True;
+   end add_1st_Segment;
+
+
+
+   procedure add_Segment (Self : in out Item;   end_Site : in Vector_3)
+   is
+      use type ada.Containers.Count_type;
+
+      procedure deallocate is new ada.unchecked_Deallocation (Geometry.colored.Vertex_array,
+                                                              vertex_Array_view);
+   begin
+      pragma assert (not Self.Points.is_Empty);
+
+      Self.Points.append (end_Site);
+
+      if Self.Points.Length > Self.Vertices'Length
+      then
+         declare
+            new_Vertices : constant vertex_Array_view
+              := new Geometry.colored.Vertex_array (1 .. 2 * Self.Vertices'Length);
+         begin
+            new_Vertices (1 .. Self.Vertices'Length) := Self.Vertices.all;
+
+            deallocate (Self.Vertices);
+            Self.Vertices := new_Vertices;
+         end;
+      end if;
+
+      Self.vertex_Count := Self.vertex_Count + 1;
+
+      Self.Vertices (Index_t (Self.vertex_Count)).Site  := end_Site;
+      Self.Vertices (Index_t (Self.vertex_Count)).Color := (Self.Color, opaque_Value);
+
+      Self.needs_Rebuild := True;
+   end add_Segment;
+
+
+
+   procedure Site_is (Self : in out Item;   Now     : in Vector_3;
+                                            for_End : in Integer)
+   is
+   begin
+      Self.Vertices (Index_t (for_End)).Site := Now;
+      Self.Points.replace_Element (for_End, Now);
+      set_Bounds (Self);
+      Self.needs_Rebuild := True;
+   end Site_is;
+
+
+
+   procedure Color_is (Self : in out Item;   Now     : in Color;
+                                             for_End : in Integer)
+   is
+   begin
+      Self.Vertices (Index_t (for_End)).Color := (+Now, opaque_Value);
+      Self.needs_Rebuild := True;
+   end Color_is;
+
+
+
+   function Segments (Self : in Item) return Segments_t
+   is
+      the_Segments : Segments_t (1 .. Integer (Self.Points.Length) - 1);
+   begin
+      for Each in the_Segments'Range
+      loop
+         the_Segments (Each) := (First => Self.Points.Element (Each),
+                                 Last  => Self.Points.Element (Each + 1));
+      end loop;
+
+      return the_Segments;
+   end Segments;
+
+
+
+   function Angle_in_xz_plane (the_Segment : in Segment) return Radians
+   is
+      use real_Functions;
+      the_Vector : constant Vector_3 := the_Segment.Last - the_Segment.First;
+   begin
+      return arcTan (the_Vector (3) / the_Vector (1));
+   end Angle_in_xz_plane;
+
+
+end openGL.Model.segment_line;

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

@@ -0,0 +1,86 @@
+with
+     openGL.Font;
+
+private
+with
+     openGL.Geometry.colored,
+     ada.Containers.Vectors;
+
+
+package openGL.Model.segment_line
+--
+--  Models a segmented line.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_segment_line_Model (Color : in openGL.Color) return View;
+
+
+   -----------
+   --- Segment
+   --
+
+   type Segment is
+      record
+         First : Vector_3;
+         Last  : Vector_3;
+      end record;
+
+   type Segments_t is array (Positive range <>) of aliased Segment;
+
+   function Angle_in_xz_plane (the_Segment : in Segment) return Radians;
+
+
+   --------------
+   --- 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;
+
+   procedure add_1st_Segment  (Self : in out Item;   start_Site : in Vector_3;
+                                                     end_Site   : in Vector_3);
+
+   procedure add_Segment      (Self : in out Item;   end_Site   : in Vector_3);
+
+   function Site              (Self : in     Item;   for_End    : in Integer) return Vector_3;
+
+   procedure Site_is          (Self : in out Item;   Now        : in Vector_3;
+                                                     for_End    : in Integer);
+
+   procedure Color_is         (Self : in out Item;   Now        : in Color;
+                                                     for_End    : in Integer);
+
+   function segment_Count     (Self : in     Item) return Natural;
+   function Segments          (Self : in     Item) return Segments_t;
+
+
+
+private
+
+   type vertex_Array_view is access all Geometry.colored.Vertex_array;
+
+   package site_Vectors is new ada.Containers.Vectors (Positive, Vector_3);
+   subtype site_Vector  is site_Vectors.Vector;
+
+
+   type Item is new Model.item with
+      record
+         Color        : openGL.rgb_Color;
+         Points       : site_Vector;
+
+         Vertices     : Vertex_array_view := new Geometry.colored.Vertex_array (1 .. 2);
+         vertex_Count : Natural           := 0;
+
+         Geometry     : openGL.Geometry.colored.view;
+      end record;
+
+end openGL.Model.segment_line;

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

@@ -0,0 +1,172 @@
+with
+     openGL.Geometry .colored,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.sphere.colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive := openGL.Model.sphere.default_latitude_Count;
+                        long_Count : in Positive := openGL.Model.sphere.default_longitude_Count;
+                        Color      : in openGL.lucid_Color) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Color      := Color;
+      Self.lat_Count  := lat_Count;
+      Self.long_Count := long_Count;
+
+      Self.define (Radius);
+
+      return Self;
+   end new_Sphere;
+
+
+   --------------
+   --- Attributes
+   --
+
+   -- NB: - An extra vertex is required at the end of each latitude ring.
+   --     - This last vertex has the same site as the rings initial vertex.
+   --     - The  last    vertex has 's' texture coord of 1.0, whereas
+   --       the  initial vertex has 's' texture coord of 0.0.
+   --
+   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 (Textures, Fonts);
+
+
+      lat_Count      : Positive renames Self.lat_Count;
+      long_Count     : Positive renames Self.long_Count;
+
+      Num_lat_strips : constant Positive := lat_Count - 1;
+
+      lat_Spacing    : constant Real := Degrees_180 / Real (lat_Count - 1);
+      long_Spacing   : constant Real := Degrees_360 / Real (long_Count);
+
+      indices_Count  : constant long_Index_t := long_Index_t (Num_lat_strips * (long_Count + 1) * 2);
+      vertex_Count   : constant      Index_t :=   1 + 1                                                  -- North and south pole.
+                                                + Index_t ((long_Count + 1) * (lat_Count - 2));          -- Each latitude ring.
+
+      the_Sites      : aliased  Sites                         := [1 ..  vertex_Count => <>];
+      the_Indices    : aliased  Indices                       := [1 .. indices_Count => <>];
+      the_Vertices   : aliased  Geometry.colored.Vertex_array := [1 ..  vertex_Count => <>];
+
+      Color          : constant openGL.rgba_Color := to_rgba_Color (Self.Color);
+      the_Geometry   : constant Geometry.colored.view     := Geometry.colored.new_Geometry;
+
+   begin
+      set_Sites:
+      declare
+         use linear_Algebra_3d;
+
+         north_Pole : constant Site := [0.0,  0.5,  0.0];
+         south_Pole : constant Site := [0.0, -0.5,  0.0];
+
+         the_Site : Site    := north_Pole;
+         vert_Id  : Index_t := 1;              -- Start at '1' (not '0')to account for north pole.
+         a, b     : Real    := 0.0;            -- Angular 'cursors' used to track lat/long for texture coords.
+
+         latitude_line_First : Site;
+
+      begin
+         the_Sites    (the_Vertices'First)       := north_Pole;
+         the_Vertices (the_Vertices'First).Site  := north_Pole;
+         the_Vertices (the_Vertices'First).Color := Color;
+
+         the_Sites    (the_Vertices'Last)        := south_Pole;
+         the_Vertices (the_Vertices'Last).Site   := south_Pole;
+         the_Vertices (the_Vertices'Last).Color  := Color;
+
+         for lat_Id in 2 .. lat_Count - 1
+         loop
+            a := 0.0;
+            b := b + lat_Spacing;
+
+            the_Site            := the_Site * z_Rotation_from (lat_Spacing);
+            latitude_line_First := the_Site;                      -- Store initial latitude lines 1st point.
+
+            vert_Id             := vert_Id + 1;
+            the_Sites (vert_Id) := the_Site;                      -- Add 1st point on a line of latitude.
+
+            the_Vertices (vert_Id).Site  := the_Site;
+            the_Vertices (vert_Id).Color := Color;
+
+            for long_Id in 1 .. long_Count
+            loop
+               a := a + long_Spacing;
+
+               if long_Id /= long_Count
+               then   the_Site := the_Site * y_Rotation_from (-long_Spacing);
+               else   the_Site := latitude_line_First;             -- Restore the_Vertex back to initial latitude lines 1st point.
+               end if;
+
+               vert_Id             := vert_Id + 1;
+               the_Sites (vert_Id) := the_Site;                    -- Add each succesive point on a line of latitude.
+
+               the_Vertices (vert_Id).Site  := the_Site;
+               the_Vertices (vert_Id).Color := Color;
+            end loop;
+
+         end loop;
+      end set_Sites;
+
+
+      for i in the_Vertices'Range
+      loop
+         the_Vertices (i).Site := the_Vertices (i).Site * Self.Radius;
+      end loop;
+
+
+      set_Indices:
+      declare
+         strip_Id : long_Index_t := 0;
+
+         Upper : Index_t;
+         Lower : Index_t;
+      begin
+         upper := 1;
+         lower := 2;
+
+         for lat_Strip in 1 .. num_lat_Strips
+         loop
+            for Each in 1 .. long_Count + 1
+            loop
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Upper;
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Lower;
+
+               if lat_Strip /= 1              then   Upper := Upper + 1;   end if;
+               if lat_Strip /= num_lat_Strips then   Lower := Lower + 1;   end if;
+            end loop;
+
+            if lat_Strip = 1 then
+               Upper := 2;
+            end if;
+
+            Lower := Upper + Index_t (long_Count) + 1;
+         end loop;
+      end set_Indices;
+
+
+      the_Geometry.is_Transparent (False);
+      the_Geometry.Vertices_are   (the_Vertices);
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.sphere.colored;

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

@@ -0,0 +1,40 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.sphere.colored
+--
+--  Models a colored sphere.
+--
+is
+   type Item is new Model.sphere.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive := openGL.Model.sphere.default_latitude_Count;
+                        long_Count : in Positive := openGL.Model.sphere.default_longitude_Count;
+                        Color      : in openGL.lucid_Color) 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;
+
+
+private
+
+   type Item is new Model.sphere.item with
+      record
+         Color : openGL.lucid_Color;
+      end record;
+
+end openGL.Model.sphere.colored;

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

@@ -0,0 +1,189 @@
+with
+     openGL.Geometry .lit_colored,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.sphere.lit_colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive := default_latitude_Count;
+                        long_Count : in Positive := default_longitude_Count;
+                        Color      : in lucid_Color) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.Color      := Color;
+      Self.lat_Count  := lat_Count;
+      Self.long_Count := long_Count;
+
+      Self.define (Radius);
+
+      return Self;
+   end new_Sphere;
+
+
+   --------------
+   --- Attributes
+   --
+
+   --  NB: - An extra vertex is required at the end of each latitude ring.
+   --      - This last vertex has the same site as the rings initial vertex.
+   --      - The  last    vertex has 's' texture coord of 1.0, whereas
+   --        the  initial vertex has 's' texture coord of 0.0.
+   --
+   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 (Textures, Fonts);
+
+      use Geometry,
+          Geometry.lit_colored;
+
+      lat_Count      : Positive renames Self.lat_Count;
+      long_Count     : Positive renames Self.long_Count;
+
+      Num_lat_strips : constant Positive := lat_Count - 1;
+
+      lat_Spacing    : constant Real := Degrees_180 / Real (lat_Count - 1);
+      long_Spacing   : constant Real := Degrees_360 / Real (long_Count);
+
+      indices_Count  : constant long_Index_t  := long_Index_t (Num_lat_strips * (long_Count + 1) * 2);
+      vertex_Count   : constant      Index_t  :=   1 + 1                                                 -- North and south pole.
+                                                 + Index_t ((long_Count + 1) * (lat_Count - 2));         -- Each latitude ring.
+
+      the_Vertices   : aliased  Geometry.lit_colored.Vertex_array := [1 ..  vertex_Count => <>];
+      the_Sites      : aliased  Sites                             := [1 ..  vertex_Count => <>];
+      the_Indices    : aliased  Indices                           := [1 .. indices_Count => <>];
+
+      Color          : constant rgba_Color                := to_rgba_Color (Self.Color);
+      the_Geometry   : constant Geometry.lit_colored.view := Geometry.lit_colored.new_Geometry;
+
+   begin
+      set_Sites:
+      declare
+         use linear_Algebra,
+             linear_Algebra_3D;
+
+         north_Pole : constant Site := [0.0,  0.5,  0.0];
+         south_Pole : constant Site := [0.0, -0.5,  0.0];
+
+         the_Site   : Site    := north_Pole;
+         vert_Id    : Index_t := 1;        -- Start at '1' (not '0') to account for the northpole.
+
+         latitude_line_First : Site;
+
+         a, b : Real := 0.0;               -- Angular 'cursors' used to track lat/long for texture coords.
+
+      begin
+         the_Sites (the_Vertices'First)           := north_Pole;
+
+         the_Vertices (the_Vertices'First).Site   := north_Pole;
+         the_Vertices (the_Vertices'First).Normal := Normalised (north_Pole);
+         the_Vertices (the_Vertices'First).Color  := Color;
+         the_Vertices (the_Vertices'First).Shine  := 0.5;
+
+         the_Sites (the_Vertices'Last)            := south_Pole;
+
+         the_Vertices (the_Vertices'Last).Site    := south_Pole;
+         the_Vertices (the_Vertices'Last).Normal  := Normalised (south_Pole);
+         the_Vertices (the_Vertices'Last).Color   := Color;
+         the_Vertices (the_Vertices'Last).Shine   := 0.5;
+
+
+         for lat_Id in 2 .. lat_Count - 1
+         loop
+            a := 0.0;
+            b := b + lat_Spacing;
+
+            the_Site            := the_Site * z_Rotation_from (lat_Spacing);
+            latitude_line_First := the_Site;                   -- Store initial latitude lines 1st point.
+
+            vert_Id             := vert_Id + 1;
+            the_Sites (vert_Id) := the_Site;                   -- Add 1st point on a line of latitude.
+
+            the_Vertices (vert_Id).Site   := the_Site;
+            the_Vertices (vert_Id).Normal := Normalised (the_Site);
+            the_Vertices (vert_Id).Color  := Color;
+            the_Vertices (vert_Id).Shine  := 0.5;
+
+            for long_Id in 1 .. long_Count
+            loop
+               a := a + long_Spacing;
+
+               if long_Id /= long_Count
+               then   the_Site := the_Site * y_Rotation_from (-long_Spacing);
+               else   the_Site := latitude_line_First;         -- Restore the_Vertex back to initial latitude lines 1st point.
+               end if;
+
+               vert_Id             := vert_Id + 1;
+               the_Sites (vert_Id) := the_Site;                -- Add each succesive point on a line of latitude.
+
+               the_Vertices (vert_Id).Site   := the_Site;
+               the_Vertices (vert_Id).Normal := Normalised (the_Site);
+               the_Vertices (vert_Id).Color  := Color;
+               the_Vertices (vert_Id).Shine  := 0.5;
+            end loop;
+
+         end loop;
+      end set_Sites;
+
+
+      for i in the_Vertices'Range
+      loop
+         the_Vertices (i).Site := the_Vertices (i).Site * Self.Radius * 2.0;
+      end loop;
+
+
+      set_Indices:
+      declare
+         strip_Id : long_Index_t := 0;
+
+         Upper    : Index_t;
+         Lower    : Index_t;
+
+      begin
+         upper := 1;
+         lower := 2;
+
+         for lat_Strip in 1 .. num_lat_Strips
+         loop
+            for Each in 1 .. long_Count + 1
+            loop
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Upper;
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Lower;
+
+               if lat_Strip /= 1              then   Upper := Upper + 1;   end if;
+               if lat_Strip /= num_lat_Strips then   Lower := Lower + 1;   end if;
+            end loop;
+
+
+            if lat_Strip = 1 then
+               Upper := 2;
+            end if;
+
+            Lower := Upper + Index_t (long_Count) + 1;
+         end loop;
+      end set_Indices;
+
+
+      the_Geometry.is_Transparent (False);
+      the_Geometry.Vertices_are (the_Vertices);
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Strip, the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.sphere.lit_colored;

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

@@ -0,0 +1,42 @@
+with
+     openGL.Font,
+     openGL.Geometry;
+
+
+package openGL.Model.sphere.lit_colored
+--
+--  Models a lit, colored sphere.
+--
+is
+   type Item is new Model.sphere.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive := default_latitude_Count;
+                        long_Count : in Positive := default_longitude_Count;
+                        Color      : in lucid_Color) 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;
+
+
+
+private
+
+   type Item is new Model.sphere.item with
+      record
+         Color : lucid_Color;
+      end record;
+
+end openGL.Model.sphere.lit_colored;

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

@@ -0,0 +1,216 @@
+with
+     openGL.Palette,
+     openGL.Geometry.lit_colored_textured,
+     openGL.Texture,
+     openGL.IO,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.sphere.lit_colored_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive   := default_latitude_Count;
+                        long_Count : in Positive   := default_longitude_Count;
+                        Image      : in asset_Name := null_Asset) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.define (Radius);
+
+      Self.lat_Count  := lat_Count;
+      Self.long_Count := long_Count;
+      Self.Image      := Image;
+
+      return Self;
+   end new_Sphere;
+
+
+   --------------
+   --- Attributes
+   --
+
+   type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
+
+
+   --  NB: - An extra vertex is required at the end of each latitude ring.
+   --      - This last vertex has the same site as the rings initial vertex.
+   --      - The  last    vertex has 's' texture coord of 1.0, whereas
+   --        the  initial vertex has 's' texture coord of 0.0.
+   --
+   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 (Textures, Fonts);
+
+      use openGL.Geometry,
+          openGL.Palette,
+          openGL.Geometry.lit_colored_textured;
+
+      lat_Count      : Positive renames Self.lat_Count;
+      long_Count     : Positive renames Self.long_Count;
+
+      Num_lat_strips : constant Positive := lat_Count - 1;
+
+      lat_Spacing    : constant Real := Degrees_180 / Real (lat_Count - 1);
+      long_Spacing   : constant Real := Degrees_360 / Real (long_Count);
+
+      vertex_Count   : constant Index_t      :=   1 + 1                                           -- North and south pole.
+                                                + Index_t ((long_Count + 1) * (lat_Count - 2));   -- Each latitude ring.
+
+      indices_Count  : constant long_Index_t := long_Index_t (Num_lat_strips * (long_Count + 1) * 2);
+
+      the_Vertices   : aliased  Geometry.lit_colored_textured.Vertex_array := [1 ..  vertex_Count => <>];
+      the_Indices    : aliased  Indices                                    := [1 .. indices_Count => <>];
+      the_Sites      : aliased  Sites                                      := [1 ..  vertex_Count => <>];
+
+      the_Geometry   : constant Geometry_view := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False);
+
+   begin
+      set_Sites:
+      declare
+         use linear_Algebra,
+             linear_Algebra_3d;
+
+         north_Pole : constant Site := [0.0,  0.5,  0.0];
+         south_Pole : constant Site := [0.0, -0.5,  0.0];
+
+         the_Site   : Site    := north_Pole;
+         vert_Id    : Index_t := 1;            -- Start at '1' (not '0')to account for north pole.
+         a, b       : Real    := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+
+         latitude_line_First : Site;
+
+      begin
+         the_Sites (the_Vertices'First) := north_Pole;
+
+         the_Vertices (the_Vertices'First).Site   := north_Pole;
+         the_Vertices (the_Vertices'First).Normal := Normalised (north_Pole);
+         the_Vertices (the_Vertices'First).Shine  := 0.5;
+         the_Vertices (the_Vertices'First).Coords := (S => 0.5, T => 1.0);
+         the_Vertices (the_Vertices'First).Color  := (Primary => +White,
+                                                      Alpha   => opaque_Value);
+
+         the_Sites (the_Vertices'Last) := south_Pole;
+
+         the_Vertices (the_Vertices'Last).Site    := south_Pole;
+         the_Vertices (the_Vertices'Last).Normal  := Normalised (south_Pole);
+         the_Vertices (the_Vertices'Last).Shine   := 0.5;
+         the_Vertices (the_Vertices'Last).Coords  := (S => 0.5, T => 0.0);
+         the_Vertices (the_Vertices'Last).Color   := (Primary => +White,
+                                                      Alpha   => opaque_Value);
+
+         for lat_Id in 2 .. lat_Count - 1
+         loop
+            a := 0.0;
+            b := b + lat_Spacing;
+
+            the_Site            := the_Site * z_Rotation_from (lat_Spacing);
+            latitude_line_First := the_Site;                 -- Store initial latitude lines 1st point.
+
+            vert_Id             := vert_Id + 1;
+            the_Sites (vert_Id) := the_Site;                 -- Add 1st point on a line of latitude.
+
+            the_Vertices (vert_Id).Site   := the_Site;
+            the_Vertices (vert_Id).Normal := Normalised (the_Site);
+            the_Vertices (vert_Id).Shine  := 0.5;
+            the_Vertices (vert_Id).Color  := (Primary => +White,
+                                              Alpha   => opaque_Value);
+            the_Vertices (vert_Id).Coords := (S =>       a / Degrees_360,
+                                              T => 1.0 - b / Degrees_180);
+
+            for long_Id in 1 .. long_Count
+            loop
+               a := a + long_Spacing;
+
+               if long_Id /= long_Count
+               then   the_Site := the_Site * y_Rotation_from (-long_Spacing);
+               else   the_Site := latitude_line_First;       -- Restore the_Vertex back to initial latitude lines 1st point.
+               end if;
+
+               vert_Id             := vert_Id + 1;
+               the_Sites (vert_Id) := the_Site;              -- Add each succesive point on a line of latitude.
+
+               the_Vertices (vert_Id).Site   := the_Site;
+               the_Vertices (vert_Id).Normal := Normalised (the_Site);
+               the_Vertices (vert_Id).Shine  := 0.5;
+               the_Vertices (vert_Id).Color  := (Primary => +White,
+                                                 Alpha   => opaque_Value);
+               the_Vertices (vert_Id).Coords := (S =>       a / Degrees_360,
+                                                 T => 1.0 - b / Degrees_180);
+            end loop;
+
+         end loop;
+      end set_Sites;
+
+
+      for i in the_Vertices'Range
+      loop
+         the_Vertices (i).Site := the_Vertices (i).Site * Self.Radius * 2.0;
+      end loop;
+
+
+      set_Indices:
+      declare
+         strip_Id : long_Index_t := 0;
+
+         Upper : Index_t;
+         Lower : Index_t;
+
+      begin
+         Upper := 1;
+         Lower := 2;
+
+         for lat_Strip in 1 .. num_lat_Strips
+         loop
+            for Each in 1 .. long_Count + 1
+            loop
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Upper;
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Lower;
+
+               if lat_Strip /= 1              then   Upper := Upper + 1;   end if;
+               if lat_Strip /= num_lat_Strips then   Lower := Lower + 1;   end if;
+            end loop;
+
+            if lat_Strip = 1
+            then
+               Upper := 2;
+            end if;
+
+            Lower := Upper + Index_t (long_Count) + 1;
+         end loop;
+      end set_Indices;
+
+
+      if Self.Image /= null_Asset     -- TODO: Use 'Textures' (ie name_Map_of_texture) here and in other models.
+      then
+         set_Texture:
+         declare
+            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);
+      the_Geometry.Vertices_are   (the_Vertices);
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.sphere.lit_colored_textured;

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

@@ -0,0 +1,34 @@
+with
+     openGL.Font,
+     openGL.Geometry;
+
+
+package openGL.Model.sphere.lit_colored_textured
+--
+--  Models a lit, colored, textured sphere.
+--
+is
+   type Item is new Model.sphere.item with private;
+   type View is access all Item'Class;
+
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive   := default_latitude_Count;
+                        long_Count : in Positive   := default_longitude_Count;
+                        Image      : in asset_Name := null_Asset) return View;
+
+
+   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;
+
+
+
+private
+
+   type Item is new Model.sphere.item with     -- TODO: Add 'Color' component.
+      record
+         Image : asset_Name := null_Asset;     -- Usually a mercator projection to be mapped onto the sphere.
+      end record;
+
+end openGL.Model.sphere.lit_colored_textured;

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

@@ -0,0 +1,193 @@
+with
+     openGL.Geometry.lit_textured,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.sphere.lit_textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive   := default_latitude_Count;
+                        long_Count : in Positive   := default_longitude_Count;
+                        Image      : in asset_Name := null_Asset) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.define (Radius);
+
+      Self.lat_Count  := lat_Count;
+      Self.long_Count := long_Count;
+      Self.Image      := Image;
+
+      return Self;
+   end new_Sphere;
+
+
+   --------------
+   --- Attributes
+   --
+
+   --  NB: - An extra vertex is required at the end of each latitude ring.
+   --      - This last vertex has the same site as the rings initial vertex.
+   --      - The  last    vertex has 's' texture coord of 1.0, whereas
+   --        the  initial vertex has 's' texture coord of 0.0.
+   --
+   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.lit_textured;
+
+      lat_Count      : Positive renames Self.lat_Count;
+      long_Count     : Positive renames Self.long_Count;
+
+      Num_lat_strips : constant Positive := lat_Count - 1;
+
+      lat_Spacing    : constant Real := Degrees_180 / Real (lat_Count - 1);
+      long_Spacing   : constant Real := Degrees_360 / Real (long_Count);
+
+      vertex_Count   : constant Index_t      :=   1 + 1                                           -- North and south pole.
+                                                + Index_t ((long_Count + 1) * (lat_Count - 2));   -- Each latitude ring.
+
+      indices_Count  : constant long_Index_t := long_Index_t (Num_lat_strips * (long_Count + 1) * 2);
+
+      the_Vertices   : aliased  Geometry.lit_textured.Vertex_array := [1 ..  vertex_Count => <>];
+      the_Sites      : aliased  Sites                              := [1 ..  vertex_Count => <>];
+      the_Indices    : aliased  Indices                            := [1 .. indices_Count => <>];
+
+      the_Geometry   : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
+
+   begin
+      set_Sites:
+      declare
+         use linear_Algebra,
+             linear_Algebra_3d;
+
+         north_Pole : constant Site := [0.0,  0.5,  0.0];
+         south_Pole : constant Site := [0.0, -0.5,  0.0];
+
+         the_Site   : Site    := north_Pole;
+         vert_Id    : Index_t := 1;            -- Start at '1' (not '0')to account for north pole.
+         a, b       : Real    := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+
+         latitude_line_First : Site;
+
+      begin
+         the_Sites (the_Vertices'First) := north_Pole;
+
+         the_Vertices (the_Vertices'First).Site   := north_Pole;
+         the_Vertices (the_Vertices'First).Normal := Normalised (north_Pole);
+         the_Vertices (the_Vertices'First).Coords := (S => 0.5, T => 1.0);
+         the_Vertices (the_Vertices'First).Shine  := 0.5;
+
+         the_Sites (the_Vertices'Last) := south_Pole;
+
+         the_Vertices (the_Vertices'Last).Site    := south_Pole;
+         the_Vertices (the_Vertices'Last).Normal  := Normalised (south_Pole);
+         the_Vertices (the_Vertices'Last).Coords  := (S => 0.5, T => 0.0);
+         the_Vertices (the_Vertices'Last).Shine   := 0.5;
+
+         for lat_Id in 2 .. lat_Count - 1
+         loop
+            a := 0.0;
+            b := b + lat_Spacing;
+
+            the_Site            := the_Site * z_Rotation_from (lat_Spacing);
+            latitude_line_First := the_Site;                 -- Store initial latitude lines 1st point.
+
+            vert_Id             := vert_Id + 1;
+            the_Sites (vert_Id) := the_Site;                 -- Add 1st point on a line of latitude.
+
+            the_Vertices (vert_Id).Site   := the_Site;
+            the_Vertices (vert_Id).Normal := Normalised (the_Site);
+            the_Vertices (vert_Id).Coords := (S =>       a / Degrees_360,
+                                              T => 1.0 - b / Degrees_180);
+            the_Vertices (vert_Id).Shine  := 0.5;
+
+            for long_Id in 1 .. long_Count
+            loop
+               a := a + long_Spacing;
+
+               if long_Id /= long_Count
+               then   the_Site := the_Site * y_Rotation_from (-long_Spacing);
+               else   the_Site := latitude_line_First;       -- Restore the_Vertex back to initial latitude lines 1st point.
+               end if;
+
+               vert_Id             := vert_Id + 1;
+               the_Sites (vert_Id) := the_Site;              -- Add each succesive point on a line of latitude.
+
+               the_Vertices (vert_Id).Site   := the_Site;
+               the_Vertices (vert_Id).Normal := Normalised (the_Site);
+               the_Vertices (vert_Id).Coords := (S =>       a / Degrees_360,
+                                                 T => 1.0 - b / Degrees_180);
+               the_Vertices (vert_Id).Shine  := 0.5;
+            end loop;
+
+         end loop;
+      end set_Sites;
+
+
+      for i in the_Vertices'Range
+      loop
+         the_Vertices (i).Site := the_Vertices (i).Site * Self.Radius * 2.0;
+      end loop;
+
+
+      set_Indices:
+      declare
+         strip_Id : long_Index_t := 0;
+
+         Upper : Index_t;
+         Lower : Index_t;
+
+      begin
+         Upper := 1;
+         Lower := 2;
+
+         for lat_Strip in 1 .. num_lat_Strips
+         loop
+            for Each in 1 .. long_Count + 1
+            loop
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Upper;
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Lower;
+
+               if lat_Strip /= 1              then   Upper := Upper + 1;   end if;
+               if lat_Strip /= num_lat_Strips then   Lower := Lower + 1;   end if;
+            end loop;
+
+            if lat_Strip = 1
+            then
+               Upper := 2;
+            end if;
+
+            Lower := Upper + Index_t (long_Count) + 1;
+         end loop;
+      end set_Indices;
+
+
+      if Self.Image /= null_Asset
+      then
+         the_Geometry.Texture_is (Textures.fetch (Self.Image));
+         the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
+      end if;
+
+      the_Geometry.Vertices_are (the_Vertices);
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.sphere.lit_textured;

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

@@ -0,0 +1,36 @@
+with
+     openGL.Font,
+     openGL.Geometry;
+
+
+package openGL.Model.sphere.lit_textured
+--
+--  Models a lit and textured sphere.
+--
+--  The texture is often a mercator projection to be mapped onto the sphere.
+--
+is
+   type Item is new Model.sphere.item with private;
+   type View is access all Item'Class;
+
+
+   function new_Sphere (Radius     : in Real;
+                        lat_Count  : in Positive   := default_latitude_Count;
+                        long_Count : in Positive   := default_longitude_Count;
+                        Image      : in asset_Name := null_Asset) return View;
+
+
+   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;
+
+
+
+private
+
+   type Item is new Model.sphere.item with     -- TODO: Add 'Color' component.
+      record
+         Image : asset_Name := null_Asset;
+      end record;
+
+end openGL.Model.sphere.lit_textured;

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

@@ -0,0 +1,203 @@
+with
+     openGL.Geometry.textured,
+     openGL.Texture,
+     openGL.IO,
+     openGL.Primitive.indexed;
+
+
+package body openGL.Model.sphere.textured
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius       : in Real;
+                        lat_Count    : in Positive   := 26;
+                        long_Count   : in Positive   := 52;
+                        Image        : in asset_Name := null_Asset;
+                        is_Skysphere : in Boolean    := False) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.lat_Count    := lat_Count;
+      Self.long_Count   := long_Count;
+      Self.Image        := Image;
+      Self.is_Skysphere := is_Skysphere;
+
+      Self.define (Radius);
+
+      return Self;
+   end new_Sphere;
+
+
+   --------------
+   --- Attributes
+   --
+
+   --  NB: - An extra vertex is required at the end of each latitude ring.
+   --      - This last vertex has the same site as the rings initial vertex.
+   --      - The  last    vertex has 's' texture coord of 1.0, whereas
+   --        the  initial vertex has 's' texture coord of 0.0.
+   --
+   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 (Textures, Fonts);
+
+      use Geometry,
+          Geometry.textured;
+
+      lat_Count      : Positive renames Self.lat_Count;
+      long_Count     : Positive renames Self.long_Count;
+
+      Num_lat_strips : constant Positive := lat_Count - 1;
+
+      lat_Spacing    : constant Real := Degrees_180 / Real (lat_Count - 1);
+      long_Spacing   : constant Real := Degrees_360 / Real (long_Count);
+
+      vertex_Count   : constant Index_t      :=   1 + 1                                           -- North and south pole.
+                                                + Index_t ((long_Count + 1) * (lat_Count - 2));   -- Each latitude ring.
+
+      indices_Count  : constant long_Index_t := long_Index_t (Num_lat_strips * (long_Count + 1) * 2);
+
+      the_Vertices   : aliased  Geometry.textured.Vertex_array := [1 .. vertex_Count  => <>];
+      the_Indices    : aliased  Indices                        := [1 .. indices_Count => <>];
+
+      the_Geometry   : constant Geometry.textured.view := Geometry.textured.new_Geometry;
+
+   begin
+      set_Sites:
+      declare
+         use linear_Algebra_3d;
+
+         north_Pole : constant Site := [0.0,  0.5,  0.0];
+         south_Pole : constant Site := [0.0, -0.5,  0.0];
+
+         the_Site : Site    := north_Pole;
+         vert_Id  : Index_t := 1;            -- Start at '1' (not '0')to account for north pole.
+         a, b     : Real    := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+
+         latitude_line_First : Site;
+
+      begin
+         the_Vertices (the_Vertices'First).Site   := north_Pole;
+         the_Vertices (the_Vertices'First).Coords := (S => 0.5, T => 1.0);
+
+         the_Vertices (the_Vertices'Last).Site    := south_Pole;
+         the_Vertices (the_Vertices'Last).Coords  := (S => 0.5, T => 0.0);
+
+         for lat_Id in 2 .. lat_Count - 1
+         loop
+            a := 0.0;
+            b := b + lat_Spacing;
+
+            the_Site            := the_Site * z_rotation_from (lat_Spacing);
+            latitude_line_First := the_Site;                 -- Store initial latitude lines 1st point.
+
+            vert_Id             := vert_Id + 1;
+
+            the_Vertices (vert_Id).Site   := the_Site;
+            the_Vertices (vert_Id).Coords := (S => a / Degrees_360,
+                                              T => 1.0 - b / Degrees_180);
+
+            for long_Id in 1 .. long_Count
+            loop
+               a := a + long_Spacing;
+
+               if long_Id /= long_Count
+               then   the_Site := the_Site * y_rotation_from (-long_Spacing);
+               else   the_Site := latitude_line_First;       -- Restore the_Vertex back to initial latitude lines 1st point.
+               end if;
+
+               vert_Id := vert_Id + 1;
+
+               the_Vertices (vert_Id).Site   := the_Site;
+               the_Vertices (vert_Id).Coords := (S =>       a / Degrees_360,
+                                                 T => 1.0 - b / Degrees_180);
+            end loop;
+
+         end loop;
+      end set_Sites;
+
+
+      for i in the_Vertices'Range
+      loop
+         the_Vertices (i).Site := the_Vertices (i).Site * Self.Radius * 2.0;
+      end loop;
+
+
+      set_Indices:
+      declare
+         strip_Id : long_Index_t := 0;
+
+         Upper : Index_t;
+         Lower : Index_t;
+
+      begin
+         upper := 1;
+         lower := 2;
+
+         for lat_Strip in 1 .. num_lat_Strips
+         loop
+            for Each in 1 .. long_Count + 1
+            loop
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Upper;
+               strip_Id := strip_Id + 1;   the_Indices (strip_Id) := Lower;
+
+               if lat_Strip /= 1              then   Upper := Upper + 1;   end if;
+               if lat_Strip /= num_lat_Strips then   Lower := Lower + 1;   end if;
+            end loop;
+
+            if lat_Strip = 1
+            then
+               Upper := 2;
+            end if;
+
+            Lower := Upper + Index_t (long_Count) + 1;
+         end loop;
+      end set_Indices;
+
+
+      declare
+         Pad : Index_t;
+      begin
+         for i in the_Indices'Range
+         loop
+            if i mod 2 = 1
+            then
+               Pad               := the_Indices (i);
+               the_Indices (i)   := the_Indices (i+1);
+               the_Indices (i+1) := Pad;
+            end if;
+         end loop;
+      end;
+
+      if Self.Image /= null_Asset
+      then
+         set_Texture:
+         declare
+            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);   -- TODO: Base this on vertex data.
+      the_Geometry.Vertices_are   (the_Vertices);
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+end openGL.Model.sphere.textured;

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

@@ -0,0 +1,42 @@
+with
+     openGL.Font,
+     openGL.Geometry;
+
+
+package openGL.Model.sphere.textured
+--
+--  Models a textured sphere.
+--
+is
+   type Item is new Model.sphere.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Sphere (Radius       : in Real;
+                        lat_Count    : in Positive   := 26;
+                        long_Count   : in Positive   := 52;
+                        Image        : in asset_Name := null_Asset;
+                        is_Skysphere : in Boolean    := False) 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;
+
+
+private
+
+   type Item is new Model.sphere.item with
+      record
+         Image        : asset_Name := null_Asset;     -- Usually a mercator projection to be mapped onto the sphere.
+         is_Skysphere : Boolean    := False;
+      end record;
+
+end openGL.Model.sphere.textured;

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

@@ -0,0 +1,30 @@
+package body openGL.Model.sphere
+is
+
+   ---------
+   --- Forge
+   --
+
+   procedure define (Self : out Item;   Radius : Real)
+   is
+   begin
+      Self.Radius := Radius;
+   end define;
+
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   function Bounds (Self : in Item) return openGL.Bounds
+   is
+   begin
+      return (Ball => Self.Radius,
+              Box  => (Lower => [-Self.Radius, -Self.Radius, -Self.Radius],
+                       Upper => [ Self.Radius,  Self.Radius,  Self.Radius]));
+   end Bounds;
+
+
+end openGL.Model.sphere;

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

@@ -0,0 +1,45 @@
+package openGL.Model.sphere
+--
+--  Provides an abstract model of a sphere.
+--
+is
+   type Item is abstract new Model.item with private;
+   type View is access all Item'Class;
+
+
+   default_latitude_Count  : constant := 26;
+   default_longitude_Count : constant := 52;
+
+
+   ---------
+   --- Forge
+   --
+
+   procedure define (Self : out Item;   Radius : Real);
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   function Bounds (Self : in Item) return openGL.Bounds;
+
+
+
+private
+
+   type Item is abstract new Model.item with
+      record
+         Radius     : Real;
+
+         lat_Count  : Positive;
+         long_Count : Positive;
+      end record;
+
+
+   Degrees_180 : constant := Pi;
+   Degrees_360 : constant := Pi * 2.0;
+
+
+end openGL.Model.sphere;

3-mid/opengl/source/lean/model/opengl-model-terrain.adb

@@ -0,0 +1,285 @@
+with
+     openGL.Geometry.lit_textured,
+     openGL.Primitive.indexed,
+     openGL.Texture.Coordinates,
+     openGL.IO,
+
+     ada.unchecked_Deallocation;
+
+
+package body openGL.Model.terrain
+is
+   use Texture;
+
+   --------
+   -- Forge
+   --
+
+   function new_Terrain (heights_Asset : in asset_Name;
+                         Row, Col      : in Integer;
+                         Heights       : in height_Map_view;
+                         color_Map     : in asset_Name;
+                         Tiling        : in texture_Transform_2d := (S => (0.0, 1.0),
+                                                                     T => (0.0, 1.0))) return View
+   is
+      the_Model : constant View := new Item' (Model.item with
+                                              heights_Asset => heights_Asset,
+                                              Heights       => Heights,
+                                              Row           => Row,
+                                              Col           => Col,
+                                              color_Map     => color_Map,
+                                              tiling        => Tiling);
+   begin
+      the_Model.set_Bounds;
+      return the_Model;
+   end new_Terrain;
+
+
+
+   overriding
+   procedure destroy (Self : in out Item)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (height_Map,
+                                                              height_Map_view);
+   begin
+      destroy (Model.Item (Self));
+      deallocate (Self.Heights);
+   end destroy;
+
+
+   -------------
+   -- 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
+   is
+      pragma unreferenced (Textures, Fonts);
+
+      use Geometry,
+          Geometry.lit_textured;
+
+      Heights       :          height_Map_view renames Self.Heights;
+
+      row_Count     : constant Index_t      := Heights'Length (1) - 1;
+      col_Count     : constant Index_t      := Heights'Length (2) - 1;
+
+      vertex_Count  : constant Index_t      := Heights'Length (1) * Heights'Length (2);
+
+      indices_Count : constant long_Index_t :=   (2 * (long_Index_t (Heights'Length (2)) + 1)) * (long_Index_t (row_Count) - 1)
+                                               +  2 * (long_Index_t (Heights'Length (2)));
+
+      the_Sites     : aliased  Sites         := [1 .. vertex_Count => <>];
+      the_Bounds    :          openGL.Bounds := null_Bounds;
+
+      the_Vertices  : aliased  Geometry.lit_textured.Vertex_array := [1 .. vertex_Count  => <>];
+      the_Indices   : aliased  Indices                            := [1 .. indices_Count => <>];
+
+      the_Geometry  : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry;
+
+   begin
+      set_Sites:
+      declare
+         vert_Id          :          Index_t  := 0;
+         the_height_Range : constant Vector_2 := height_Extent (Heights.all);
+         Middle           : constant Real     := (the_height_Range (1) + the_height_Range (2))  /  2.0;
+         flipped_Row      :          Index_t;
+      begin
+         for Row in 1 .. row_Count + 1
+         loop
+            for Col in 1 .. col_Count + 1
+            loop
+               vert_Id     := vert_Id + 1;
+               flipped_Row := 2 + row_Count - Row;     -- Flipping the row simplifies building the triangle strip below.
+
+               the_Sites (vert_Id) := [Real (Col)                 - Real (col_Count) / 2.0 - 1.0,
+                                       Heights (flipped_Row, Col) - Middle,
+                                       Real (Row)                 - Real (row_Count) / 2.0 - 1.0];
+
+               the_Bounds.Box.Lower (1) := Real'Min (the_Bounds.Box.Lower (1),  the_Sites (vert_Id) (1));
+               the_Bounds.Box.Lower (2) := Real'Min (the_Bounds.Box.Lower (2),  the_Sites (vert_Id) (2));
+               the_Bounds.Box.Lower (3) := Real'Min (the_Bounds.Box.Lower (3),  the_Sites (vert_Id) (3));
+
+               the_Bounds.Box.Upper (1) := Real'Max (the_Bounds.Box.Upper (1),  the_Sites (vert_Id) (1));
+               the_Bounds.Box.Upper (2) := Real'Max (the_Bounds.Box.Upper (2),  the_Sites (vert_Id) (2));
+               the_Bounds.Box.Upper (3) := Real'Max (the_Bounds.Box.Upper (3),  the_Sites (vert_Id) (3));
+
+               the_Bounds.Ball := Real'Max (the_Bounds.Ball,
+                                            abs (the_Sites (vert_Id)));
+
+               the_Vertices (vert_Id).Site  := the_Sites (vert_Id);
+            end loop;
+         end loop;
+
+         the_Bounds.Ball := the_Bounds.Ball * 1.1;     -- TODO: Why the '* 1.1' ?
+      end set_Sites;
+
+
+      set_Indices:
+      declare
+         Cursor : long_Index_t := 0;
+         Start,
+         Upper,
+         Lower  : Index_t;
+      begin
+         Start := 1;
+
+         for Row in 1 .. row_Count
+         loop
+            Upper := Start;
+            Lower := Start + col_Count + 1;
+
+            for Col in 1 .. col_Count + 1
+            loop
+               Cursor := Cursor + 1;   the_Indices (Cursor) := Upper;
+               Cursor := Cursor + 1;   the_Indices (Cursor) := Lower;
+
+               if Col /= col_Count + 1
+               then
+                  Upper := Upper + 1;
+                  Lower := Lower + 1;
+               end if;
+            end loop;
+
+            if Row /= row_Count   -- Not the last row.
+            then
+               -- Add 1st redundant triangle to allow for next strip.
+               Cursor := Cursor + 1;   the_Indices (Cursor) := Lower;
+
+               -- Advance Start index.
+               Start  := Start + col_Count + 1;
+
+               -- Add 2nd redundant triangle to allow for next strip.
+               Cursor := Cursor + 1;   the_Indices (Cursor) := Start;
+            end if;
+         end loop;
+
+      end set_Indices;
+
+
+      set_Normals:
+      declare
+         type Normals_view is access all Normals;
+
+         the_Normals : Normals_view := Geometry.Normals_of (Primitive.triangle_Strip,
+                                                            the_Indices,
+                                                            the_Sites);
+         procedure deallocate is new ada.unchecked_Deallocation (Normals,
+                                                                 Normals_view);
+
+      begin
+         for i in the_Vertices'Range
+         loop
+            the_Vertices (i).Normal := the_Normals (i);
+            the_Vertices (i).Shine  := 0.005;
+         end loop;
+
+         deallocate (the_Normals);
+      end set_Normals;
+
+
+      if Self.color_Map /= null_Asset
+      then
+         set_texture_Coords:
+         declare
+            x_Length : constant Real := the_Bounds.Box.upper (1) - the_Bounds.Box.lower (1);
+            x_Min    : constant Real := the_Bounds.Box.lower (1);
+
+            z_Length : constant Real := the_Bounds.Box.upper (3) - the_Bounds.Box.lower (3);
+            z_Min    : constant Real := the_Bounds.Box.lower (3);
+
+            upper_Generator : constant Texture.Coordinates.xz_Generator
+              := (Normalise => (S => (-x_Min, 1.0 / x_Length),
+                                T => (-z_Min, 1.0 / z_Length)),
+                  Tile      =>  Self.Tiling);
+
+            the_Coords : constant Coordinates_2D := upper_Generator.to_Coordinates (the_Sites'Access);
+         begin
+            for i in the_Coords'Range
+            loop
+               the_Vertices (i).Coords := the_Coords (i);
+            end loop;
+         end set_texture_Coords;
+
+
+         set_Texture:
+         declare
+            the_Image   : constant Image          := IO.to_Image (Self.color_Map);
+            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);
+      the_Geometry.Vertices_are   (the_Vertices);
+
+      Self.Bounds := the_Bounds;
+
+      declare
+         the_Primitive : constant Primitive.indexed.view
+           := Primitive.indexed.new_Primitive (Primitive.triangle_Strip,
+                                               the_Indices);
+      begin
+         the_Geometry.add (Primitive.view (the_Primitive));
+      end;
+
+      return [1 => Geometry.view (the_Geometry)];
+   end to_GL_Geometries;
+
+
+
+   overriding
+   procedure set_Bounds (Self : in out Item)
+   is
+      Heights      : height_Map_view renames Self.Heights;
+
+      row_Count    : constant Index_t  := Heights'Length (1) - 1;
+      col_Count    : constant Index_t  := Heights'Length (2) - 1;
+
+      vertex_Count : constant Index_t  := Heights'Length (1) * Heights'Length (2);
+
+      the_Sites    : aliased  Sites         := [1 .. vertex_Count => <>];
+      the_Bounds   :          openGL.Bounds := null_Bounds;
+
+   begin
+      set_Sites:
+      declare
+         vert_Id          :          Index_t  := 0;
+         the_height_Range : constant Vector_2 := height_Extent (Heights.all);
+         Middle           : constant Real     :=   (the_height_Range (1) + the_height_Range (2))
+                                                 / 2.0;
+      begin
+         for Row in 1 .. row_Count + 1
+         loop
+            for Col in 1 .. col_Count + 1
+            loop
+               vert_Id := vert_Id + 1;
+
+               the_Sites (vert_Id) := [Real (Col)         - Real (col_Count) / 2.0 - 1.0,
+                                       Heights (Row, Col) - Middle,
+                                       Real (Row)         - Real (row_Count) / 2.0 - 1.0];
+
+               the_Bounds.Box.Lower (1) := Real'Min (the_Bounds.Box.Lower (1),  the_Sites (vert_Id) (1));
+               the_Bounds.Box.Lower (2) := Real'Min (the_Bounds.Box.Lower (2),  the_Sites (vert_Id) (2));
+               the_Bounds.Box.Lower (3) := Real'Min (the_Bounds.Box.Lower (3),  the_Sites (vert_Id) (3));
+
+               the_Bounds.Box.Upper (1) := Real'Max (the_Bounds.Box.Upper (1),  the_Sites (vert_Id) (1));
+               the_Bounds.Box.Upper (2) := Real'Max (the_Bounds.Box.Upper (2),  the_Sites (vert_Id) (2));
+               the_Bounds.Box.Upper (3) := Real'Max (the_Bounds.Box.Upper (3),  the_Sites (vert_Id) (3));
+
+               the_Bounds.Ball := Real'Max (the_Bounds.Ball,
+                                            abs (the_Sites (vert_Id)));
+            end loop;
+         end loop;
+
+         the_Bounds.Ball := the_Bounds.Ball * 1.1;     -- TODO: Why the '* 1.1' ?
+      end set_Sites;
+
+      Self.Bounds := the_Bounds;
+   end set_Bounds;
+
+
+end openGL.Model.terrain;

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

@@ -0,0 +1,57 @@
+with
+     openGL.Geometry;
+
+
+package openGL.Model.terrain
+--
+--  Models lit, textured terrain.
+--
+is
+   type Item is new Model.item with private;
+   type View is access all Item'Class;
+
+
+   type height_Map_view is access all height_Map;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Terrain (heights_Asset : in asset_Name;
+                         Row, Col      : in Integer;
+                         Heights       : in height_Map_view;
+                         color_Map     : in asset_Name;
+                         Tiling        : in texture_Transform_2d := (S => (0.0, 1.0),
+                                                                     T => (0.0, 1.0))) return View;
+   overriding
+   procedure destroy (Self : in out Item);
+
+
+   --------------
+   --- 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;
+
+
+private
+
+   type Item is new Model.item with
+      record
+         heights_Asset : asset_Name := null_Asset;
+
+         Heights       : height_Map_view;
+         Row, Col      : Integer;
+
+         color_Map     : asset_Name := null_Asset;
+         Tiling        : texture_Transform_2D;
+      end record;
+
+
+   overriding
+   procedure set_Bounds (Self : in out Item);
+
+end openGL.Model.terrain;

3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb

@@ -0,0 +1,289 @@
+with
+     openGL.Geometry.lit_colored_textured,
+     openGL.GlyphImpl.Texture,
+     openGL.Primitive.indexed,
+     openGL.Texture,
+
+     ada.Directories;
+
+
+package body openGL.Model.Text.lit_colored
+is
+   ---------
+   --- Forge
+   --
+
+   function new_Text (Text     : in String;
+                      Font     : in openGL.Font.font_Id;
+                      Color    : in lucid_Color;
+                      Centered : in Boolean := True) return View
+   is
+      Font_Name : constant String  := to_String (Font.Name);
+      Exists    : constant Boolean := ada.Directories.Exists (Font_Name);
+   begin
+      if not Exists
+      then
+         raise no_such_Font with Font_Name;
+      end if;
+
+      declare
+         Self : constant View := new Item;
+      begin
+         Self.Text     := new String' (Text);
+         Self.Font_Id  := Font;
+         Self.Color    := +Color;
+         Self.Centered := Centered;
+         Self.Bounds   := null_Bounds;
+
+         return Self;
+      end;
+   end new_Text;
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   procedure Text_is (Self : in out Item;   Now : in String)
+   is
+   begin
+      Self.Text          := new String (1 .. Now'Length);
+      Self.Text.all      := Now;                             -- NB: This results in Text'First = 1.
+      Self.needs_Rebuild := True;
+   end Text_is;
+
+
+   overriding
+   function Text (Self : in Item) return String
+   is
+   begin
+      return Self.Text.all;
+   end Text;
+
+
+
+   overriding
+   function  Font (Self : in Item) return openGL.Font.view
+   is
+   begin
+      return Self.Font.all'Access;
+   end Font;
+
+
+
+   overriding
+   function to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+                                                    Fonts    : in     openGL.Font.font_id_Map_of_font) return Geometry.views
+   is
+      pragma unreferenced (Textures);
+
+      text_Scale : constant Vector_3 := [2.0 * 4.0 / 78.0,                -- TODO: Fix scaling.
+                                         2.0 * 4.0 / 95.0,
+                                         1.0 / 1.0];
+   begin
+      if Self.Text.all = ""
+      then
+         return [1 .. 0 => <>];
+      end if;
+
+      declare
+         use Geometry,
+             Geometry.lit_colored_textured,
+             Texture;
+
+         num_Characters : constant Positive     := Self.Text.all'Length;
+         num_Indices    : constant long_Index_t := long_Index_t (num_Characters) * 2 * 3;   -- For each character, 2 triangles each with 3 indices.
+         num_Vertices   : constant      Index_t :=      Index_t (num_Characters) * 4;       -- For each character, 2 triangles sharing 4 vertices.
+
+         the_Indices    : aliased Indices (1 .. num_Indices);
+         the_Vertices   : aliased Geometry.lit_colored_textured.Vertex_array := [1 .. num_Vertices => <>];
+
+         --- Procedure to 'add' a character.
+         --
+
+         pen_Site       : Vector_3     := Origin_3D;
+
+         indices_Count  : long_Index_t := 0;
+         vertex_Count   :      Index_t := 0;
+
+
+         procedure add (the_Character : in Character;
+                        Next          : in Character)
+         is
+            pragma unreferenced (Next);
+            the_Quad : GlyphImpl.Texture.Quad_t := Self.Font.Quad (the_Character);
+         begin
+            --- Add indices.
+            --
+
+            --  Triangle 1.
+            indices_Count               := indices_Count + 1;
+            the_Indices (indices_Count) := vertex_Count  + 1;
+
+            indices_Count               := indices_Count + 1;
+            the_Indices (indices_Count) := vertex_Count  + 2;
+
+            indices_Count               := indices_Count + 1;
+            the_Indices (indices_Count) := vertex_Count  + 3;
+
+
+            --  Triangle 2.
+            indices_Count               := indices_Count + 1;
+            the_Indices (indices_Count) := vertex_Count  + 3;
+
+            indices_Count               := indices_Count + 1;
+            the_Indices (indices_Count) := vertex_Count  + 4;
+
+            indices_Count               := indices_Count + 1;
+            the_Indices (indices_Count) := vertex_Count  + 1;
+
+
+            --- Scale the Quad sites and advance to pixel units.
+            --
+            the_Quad.NW.Site (1) := the_Quad.NW.Site (1) * text_Scale (1);     -- TODO: Scaling should be done by the shader.
+            the_Quad.NW.Site (2) := the_Quad.NW.Site (2) * text_Scale (2);
+
+            the_Quad.NE.Site (1) := the_Quad.NE.Site (1) * text_Scale (1);
+            the_Quad.NE.Site (2) := the_Quad.NE.Site (2) * text_Scale (2);
+
+            the_Quad.SW.Site (1) := the_Quad.SW.Site (1) * text_Scale (1);
+            the_Quad.SW.Site (2) := the_Quad.SW.Site (2) * text_Scale (2);
+
+            the_Quad.SE.Site (1) := the_Quad.SE.Site (1) * text_Scale (1);
+            the_Quad.SE.Site (2) := the_Quad.SE.Site (2) * text_Scale (2);
+
+            the_Quad.Advance (1) := the_Quad.Advance (1) * text_Scale (1);
+            the_Quad.Advance (2) := the_Quad.Advance (2) * text_Scale (2);
+
+
+            --- Add vertices.
+            --
+
+            --  top left (NW)
+            --
+            vertex_Count := vertex_Count + 1;
+            declare
+               the_Vertex : Geometry.lit_colored_textured.Vertex renames the_Vertices (vertex_Count);
+            begin
+               the_Vertex.Site   := pen_Site + the_Quad.NW.Site;
+               the_Vertex.Normal := [0.0, 0.0, 1.0];
+               the_Vertex.Shine  := 0.5;
+               the_Vertex.Color  := Self.Color;
+               the_Vertex.Coords := the_Quad.NW.Coords;
+
+               Self.Bounds.Box := Self.Bounds.Box or the_Vertex.Site;
+            end;
+
+            --  bottom left (SW)
+            --
+            vertex_Count := vertex_Count + 1;
+            declare
+               the_Vertex : Geometry.lit_colored_textured.Vertex renames the_Vertices (vertex_Count);
+            begin
+               the_Vertex.Site   := pen_Site + the_Quad.SW.Site;
+               the_Vertex.Normal := [0.0, 0.0, 1.0];
+               the_Vertex.Shine  := 0.5;
+               the_Vertex.Color  := Self.Color;
+               the_Vertex.Coords := the_Quad.SW.Coords;
+
+               Self.Bounds.Box := Self.Bounds.Box or the_Vertex.Site;
+            end;
+
+            --  bottom right (SE)
+            --
+            vertex_Count := vertex_Count + 1;
+            declare
+               the_Vertex : Geometry.lit_colored_textured.Vertex renames the_Vertices (vertex_Count);
+            begin
+               the_Vertex.Site   := pen_Site + the_Quad.SE.Site;
+               the_Vertex.Normal := [0.0, 0.0, 1.0];
+               the_Vertex.Shine  := 0.5;
+               the_Vertex.Color  := Self.Color;
+               the_Vertex.Coords := the_Quad.SE.Coords;
+
+               Self.Bounds.Box := Self.Bounds.Box or the_Vertex.Site;
+            end;
+
+            --  top right (NE)
+            --
+            vertex_Count := vertex_Count + 1;
+            declare
+               the_Vertex : Geometry.lit_colored_textured.Vertex renames the_Vertices (vertex_Count);
+            begin
+               the_Vertex.Site   := pen_Site + the_Quad.NE.Site;
+               the_Vertex.Normal := [0.0, 0.0, 1.0];
+               the_Vertex.Shine  := 0.5;
+               the_Vertex.Color  := Self.Color;
+               the_Vertex.Coords := the_Quad.NE.Coords;
+
+               Self.Bounds.Box := Self.Bounds.Box or the_Vertex.Site;
+            end;
+
+            pen_Site        := pen_Site + the_Quad.Advance;
+            Self.Bounds.Box := Self.Bounds.Box or pen_Site;
+         end add;
+
+
+         use      Primitive;
+         use type openGL.Font.texture.view;
+
+         the_Geometry   : Geometry.lit_colored_textured.view;
+         the_Primitive  : Primitive.indexed.view;
+
+         unused         : Vector_3;
+         next_Character : Character;
+
+      begin
+         if Self.Font = null
+         then
+            Self.Font := openGL.Font.texture.view (Fonts.Element (Self.Font_Id));
+         end if;
+
+         -- Add vertices and indices for each character in the text.
+         --
+         unused := Self.Font.check_Glyphs (Self.Text.all);   -- Make sure the glyphs, for each character in 'Self.Text' exist in the font.
+
+         for i in Self.Text'Range
+         loop
+            if i /= Self.Text'Last
+            then   next_Character := Self.Text (i + 1);
+            else   next_Character := ' ';
+            end if;
+
+            add (Self.Text (i), next_Character);
+         end loop;
+
+         -- Center the vertex sites, if requested.
+         --
+         if Self.Centered
+         then
+            declare
+               the_Bounds : constant openGL.Bounds := Self.Font.BBox (Self.Text.all);
+            begin
+               for i in the_Vertices'Range
+               loop
+                  the_Vertices (i).Site (1) := the_Vertices (i).Site (1)  -  (the_Bounds.Box.Upper (1) / 2.0) * text_Scale (1);
+                  the_Vertices (i).Site (2) := the_Vertices (i).Site (2)  -  (the_Bounds.Box.Upper (2) / 2.0) * text_Scale (2);
+               end loop;
+            end;
+         end if;
+
+         set_Ball_from_Box (Self.Bounds);
+
+         -- Setup the geometry.
+         --
+         the_Primitive := Primitive.indexed            .new_Primitive (Triangles, the_Indices);
+         the_Geometry  := Geometry.lit_colored_textured.new_Geometry  (texture_is_Alpha => True);
+
+         the_Geometry.add          (Primitive.view (the_Primitive));
+         the_Geometry.Vertices_are (the_Vertices);
+         the_Geometry.Texture_is   (Texture.Forge.to_Texture (Self.Font.gl_Texture));
+         the_Geometry.is_Transparent;
+
+         return [1 => Geometry.view (the_Geometry)];
+      end;
+   end to_GL_Geometries;
+
+
+end openGL.Model.Text.lit_colored;

3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.ads

@@ -0,0 +1,55 @@
+with
+     openGL.Font.texture,
+     openGL.Geometry;
+
+
+package openGL.Model.Text.lit_colored
+--
+--  Models lit and colored text.
+--
+is
+   type Item is new Model.text.item with private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   function new_Text (Text     : in String;
+                      Font     : in openGL.Font.font_Id;
+                      Color    : in lucid_Color;
+                      Centered : in Boolean := True) return View;
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   function  to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+                                                     Fonts    : in     openGL.Font.font_id_Map_of_font) return Geometry.views;
+   overriding
+   procedure Text_is (Self : in out Item;   Now : in String);
+   overriding
+   function  Text    (Self : in     Item)     return String;
+
+   overriding
+   function  Font    (Self : in     Item) return openGL.Font.view;
+
+
+
+private
+
+   type Item is new Model.text.item with
+      record
+         Text     : String_view;
+
+         Font_Id  : openGL.Font.font_Id;
+         Font     : openGL.Font.texture.view;
+
+         Color    : rgba_Color;
+         Centered : Boolean;
+      end record;
+
+end openGL.Model.Text.lit_colored;

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

@@ -0,0 +1,29 @@
+with
+     openGL.Font;
+
+
+package openGL.Model.text
+--
+--  Provides an abstract model for rendering text.
+--
+is
+   type Item is abstract new Model.item with private;
+   type View is access all Item'Class;
+
+
+   procedure Text_is (Self : in out Item;   Now : in String)   is abstract;
+   function  Text    (Self : in     Item)     return String    is abstract;
+
+   function  Font    (Self : in     Item)     return Font.view is abstract;
+
+   no_such_Font : exception;
+
+
+
+private
+
+   type Item is abstract new Model.item with null record;
+
+   type String_view is access String;
+
+end openGL.Model.text;

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

@@ -0,0 +1,214 @@
+with
+     ada.unchecked_Deallocation;
+
+
+package body openGL.Model
+is
+   ---------
+   --- Forge
+   --
+
+   procedure define (Self : out Item) is null;
+
+
+   procedure deallocate is new ada.unchecked_Deallocation (Geometry.views,
+                                                           access_Geometry_views);
+
+
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      if Self.opaque_Geometries /= null
+      then
+         for i in Self.opaque_Geometries'Range
+         loop
+            Geometry.free (Self.opaque_Geometries (i));
+         end loop;
+
+         deallocate (Self.opaque_Geometries);
+      end if;
+
+      if Self.lucid_Geometries /= null
+      then
+         for i in Self.lucid_Geometries'Range
+         loop
+            Geometry.free (Self.lucid_Geometries (i));
+         end loop;
+
+         deallocate (Self.lucid_Geometries);
+      end if;
+   end destroy;
+
+
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Model.item'Class,
+                                                              Model.view);
+   begin
+      Self.destroy;
+      deallocate (Self);
+   end free;
+
+
+
+   --------------
+   --- Attributes
+   --
+
+   function Id (Self : in Item'Class) return Model_Id
+   is
+   begin
+      return Self.Id;
+   end Id;
+
+
+   procedure Id_is (Self : in out Item'Class;   Now : in Model_Id)
+   is
+   begin
+      Self.Id := Now;
+   end Id_is;
+
+
+
+   procedure set_Bounds (Self : in out Item)
+   is
+   begin
+      Self.Bounds := null_Bounds;
+
+      if Self.opaque_Geometries /= null
+      then
+         for Each of Self.opaque_Geometries.all
+         loop
+            Self.Bounds.Box  :=    Self.Bounds.Box
+                                or Each.Bounds.Box;
+
+            Self.Bounds.Ball := Real'Max (Self.Bounds.Ball,
+                                          Each.Bounds.Ball);
+         end loop;
+      end if;
+
+      if Self.lucid_Geometries /= null
+      then
+         for Each of Self.lucid_Geometries.all
+         loop
+            Self.Bounds.Box  :=    Self.Bounds.Box
+                                or Each.Bounds.Box;
+
+            Self.Bounds.Ball := Real'Max (Self.Bounds.Ball,
+                                          Each.Bounds.Ball);
+         end loop;
+      end if;
+   end set_Bounds;
+
+
+
+   procedure create_GL_Geometries (Self : in out Item'Class;   Textures : access Texture.name_Map_of_texture'Class;
+                                                               Fonts    : in     Font.font_id_Map_of_font)
+   is
+      all_Geometries : constant Geometry.views := Self.to_GL_Geometries (Textures, Fonts);
+
+      opaque_Faces   : Geometry.views (1 .. all_Geometries'Length);
+      opaque_Count   : Index_t := 0;
+
+      lucid_Faces    : Geometry.views (1 .. all_Geometries'Length);
+      lucid_Count    : Index_t := 0;
+
+   begin
+      Self.Bounds := null_Bounds;
+
+      -- Separate lucid and opaque geometries.
+      --
+      for i in all_Geometries'Range
+      loop
+         if all_Geometries (i).is_Transparent
+         then
+            lucid_Count               := lucid_Count + 1;
+            lucid_Faces (lucid_Count) := all_Geometries (i);
+         else
+            opaque_Count                := opaque_Count + 1;
+            opaque_Faces (opaque_Count) := all_Geometries (i);
+         end if;
+
+         Self.Bounds.Box :=    Self.Bounds.Box
+                            or all_Geometries (i).Bounds.Box;
+
+         Self.Bounds.Ball:= Real'Max (Self.Bounds.Ball,
+                                      all_Geometries (i).Bounds.Ball);
+      end loop;
+
+
+      -- Free any existing geometries.
+      --
+      if Self.opaque_Geometries /= null
+      then
+         for i in Self.opaque_Geometries'Range
+         loop
+            Geometry.free (Self.opaque_Geometries (i));
+         end loop;
+
+         deallocate (Self.opaque_Geometries);
+      end if;
+
+      if Self.lucid_Geometries /= null
+      then
+         for i in Self.lucid_Geometries'Range
+         loop
+            Geometry.free (Self.lucid_Geometries (i));
+         end loop;
+
+         deallocate (Self.lucid_Geometries);
+      end if;
+
+      -- Create new gemometries.
+      --
+      Self.opaque_Geometries := new Geometry.views' (opaque_Faces (1 .. opaque_Count));
+      Self. lucid_Geometries := new Geometry.views' ( lucid_Faces (1 ..  lucid_Count));
+      Self.needs_Rebuild     := False;
+   end create_GL_Geometries;
+
+
+
+   function is_Modified (Self : in Item) return Boolean
+   is
+      pragma unreferenced (Self);
+   begin
+      return False;
+   end is_Modified;
+
+
+   function Bounds (Self : in Item) return openGL.Bounds
+   is
+   begin
+      return Self.Bounds;
+   end Bounds;
+
+
+   function opaque_Geometries (Self : in Item) return access_Geometry_views
+   is
+   begin
+      return Self.opaque_Geometries;
+   end opaque_Geometries;
+
+
+   function lucid_Geometries (Self : in Item) return access_Geometry_views
+   is
+   begin
+      return Self.lucid_Geometries;
+   end lucid_Geometries;
+
+
+   function needs_Rebuild (Self : in Item) return Boolean
+   is
+   begin
+      return Boolean (Self.needs_Rebuild);
+   end needs_Rebuild;
+
+
+   procedure needs_Rebuild (Self : in out Item)
+   is
+   begin
+      Self.needs_Rebuild := True;
+   end needs_Rebuild;
+
+end openGL.Model;

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

@@ -0,0 +1,82 @@
+with
+     openGL.remote_Model,
+     openGL.Font,
+     openGL.Texture,
+     openGL.Geometry;
+
+
+package openGL.Model
+--
+--  Provides an abstract base class for 3D models.
+--
+--  TODO: Make subprograms and 'with's private where possible.
+is
+   use Geometry_3d;
+
+   type Item  is abstract new remote_Model.item with private;
+   type View  is access all Item'Class;
+   type Views is array (Positive range <>) of View;
+
+
+   --------
+   -- Forge
+   --
+
+   procedure define  (Self :    out Item);     -- TODO: Rid this.
+   procedure destroy (Self : in out Item);
+   procedure free    (Self : in out View);
+
+
+   -------------
+   -- Attributes
+   --
+
+   function  Id               (Self : in     Item'Class)     return model_Id;
+   procedure Id_is            (Self : in out Item'Class;   Now : in model_Id);
+
+   procedure    modify        (Self : in out Item) is null;
+   function  is_modified      (Self : in     Item) return Boolean;
+
+   function  to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+                                                     Fonts    : in     Font.font_id_Maps_of_font.Map) return Geometry.views
+                               is abstract;
+
+   type access_Geometry_views is access Geometry.views;
+
+   function opaque_Geometries (Self : in     Item) return access_Geometry_views;
+   function  lucid_Geometries (Self : in     Item) return access_Geometry_views;
+
+
+   procedure set_Bounds       (Self : in out Item);
+   --
+   -- Recalculate the bounds based on model geometry.
+
+   function  Bounds           (Self : in     Item) return openGL.Bounds;
+   --
+   -- Returns the bounds in model space.
+
+
+   function  needs_Rebuild    (Self : in     Item) return Boolean;
+   procedure needs_Rebuild    (Self : in out Item);
+
+
+   -------------
+   -- Operations
+   --
+
+   procedure create_GL_Geometries (Self : in out Item'Class;   Textures : access Texture.name_Map_of_texture'Class;
+                                                               Fonts    : in     Font.font_id_Map_of_font);
+
+
+private
+
+   type Item is abstract new remote_Model.item with
+      record
+         opaque_Geometries : access_Geometry_views;
+         lucid_Geometries  : access_Geometry_views;
+
+         Bounds            : openGL.Bounds := null_Bounds;   -- The combined bounds of all geometries.
+         needs_Rebuild     : safe_Boolean  := False;
+      end record;
+
+end openGL.Model;

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

@@ -0,0 +1,15 @@
+package openGL.remote_Model with remote_Types
+--
+--  Provides a DSA friendly base class for 3D models.
+--
+is
+
+   type Item is abstract tagged
+      record
+         Id    : model_Id     := null_model_Id;
+         Shine : openGL.Shine := 200.0;
+      end record;
+
+end openGL.remote_Model;
+
+