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_Details  : in texture_Set.item;
                      Texture_is_lucid : in Boolean) return openGL.Model.any.item
   is
   begin
      --  return Self : openGL.Model.any. := (openGL.Model.item with
      return Self : openGL.Model.any.item := (textured_Model.textured_item with
                                              Model,
                                              Texture,
                                              Texture_is_lucid,
                                              Geometry => null)
      do
         Self.Bounds.Ball := 1.0;
         Self.texture_Details_is (texture_Details);
      end return;
   end to_Model;


   function new_Model (Model            : in asset_Name;
                       Texture          : in asset_Name;
                       texture_Details  : in texture_Set.item;
                       Texture_is_lucid : in Boolean) return openGL.Model.any.view
   is
   begin
      return new openGL.Model.any.item' (to_Model (Model, Texture, texture_Details, 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;
      Self.Geometry.Model_is  (Self.all'unchecked_Access);

      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);

         Self.Geometry.Model_is (Self'unchecked_Access);


         --  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;



   ------------
   -- Texturing
   --

   --  overriding
   --  procedure Fade_is (Self : in out Item;   Which : in texture_Set.texture_Id;
   --                                           Now   : in texture_Set.fade_Level)
   --  is
   --  begin
   --     null;
   --  end Fade_is;
   --
   --
   --
   --  overriding
   --  function Fade (Self : in Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level
   --  is
   --  begin
   --     return 0.0;
   --  end Fade;
   --
   --
   --
   --  procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
   --                                              Now   : in openGL.asset_Name)
   --  is
   --  begin
   --     null;
   --  end Texture_is;
   --
   --
   --
   --  overriding
   --  function texture_Count (Self : in Item) return Natural
   --  is
   --  begin
   --     return 1;
   --  end texture_Count;



end openGL.Model.any;
