with
     openGL.Errors,
     openGL.Tasks,
     openGL.IO,

     GL.Binding,
     GL.lean,
     GL.Pointers,

     ada.unchecked_Deallocation;

with ada.Text_IO;


package body openGL.Texture
is
   use GL,
       GL.lean,
       GL.Pointers;


   ----------------
   --  Texture Name
   --

   function new_texture_Name return texture_Name
   is
      use GL.Binding;
      the_Name : aliased texture_Name;
   begin
      Tasks.check;
      glGenTextures (1, the_Name'Access);
      return the_Name;
   end new_texture_Name;



   procedure free (the_texture_Name : in texture_Name)
   is
      the_Name : aliased texture_Name := the_texture_Name;
   begin
      Tasks.check;
      glDeleteTextures (1, the_Name'Access);
   end free;


   ---------
   --  Forge
   --

   package body Forge
   is

      function to_Texture (Name : in texture_Name) return Object
      is
         Self : Texture.Object;
      begin
         Self.Name := Name;
         -- TODO: Fill in remaining fields by querying GL.

         return Self;
      end to_Texture;


      function to_Texture (Dimensions : in Texture.Dimensions) return Object
      is
         use GL.Binding;
         Self : aliased Texture.Object;

      begin
         Tasks.check;

         Self.Dimensions := Dimensions;
         Self.Name       := new_texture_Name;
         Self.enable;

         glPixelStorei   (GL_UNPACK_ALIGNMENT, 1);

         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

         return Self;
      end to_Texture;


      function to_Texture (the_Image   : in Image;
                           use_Mipmaps : in Boolean := True) return Object
      is
         Self : aliased Texture.Object;
      begin
         Self.Name := new_texture_Name;
         Self.set_Image (the_Image, use_Mipmaps);

         return Self;
      end to_Texture;


      function to_Texture (the_Image   : in lucid_Image;
                           use_Mipmaps : in Boolean    := True) return Object
      is
         Self : aliased Texture.Object;
      begin
         Self.Name := new_texture_Name;
         Self.set_Image (the_Image, use_Mipmaps);

         return Self;
      end to_Texture;

   end Forge;



   procedure destroy (Self : in out Object)
   is
   begin
      free (Self.Name);     -- Release the GL texture name.
   end destroy;



   procedure free (Self : in out Object)
   is
   begin
      free (Self.Pool.all, Self);     -- Release 'Self' from it's pool for later re-use.
   end free;



   function is_Defined (Self : in Object) return Boolean
   is
      use type texture_Name;
   begin
      return Self.Name /= 0;
   end is_Defined;



   procedure set_Name (Self : in out Object;   To : in texture_Name)
   is
   begin
      Self.Name := To;
   end set_Name;


   function Name (Self : in Object) return texture_Name
   is
   begin
      return Self.Name;
   end Name;



   procedure set_Image (Self : in out Object;   To          : in Image;
                                                use_Mipmaps : in Boolean := True)
   is
      use GL.Binding,
          ada.Text_IO;

      the_Image  :          Image renames To;
      min_Width  : constant Positive := the_Image'Length (2);
      min_Height : constant Positive := the_Image'Length (1);
   begin
      Tasks.check;

      Self.is_Transparent    := False;
      Self.Dimensions.Width  := min_Width;
      Self.Dimensions.Height := min_Height;

      --  new_Line (3);
      --  put_Line ("openGL.Texture.set_Image ~ GLsizei (Self.Dimensions.Width)  =>" & GLsizei (Self.Dimensions.Width) 'Image);
      --  put_Line ("                         ~ GLsizei (Self.Dimensions.Height) =>" & GLsizei (Self.Dimensions.Height)'Image);
      --  put_Line ("                         ~ the_Image                        =>");
      --  put_Line (the_Image'Image);
      --  new_Line (3);

      Self.enable;

      glPixelStorei   (GL_UNPACK_ALIGNMENT, 1);                                 Errors.log;

      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);     Errors.log;
      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);     Errors.log;

      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);        Errors.log;
      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);        Errors.log;

      glTexImage2D (GL_TEXTURE_2D,
                    0,
                    GL_RGB,
                    GLsizei (Self.Dimensions.Width),
                    GLsizei (Self.Dimensions.Height),
                    0,
                    GL_RGB,
                    GL_UNSIGNED_BYTE,
                    +the_Image (1, 1).Red'Address);
      Errors.log;

      if use_Mipmaps
      then
         glGenerateMipmap (GL_TEXTURE_2D);
         Errors.log;
      end if;
   end set_Image;



   procedure set_Image (Self : in out Object;   To          : in lucid_Image;
                                                use_Mipmaps : in Boolean    := True)
   is
      use GL.Binding;

      the_Image  :          lucid_Image renames To;
      min_Width  : constant Positive := the_Image'Length (2);
      min_Height : constant Positive := the_Image'Length (1);

   begin
      Tasks.check;

      Self.is_Transparent    := True;
      Self.Dimensions.Width  := min_Width;
      Self.Dimensions.Height := min_Height;
      Self.enable;

      glPixelStorei   (GL_UNPACK_ALIGNMENT, 1);                                 Errors.log;

      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);     Errors.log;
      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);     Errors.log;

      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);        Errors.log;
      glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);        Errors.log;

      glTexImage2D (GL_TEXTURE_2D,
                    0,
                    GL_RGBA,
                    GLsizei (Self.Dimensions.Width),
                    GLsizei (Self.Dimensions.Height),
                    0,
                    GL_RGBA,
                    GL_UNSIGNED_BYTE,
                    +the_Image (1, 1).Primary.Red'Address);
      Errors.log;

      if use_Mipmaps
      then
         glGenerateMipmap (GL_TEXTURE_2D);
         Errors.log;
      end if;
   end set_Image;



   function is_Transparent (Self : in Object) return Boolean
   is
   begin
      return Self.is_Transparent;
   end is_Transparent;



   procedure enable (Self : in Object)
   is
      use GL.Binding;
      use type GL.GLuint;
      pragma Assert (Self.Name > 0);
   begin
      Tasks.check;
      glBindTexture (GL.GL_TEXTURE_2D, Self.Name);
      Errors.log;
   end enable;



   function Power_of_2_Ceiling (From : in Positive) return GL.GLsizei
   is
      use type GL.GLsizei;
   begin
      if    From <=         2 then   return         2;
      elsif From <=         4 then   return         4;
      elsif From <=         8 then   return         8;
      elsif From <=        16 then   return        16;
      elsif From <=        32 then   return        32;
      elsif From <=        64 then   return        64;
      elsif From <=       128 then   return       128;
      elsif From <=       256 then   return       256;
      elsif From <=       512 then   return       512;
      elsif From <=      1024 then   return      1024;
      elsif From <=  2 * 1024 then   return  2 * 1024;
      elsif From <=  4 * 1024 then   return  4 * 1024;
      elsif From <=  8 * 1024 then   return  8 * 1024;
      elsif From <= 16 * 1024 then   return 16 * 1024;
      elsif From <= 32 * 1024 then   return 32 * 1024;
      end if;

      raise Constraint_Error with "Texture size too large:" & From'Image;
   end Power_of_2_Ceiling;



   function Size (Self : in Object) return Texture.Dimensions
   is
   begin
      return Self.Dimensions;
   end Size;



   -----------------------
   -- Name Maps of Texture
   --

   function fetch (From : access name_Map_of_texture'Class;   texture_Name : in asset_Name) return Object
   is
      Name : constant unbounded_String := to_unbounded_String (to_String (texture_Name));
   begin
      if From.Contains (Name)
      then
         return From.Element (Name);
      else
         declare
            new_Texture : constant Object := IO.to_Texture (texture_Name);
         begin
            From.insert (Name, new_Texture);
            return new_Texture;
         end;
      end if;
   end fetch;



   --------
   --  Pool
   --

   procedure destroy (the_Pool : in out Pool)
   is
      procedure deallocate is new ada.unchecked_Deallocation (pool_texture_List,
                                                              pool_texture_List_view);
   begin
      for Each of the_Pool.Map
      loop
         for i in 1 .. Each.Last
         loop
            destroy    (Each.Textures (i));
            deallocate (Each);
         end loop;
      end loop;
   end destroy;



   function new_Texture (From : access Pool;   Size : in Dimensions) return Object
   is
      use GL.Binding;

      the_Pool    : access  Pool renames From;
      the_Texture : aliased Object;

      unused_List : pool_texture_List_view;

   begin
      Tasks.check;

      if the_Pool.Map.contains (Size)
      then
         unused_List := the_Pool.Map.Element (Size);
      else
         unused_List := new pool_texture_List;
         the_Pool.Map.insert (Size, unused_List);
      end if;

      -- Search for existing, but unused, object.
      --
      if unused_List.Last > 0
      then     -- An existing unused texture has been found.
         the_Texture      := unused_List.Textures (unused_List.Last);
         unused_List.Last := unused_List.Last - 1;

         the_Texture.enable;

         gltexImage2D  (GL_TEXTURE_2D,  0,  GL_RGBA,
                        GLsizei (Size.Width),
                        GLsizei (Size.Height),
                        0,
                        GL_RGBA, GL_UNSIGNED_BYTE,
                        null);                             -- NB: Actual image is not initialised.

      else     -- No existing, unused texture found, so create a new one.
         the_Texture.Pool := From.all'unchecked_Access;
         the_Texture.Name := new_texture_Name;
         the_Texture.enable;

         glPixelStorei   (GL_UNPACK_ALIGNMENT, 1);
         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S,
                          GL_CLAMP_TO_EDGE);
         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T,
                          GL_CLAMP_TO_EDGE);

         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER,
                          GL_LINEAR);
         glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER,
                          GL_LINEAR);

         gltexImage2D  (gl_TEXTURE_2D,  0,  gl_RGBA,
                        GLsizei (Size.Width),
                        GLsizei (Size.Height),
                        0,
                        GL_RGBA, GL_UNSIGNED_BYTE,
                        null);                             -- NB: Actual image is not initialised.
      end if;

      the_Texture.Dimensions := Size;

      return the_Texture;
   end new_Texture;



   procedure free (From : in out Pool;   the_Texture : in Object)
   is
      use type texture_Name;
   begin
      if the_Texture.Name = 0 then
         return;
      end if;

      raise Program_Error with "TODO: free texture from pool";
--        declare
--           unused_texture_List : constant pool_texture_List_view
--             := Self.unused_Textures_for_size (the_Texture.Size_width,
--                                               the_Texture.Size_height);
--        begin
--           unused_texture_List.Last                                := unused_texture_List.Last + 1;
--           unused_texture_List.Textures (unused_texture_List.Last) := the_Texture;
--        end;
   end free;



   procedure vacuum (the_Pool : in out Pool)
   is
   begin
      for Each of the_Pool.Map
      loop
         declare
            unused_List : constant pool_texture_List_view := Each;
         begin
            if unused_List /= null
            then
               for Each in 1 .. unused_List.Last
               loop
                  free (unused_List.Textures (Each).Name);
               end loop;

               unused_List.Last := 0;
            end if;
         end;
      end loop;

      -- TODO: Test this ~ old code follows ...

--        for each_Width in Self.unused_Textures_for_size'Range (1)
--        loop
--           for each_Height in self.unused_Textures_for_size'Range (2)
--           loop
--              declare
--                 unused_texture_List : constant pool_texture_List_view
--                   := Self.unused_Textures_for_size (each_Width, each_Height);
--              begin
--                 if unused_texture_List /= null
--                 then
--                    for Each in 1 .. unused_texture_List.Last
--                    loop
--                       free (unused_texture_List.Textures (Each).Name);
--                    end loop;
--
--                    unused_texture_List.Last := 0;
--                 end if;
--              end;
--           end loop;
--        end loop;
   end vacuum;



   function Hash (the_Dimensions : in Texture.Dimensions) return ada.Containers.Hash_Type
   is
   begin
      return ada.Containers.Hash_type (  the_Dimensions.Width  * 13
                                       + the_Dimensions.Height * 17);
   end Hash;


end openGL.Texture;
