--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with System;

with Interfaces.C.Pointers;

with Ada.Unchecked_Deallocation;

with GL.Low_Level.Enums;
with GL.Objects.Buffers;
with GL.Pixels.Extensions;
with GL.Types.Colors;

package GL.Objects.Textures is
   pragma Preelaborate;

   package LE renames Low_Level.Enums;
   package PE renames Pixels.Extensions;

   use all type LE.Texture_Kind;

   type Dimension_Count is (One, Two, Three);

   function Get_Dimensions (Kind : LE.Texture_Kind) return Dimension_Count;

   function Maximum_Anisotropy return Single
     with Post => Maximum_Anisotropy'Result >= 16.0;

   -----------------------------------------------------------------------------
   --                            Basic Types                                  --
   -----------------------------------------------------------------------------

   type Minifying_Function is (Nearest, Linear, Nearest_Mipmap_Nearest,
                               Linear_Mipmap_Nearest, Nearest_Mipmap_Linear,
                               Linear_Mipmap_Linear);

   --  Has to be defined here because of following subtype declaration.
   for Minifying_Function use (Nearest                => 16#2600#,
                               Linear                 => 16#2601#,
                               Nearest_Mipmap_Nearest => 16#2700#,
                               Linear_Mipmap_Nearest  => 16#2701#,
                               Nearest_Mipmap_Linear  => 16#2702#,
                               Linear_Mipmap_Linear   => 16#2703#);
   for Minifying_Function'Size use Int'Size;

   subtype Magnifying_Function is Minifying_Function range Nearest .. Linear;

   type Wrapping_Mode is (Repeat, Clamp_To_Border, Clamp_To_Edge,
                          Mirrored_Repeat, Mirror_Clamp_To_Edge);

   --  Actual range is implementation-defined
   --
   --  - OpenGL 2.x: At least 2
   --  - OpenGL 3.x: At least 48
   --  - OpenGL 4.x: At least 80
   subtype Texture_Unit is UInt;

   subtype Image_Unit is UInt;

   subtype Mipmap_Level is Size;

   -----------------------------------------------------------------------------
   --                          Texture Objects                                --
   -----------------------------------------------------------------------------

   type Texture_Base (Kind : LE.Texture_Kind)
     is abstract new GL_Object with private;

   function Has_Levels (Object : Texture_Base) return Boolean is
     (Object.Kind not in Texture_Buffer | Texture_Rectangle |
        Texture_2D_Multisample | Texture_2D_Multisample_Array)
   with Inline;

   overriding
   procedure Initialize_Id (Object : in out Texture_Base);

   overriding
   procedure Delete_Id (Object : in out Texture_Base);

   overriding
   function Identifier (Object : Texture_Base) return Types.Debug.Identifier is
     (Types.Debug.Texture);

   procedure Invalidate_Image (Object : Texture_Base; Level : Mipmap_Level)
     with Pre  => (if not Object.Has_Levels then Level = 0);

   procedure Invalidate_Sub_Image (Object : Texture_Base; Level : Mipmap_Level;
                                   X, Y, Z : Int; Width, Height, Depth : Size)
   with Pre  => (if not Object.Has_Levels then Level = 0);

   procedure Bind_Texture_Unit (Object : Texture_Base; Unit : Texture_Unit);

   procedure Bind_Image_Texture (Object : Texture_Base; Unit : Image_Unit);

   -----------------------------------------------------------------------------

   type Texture is new Texture_Base with private;

   function Dimensions (Object : Texture) return Dimension_Count;

   function Allocated (Object : Texture) return Boolean;

   procedure Clear_Using_Data
     (Object : Texture; Level : Mipmap_Level;
      Source_Format : Pixels.Format;
      Source_Type   : Pixels.Data_Type;
      Source        : System.Address)
   with Pre => not Object.Compressed (Level);

   procedure Clear_Using_Zeros
     (Object : Texture; Level : Mipmap_Level)
   with Pre => not Object.Compressed (Level);

   procedure Generate_Mipmap (Object : Texture);

   -----------------------------------------------------------------------------
   --                            Texture Parameters                           --
   -----------------------------------------------------------------------------

   procedure Set_Minifying_Filter     (Object : Texture; Filter : Minifying_Function);
   procedure Set_Magnifying_Filter    (Object : Texture; Filter : Magnifying_Function);
   procedure Set_Minimum_LoD          (Object : Texture; Level : Double);
   procedure Set_Maximum_LoD          (Object : Texture; Level : Double);
   procedure Set_Lowest_Mipmap_Level  (Object : Texture; Level : Mipmap_Level);
   procedure Set_Highest_Mipmap_Level (Object : Texture; Level : Mipmap_Level);

   procedure Set_Seamless_Filtering   (Object : Texture; Enable : Boolean)
     with Pre => Object.Kind in Texture_Cube_Map | Texture_Cube_Map_Array;
   --  Enable seamless cubemap filtering
   --
   --  Note: this procedure requires the ARB_seamless_cubemap_per_texture
   --  extension. If this extension is not available, you can enable seamless
   --  filtering globally via GL.Toggles.

   function Minifying_Filter     (Object : Texture) return Minifying_Function;
   function Magnifying_Filter    (Object : Texture) return Magnifying_Function;
   function Minimum_LoD          (Object : Texture) return Double;
   function Maximum_LoD          (Object : Texture) return Double;
   function Lowest_Mipmap_Level  (Object : Texture) return Mipmap_Level;
   function Highest_Mipmap_Level (Object : Texture) return Mipmap_Level;
   --  TODO LoD_Bias (Double)

   function Seamless_Filtering   (Object : Texture) return Boolean
     with Pre => Object.Kind in Texture_Cube_Map | Texture_Cube_Map_Array;

   procedure Set_Max_Anisotropy (Object : Texture; Degree : Double)
     with Pre => Degree >= 1.0;
   --  Set the maximum amount of anisotropy filtering to reduce the blurring
   --  of textures (caused by mipmap filtering) that are viewed at an
   --  oblique angle.
   --
   --  For best results, combine the use of anisotropy filtering with
   --  a Linear_Mipmap_Linear minification filter and a Linear maxification
   --  filter.

   function Max_Anisotropy (Object : Texture) return Double
     with Post => Max_Anisotropy'Result >= 1.0;

   procedure Set_X_Wrapping (Object : Texture; Mode : Wrapping_Mode);
   procedure Set_Y_Wrapping (Object : Texture; Mode : Wrapping_Mode);
   procedure Set_Z_Wrapping (Object : Texture; Mode : Wrapping_Mode);

   function X_Wrapping (Object : Texture) return Wrapping_Mode;
   function Y_Wrapping (Object : Texture) return Wrapping_Mode;
   function Z_Wrapping (Object : Texture) return Wrapping_Mode;

   procedure Set_Border_Color         (Object : Texture; Color : Colors.Color);
   function Border_Color              (Object : Texture) return Colors.Color;

   procedure Toggle_Compare_X_To_Texture (Object : Texture; Enabled : Boolean);
   procedure Set_Compare_Function        (Object : Texture; Func : Compare_Function);

   function Compare_X_To_Texture_Enabled (Object : Texture) return Boolean;
   function Current_Compare_Function     (Object : Texture) return Compare_Function;

   -----------------------------------------------------------------------------
   --                         Texture Level Parameters                        --
   -----------------------------------------------------------------------------

   function Width  (Object : Texture; Level : Mipmap_Level) return Size;
   function Height (Object : Texture; Level : Mipmap_Level) return Size;
   function Depth  (Object : Texture; Level : Mipmap_Level) return Size;

   function Internal_Format (Object : Texture; Level : Mipmap_Level)
     return Pixels.Internal_Format
   with Pre => Object.Allocated and not Object.Compressed (Level);

   function Compressed_Format (Object : Texture; Level : Mipmap_Level)
     return Pixels.Compressed_Format
   with Pre => Object.Allocated and Object.Compressed (Level);

   function Red_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Green_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Blue_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Alpha_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Depth_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;

   function Red_Size   (Object : Texture; Level : Mipmap_Level) return Size;
   function Green_Size (Object : Texture; Level : Mipmap_Level) return Size;
   function Blue_Size  (Object : Texture; Level : Mipmap_Level) return Size;
   function Alpha_Size (Object : Texture; Level : Mipmap_Level) return Size;
   function Depth_Size (Object : Texture; Level : Mipmap_Level) return Size;
   --  TODO Stencil_Size, Shared_Size

   function Compressed (Object : Texture; Level : Mipmap_Level) return Boolean;
   function Compressed_Image_Size (Object : Texture; Level : Mipmap_Level) return Size;
   --  TODO Pre => Object is compressed

   --  TODO Samples (Size), Fixed_Sample_Locations (Boolean) (if Object is multisampled)

   function Buffer_Offset (Object : Texture; Level : Mipmap_Level) return Size;
   function Buffer_Size   (Object : Texture; Level : Mipmap_Level) return Size;

   -----------------------------------------------------------------------------
   --                            Texture Units                                --
   -----------------------------------------------------------------------------

   function Active_Unit return Texture_Unit;

   function Texture_Unit_Count return Natural;

   -----------------------------------------------------------------------------
   --                        Buffer Texture Loading                           --
   -----------------------------------------------------------------------------

   type Buffer_Texture is new Texture_Base (Kind => Texture_Buffer) with private;

   procedure Attach_Buffer (Object : Buffer_Texture;
                            Internal_Format : Pixels.Internal_Format_Buffer_Texture;
                            Buffer : Objects.Buffers.Buffer);

   procedure Attach_Buffer (Object : Buffer_Texture;
                            Internal_Format : Pixels.Internal_Format_Buffer_Texture;
                            Buffer : Objects.Buffers.Buffer;
                            Offset, Size : Types.Size);

   -----------------------------------------------------------------------------
   --                           Texture Loading                               --
   -----------------------------------------------------------------------------

   procedure Allocate_Storage
     (Object : in out Texture;
      Levels, Samples : Types.Size;
      Format : Pixels.Internal_Format;
      Width, Height, Depth : Types.Size;
      Fixed_Locations : Boolean := True)
   with Pre  => not Object.Allocated,
        Post => Object.Allocated;

   procedure Allocate_Storage
     (Object : in out Texture;
      Levels, Samples : Types.Size;
      Format : Pixels.Compressed_Format;
      Width, Height, Depth : Types.Size;
      Fixed_Locations : Boolean := True)
   with Pre  => not Object.Allocated and Object.Kind /= Texture_Rectangle,
        Post => Object.Allocated;

   procedure Load_From_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Source_Format : Pixels.Format;
      Source_Type   : Pixels.Data_Type;
      Source        : System.Address)
   with Pre => Object.Allocated and not Object.Compressed (Level);

   procedure Load_From_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Source_Format : Pixels.Compressed_Format;
      Image_Size    : Types.Size;
      Source        : System.Address)
   with Pre => Object.Dimensions /= One and Object.Allocated and Object.Compressed (Level);

   procedure Copy_Data
     (Object  : Texture;
      Subject : Texture;
      Source_Level, Target_Level : Mipmap_Level)
   with Pre => Object.Allocated and Subject.Allocated;

   procedure Copy_Sub_Data
     (Object  : Texture;
      Subject : Texture;
      Source_Level, Target_Level : Mipmap_Level;
      Source_X, Source_Y, Source_Z : Types.Size := 0;
      Target_X, Target_Y, Target_Z : Types.Size := 0;
      Width, Height, Depth : Types.Size)
   with Pre => Object.Allocated and Subject.Allocated;

   procedure Clear_Using_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Source_Format : Pixels.Format;
      Source_Type   : Pixels.Data_Type;
      Source        : System.Address)
   with Pre => not Object.Compressed (Level);

   procedure Clear_Using_Zeros
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size)
   with Pre => not Object.Compressed (Level);

   -----------------------------------------------------------------------------

   function Get_Compressed_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Format : Pixels.Compressed_Format) return not null Types.UByte_Array_Access
   with Pre => Object.Dimensions /= One and Object.Allocated and Object.Compressed (Level)
     and Object.Kind not in Texture_2D_Multisample | Texture_2D_Multisample_Array;

   generic
      with package Pointers is new Interfaces.C.Pointers (<>);
   package Texture_Pointers is

      type Element_Array_Access is access Pointers.Element_Array;

      procedure Free is new Ada.Unchecked_Deallocation
        (Object => Pointers.Element_Array, Name => Element_Array_Access);

      function Get_Data
        (Object : Texture;
         Level  : Mipmap_Level;
         X, Y, Z              : Types.Size := 0;
         Width, Height, Depth : Types.Positive_Size;
         Format    : Pixels.Format;
         Data_Type : PE.Non_Packed_Data_Type) return not null Element_Array_Access
      with Pre => Object.Allocated and
                    not Object.Compressed (Level) and PE.Compatible (Format, Data_Type);

   end Texture_Pointers;

private

   for Wrapping_Mode use
     (Repeat               => 16#2901#,
      Clamp_To_Border      => 16#812D#,
      Clamp_To_Edge        => 16#812F#,
      Mirrored_Repeat      => 16#8370#,
      Mirror_Clamp_To_Edge => 16#8743#);
   for Wrapping_Mode'Size use Int'Size;

   type Texture_Base (Kind : LE.Texture_Kind)
     is new GL_Object with null record;

   type Texture is new Texture_Base with record
      Allocated  : Boolean := False;
      Dimensions : Dimension_Count := Get_Dimensions (Texture.Kind);
   end record;

   type Buffer_Texture is new Texture_Base (Kind => Texture_Buffer) with null record;

end GL.Objects.Textures;

--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with System;

with Interfaces.C.Pointers;

with Ada.Unchecked_Deallocation;

with GL.Low_Level.Enums;
with GL.Objects.Buffers;
with GL.Pixels.Extensions;
with GL.Types.Colors;

package GL.Objects.Textures is
   pragma Preelaborate;

   package LE renames Low_Level.Enums;
   package PE renames Pixels.Extensions;

   use all type LE.Texture_Kind;

   type Dimension_Count is (One, Two, Three);

   function Get_Dimensions (Kind : LE.Texture_Kind) return Dimension_Count;

   function Maximum_Anisotropy return Single
     with Post => Maximum_Anisotropy'Result >= 16.0;

   -----------------------------------------------------------------------------
   --                            Basic Types                                  --
   -----------------------------------------------------------------------------

   type Minifying_Function is (Nearest, Linear, Nearest_Mipmap_Nearest,
                               Linear_Mipmap_Nearest, Nearest_Mipmap_Linear,
                               Linear_Mipmap_Linear);

   --  Has to be defined here because of following subtype declaration.
   for Minifying_Function use (Nearest                => 16#2600#,
                               Linear                 => 16#2601#,
                               Nearest_Mipmap_Nearest => 16#2700#,
                               Linear_Mipmap_Nearest  => 16#2701#,
                               Nearest_Mipmap_Linear  => 16#2702#,
                               Linear_Mipmap_Linear   => 16#2703#);
   for Minifying_Function'Size use Int'Size;

   subtype Magnifying_Function is Minifying_Function range Nearest .. Linear;

   type Wrapping_Mode is (Repeat, Clamp_To_Border, Clamp_To_Edge,
                          Mirrored_Repeat, Mirror_Clamp_To_Edge);

   --  Actual range is implementation-defined
   --
   --  - OpenGL 2.x: At least 2
   --  - OpenGL 3.x: At least 48
   --  - OpenGL 4.x: At least 80
   subtype Texture_Unit is UInt;

   subtype Image_Unit is UInt;

   subtype Mipmap_Level is Size;

   -----------------------------------------------------------------------------
   --                          Texture Objects                                --
   -----------------------------------------------------------------------------

   type Texture_Base (Kind : LE.Texture_Kind)
     is abstract new GL_Object with private;

   function Has_Levels (Object : Texture_Base) return Boolean is
     (Object.Kind not in Texture_Buffer | Texture_Rectangle |
        Texture_2D_Multisample | Texture_2D_Multisample_Array)
   with Inline;

   overriding
   procedure Initialize_Id (Object : in out Texture_Base);

   overriding
   procedure Delete_Id (Object : in out Texture_Base);

   overriding
   function Identifier (Object : Texture_Base) return Types.Debug.Identifier is
     (Types.Debug.Texture);

   procedure Invalidate_Image (Object : Texture_Base; Level : Mipmap_Level)
     with Pre  => (if not Object.Has_Levels then Level = 0);

   procedure Invalidate_Sub_Image (Object : Texture_Base; Level : Mipmap_Level;
                                   X, Y, Z : Int; Width, Height, Depth : Size)
   with Pre  => (if not Object.Has_Levels then Level = 0);

   procedure Bind_Texture_Unit (Object : Texture_Base; Unit : Texture_Unit);

   procedure Bind_Image_Texture (Object : Texture_Base; Unit : Image_Unit);

   -----------------------------------------------------------------------------

   type Texture is new Texture_Base with private;

   function Dimensions (Object : Texture) return Dimension_Count;

   function Allocated (Object : Texture) return Boolean;

   procedure Clear_Using_Data
     (Object : Texture; Level : Mipmap_Level;
      Source_Format : Pixels.Format;
      Source_Type   : Pixels.Data_Type;
      Source        : System.Address)
   with Pre => not Object.Compressed (Level);

   procedure Clear_Using_Zeros
     (Object : Texture; Level : Mipmap_Level)
   with Pre => not Object.Compressed (Level);

   procedure Generate_Mipmap (Object : Texture)
     with Pre => Object.Has_Levels;

   -----------------------------------------------------------------------------
   --                            Texture Parameters                           --
   -----------------------------------------------------------------------------

   procedure Set_Minifying_Filter     (Object : Texture; Filter : Minifying_Function)
     with Pre => (if Object.Kind = Texture_Rectangle then Filter in Nearest | Linear);

   procedure Set_Magnifying_Filter    (Object : Texture; Filter : Magnifying_Function);
   procedure Set_Minimum_LoD          (Object : Texture; Level : Double);
   procedure Set_Maximum_LoD          (Object : Texture; Level : Double);
   procedure Set_Lowest_Mipmap_Level  (Object : Texture; Level : Mipmap_Level);
   procedure Set_Highest_Mipmap_Level (Object : Texture; Level : Mipmap_Level);

   procedure Set_Seamless_Filtering   (Object : Texture; Enable : Boolean)
     with Pre => Object.Kind in Texture_Cube_Map | Texture_Cube_Map_Array;
   --  Enable seamless cubemap filtering
   --
   --  Note: this procedure requires the ARB_seamless_cubemap_per_texture
   --  extension. If this extension is not available, you can enable seamless
   --  filtering globally via GL.Toggles.

   function Minifying_Filter     (Object : Texture) return Minifying_Function;
   function Magnifying_Filter    (Object : Texture) return Magnifying_Function;
   function Minimum_LoD          (Object : Texture) return Double;
   function Maximum_LoD          (Object : Texture) return Double;
   function Lowest_Mipmap_Level  (Object : Texture) return Mipmap_Level;
   function Highest_Mipmap_Level (Object : Texture) return Mipmap_Level;
   --  TODO LoD_Bias (Double)

   function Seamless_Filtering   (Object : Texture) return Boolean
     with Pre => Object.Kind in Texture_Cube_Map | Texture_Cube_Map_Array;

   procedure Set_Max_Anisotropy (Object : Texture; Degree : Double)
     with Pre => Degree >= 1.0;
   --  Set the maximum amount of anisotropy filtering to reduce the blurring
   --  of textures (caused by mipmap filtering) that are viewed at an
   --  oblique angle.
   --
   --  For best results, combine the use of anisotropy filtering with
   --  a Linear_Mipmap_Linear minification filter and a Linear maxification
   --  filter.

   function Max_Anisotropy (Object : Texture) return Double
     with Post => Max_Anisotropy'Result >= 1.0;

   procedure Set_X_Wrapping (Object : Texture; Mode : Wrapping_Mode);
   procedure Set_Y_Wrapping (Object : Texture; Mode : Wrapping_Mode);
   procedure Set_Z_Wrapping (Object : Texture; Mode : Wrapping_Mode);

   function X_Wrapping (Object : Texture) return Wrapping_Mode;
   function Y_Wrapping (Object : Texture) return Wrapping_Mode;
   function Z_Wrapping (Object : Texture) return Wrapping_Mode;

   procedure Set_Border_Color         (Object : Texture; Color : Colors.Color);
   function Border_Color              (Object : Texture) return Colors.Color;

   procedure Toggle_Compare_X_To_Texture (Object : Texture; Enabled : Boolean);
   procedure Set_Compare_Function        (Object : Texture; Func : Compare_Function);

   function Compare_X_To_Texture_Enabled (Object : Texture) return Boolean;
   function Current_Compare_Function     (Object : Texture) return Compare_Function;

   -----------------------------------------------------------------------------
   --                         Texture Level Parameters                        --
   -----------------------------------------------------------------------------

   function Width  (Object : Texture; Level : Mipmap_Level) return Size;
   function Height (Object : Texture; Level : Mipmap_Level) return Size;
   function Depth  (Object : Texture; Level : Mipmap_Level) return Size;

   function Internal_Format (Object : Texture; Level : Mipmap_Level)
     return Pixels.Internal_Format
   with Pre => Object.Allocated and not Object.Compressed (Level);

   function Compressed_Format (Object : Texture; Level : Mipmap_Level)
     return Pixels.Compressed_Format
   with Pre => Object.Allocated and Object.Compressed (Level);

   function Red_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Green_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Blue_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Alpha_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;
   function Depth_Type (Object : Texture; Level : Mipmap_Level)
     return Pixels.Channel_Data_Type;

   function Red_Size   (Object : Texture; Level : Mipmap_Level) return Size;
   function Green_Size (Object : Texture; Level : Mipmap_Level) return Size;
   function Blue_Size  (Object : Texture; Level : Mipmap_Level) return Size;
   function Alpha_Size (Object : Texture; Level : Mipmap_Level) return Size;
   function Depth_Size (Object : Texture; Level : Mipmap_Level) return Size;
   --  TODO Stencil_Size, Shared_Size

   function Compressed (Object : Texture; Level : Mipmap_Level) return Boolean;
   function Compressed_Image_Size (Object : Texture; Level : Mipmap_Level) return Size;
   --  TODO Pre => Object is compressed

   --  TODO Samples (Size), Fixed_Sample_Locations (Boolean) (if Object is multisampled)

   function Buffer_Offset (Object : Texture; Level : Mipmap_Level) return Size;
   function Buffer_Size   (Object : Texture; Level : Mipmap_Level) return Size;

   -----------------------------------------------------------------------------
   --                            Texture Units                                --
   -----------------------------------------------------------------------------

   function Active_Unit return Texture_Unit;

   function Texture_Unit_Count return Natural;

   -----------------------------------------------------------------------------
   --                        Buffer Texture Loading                           --
   -----------------------------------------------------------------------------

   type Buffer_Texture is new Texture_Base (Kind => Texture_Buffer) with private;

   procedure Attach_Buffer (Object : Buffer_Texture;
                            Internal_Format : Pixels.Internal_Format_Buffer_Texture;
                            Buffer : Objects.Buffers.Buffer);

   procedure Attach_Buffer (Object : Buffer_Texture;
                            Internal_Format : Pixels.Internal_Format_Buffer_Texture;
                            Buffer : Objects.Buffers.Buffer;
                            Offset, Size : Types.Size);

   -----------------------------------------------------------------------------
   --                           Texture Loading                               --
   -----------------------------------------------------------------------------

   procedure Allocate_Storage
     (Object : in out Texture;
      Levels, Samples : Types.Size;
      Format : Pixels.Internal_Format;
      Width, Height, Depth : Types.Size;
      Fixed_Locations : Boolean := True)
   with Pre  => not Object.Allocated,
        Post => Object.Allocated;

   procedure Allocate_Storage
     (Object : in out Texture;
      Levels, Samples : Types.Size;
      Format : Pixels.Compressed_Format;
      Width, Height, Depth : Types.Size;
      Fixed_Locations : Boolean := True)
   with Pre  => not Object.Allocated and Object.Kind /= Texture_Rectangle,
        Post => Object.Allocated;

   procedure Load_From_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Source_Format : Pixels.Format;
      Source_Type   : Pixels.Data_Type;
      Source        : System.Address)
   with Pre => Object.Allocated and not Object.Compressed (Level);

   procedure Load_From_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Source_Format : Pixels.Compressed_Format;
      Image_Size    : Types.Size;
      Source        : System.Address)
   with Pre => Object.Dimensions /= One and Object.Allocated and Object.Compressed (Level);

   procedure Copy_Data
     (Object  : Texture;
      Subject : Texture;
      Source_Level, Target_Level : Mipmap_Level)
   with Pre => Object.Allocated and Subject.Allocated;

   procedure Copy_Sub_Data
     (Object  : Texture;
      Subject : Texture;
      Source_Level, Target_Level : Mipmap_Level;
      Source_X, Source_Y, Source_Z : Types.Size := 0;
      Target_X, Target_Y, Target_Z : Types.Size := 0;
      Width, Height, Depth : Types.Size)
   with Pre => Object.Allocated and Subject.Allocated;

   procedure Clear_Using_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Source_Format : Pixels.Format;
      Source_Type   : Pixels.Data_Type;
      Source        : System.Address)
   with Pre => not Object.Compressed (Level);

   procedure Clear_Using_Zeros
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size)
   with Pre => not Object.Compressed (Level);

   -----------------------------------------------------------------------------

   function Get_Compressed_Data
     (Object : Texture;
      Level  : Mipmap_Level;
      X, Y, Z              : Types.Size := 0;
      Width, Height, Depth : Types.Positive_Size;
      Format : Pixels.Compressed_Format) return not null Types.UByte_Array_Access
   with Pre => Object.Dimensions /= One and Object.Allocated and Object.Compressed (Level)
     and Object.Kind not in Texture_2D_Multisample | Texture_2D_Multisample_Array;

   generic
      with package Pointers is new Interfaces.C.Pointers (<>);
   package Texture_Pointers is

      type Element_Array_Access is access Pointers.Element_Array;

      procedure Free is new Ada.Unchecked_Deallocation
        (Object => Pointers.Element_Array, Name => Element_Array_Access);

      function Get_Data
        (Object : Texture;
         Level  : Mipmap_Level;
         X, Y, Z              : Types.Size := 0;
         Width, Height, Depth : Types.Positive_Size;
         Format    : Pixels.Format;
         Data_Type : PE.Non_Packed_Data_Type) return not null Element_Array_Access
      with Pre => Object.Allocated and
                    not Object.Compressed (Level) and PE.Compatible (Format, Data_Type);

   end Texture_Pointers;

private

   for Wrapping_Mode use
     (Repeat               => 16#2901#,
      Clamp_To_Border      => 16#812D#,
      Clamp_To_Edge        => 16#812F#,
      Mirrored_Repeat      => 16#8370#,
      Mirror_Clamp_To_Edge => 16#8743#);
   for Wrapping_Mode'Size use Int'Size;

   type Texture_Base (Kind : LE.Texture_Kind)
     is new GL_Object with null record;

   type Texture is new Texture_Base with record
      Allocated  : Boolean := False;
      Dimensions : Dimension_Count := Get_Dimensions (Texture.Kind);
   end record;

   type Buffer_Texture is new Texture_Base (Kind => Texture_Buffer) with null record;

end GL.Objects.Textures;

gl: Add some pre conditions to Generate_Mipmap and Set_Minifying_Filter

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;

with Util.Log.Loggers;

with ADO.Objects;
with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Permissions;
with AWA.Storages.Stores.Files;
package body AWA.Storages.Services is

   use AWA.Services;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Services");

   --  ------------------------------
   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   --  ------------------------------
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access is
   begin
      return Service.Stores (Kind);
   end Get_Store;

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class) is
      Root : constant String := Module.Get_Config (Stores.Files.Root_Directory_Parameter.P);
      Tmp  : constant String := Module.Get_Config (Stores.Files.Tmp_Directory_Parameter.P);
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);
      Service.Stores (Storages.Models.DATABASE) := Service.Database_Store'Unchecked_Access;
      Service.Stores (Storages.Models.FILE) := AWA.Storages.Stores.Files.Create_File_Store (Root);
      Service.Stores (Storages.Models.TMP) := AWA.Storages.Stores.Files.Create_File_Store (Tmp);
      Service.Database_Store.Tmp := Service.Stores (Storages.Models.TMP);
   end Initialize;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
   begin
      if not Folder.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Folder.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Folder.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create folder permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Folder.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Folder.Is_Inserted then
         Folder.Set_Create_Date (Ada.Calendar.Clock);
         Folder.Set_Owner (Ctx.Get_User);
      end if;
      Folder.Save (DB);
      Ctx.Commit;
   end Save_Folder;

   --  ------------------------------
   --  Load the folder instance identified by the given identifier.
   --  ------------------------------
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier) is
      pragma Unreferenced (Service);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Folder.Load (Session => DB, Id => Id);
   end Load_Folder;

   --  ------------------------------
   --  Load the storage instance identified by the given identifier.
   --  ------------------------------
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Service);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
   begin
      Storage.Load (Session => DB, Id => Id);
   end Load_Storage;

   --  ------------------------------
   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type) is
   begin
      Storage_Service'Class (Service).Save (Into, Data.Get_Local_Filename, Storage);
   end Save;

   --  ------------------------------
   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type) is
      use type AWA.Storages.Models.Storage_Type;
      use type Stores.Store_Access;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
      Store     : Stores.Store_Access;
      Created   : Boolean;
   begin
      Log.Info ("Save {0} in storage space", Path);

      Into.Set_Storage (Storage);
      Store := Storage_Service'Class (Service).Get_Store (Into.Get_Storage);
      if Store = null then
         Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Storage));
      end if;

      if not Into.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Into.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Into.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Storage.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      Created := not Into.Is_Inserted;
      if Created then
         Into.Set_Create_Date (Ada.Calendar.Clock);
         Into.Set_Owner (Ctx.Get_User);
      end if;
      Into.Save (DB);
      Store.Save (DB, Into, Path);
      Into.Save (DB);

      --  Notify the listeners.
      if Created then
         Storage_Lifecycle.Notify_Create (Service, Into);
      else
         Storage_Lifecycle.Notify_Update (Service, Into);
      end if;
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   --  ------------------------------
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref) is
      use type AWA.Storages.Models.Storage_Type;
      use type AWA.Storages.Stores.Store_Access;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (Models.Query_Storage_Get_Data);
      Kind  : AWA.Storages.Models.Storage_Type;
   begin
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, DB);

      Query.Execute;
      if not Query.Has_Elements then
         Log.Warn ("Storage entity {0} not found", ADO.Identifier'Image (From));
         raise ADO.Objects.NOT_FOUND;
      end if;
      Mime := Query.Get_Unbounded_String (0);
      Date := Query.Get_Time (1);
      Name := Query.Get_Unbounded_String (2);
      Kind := AWA.Storages.Models.Storage_Type'Val (Query.Get_Integer (4));
      if Kind = AWA.Storages.Models.DATABASE then
         Into := Query.Get_Blob (5);
      else
         declare
            Store   : Stores.Store_Access;
            Storage : AWA.Storages.Models.Storage_Ref;
            File    : AWA.Storages.Storage_File;
            Found   : Boolean;
         begin
            Store := Storage_Service'Class (Service).Get_Store (Kind);
            if Store = null then
               Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Kind));
            end if;
            Storage.Load (DB, From, Found);
            if not Found then
               Log.Warn ("Storage entity {0} not found", ADO.Identifier'Image (From));
               raise ADO.Objects.NOT_FOUND;
            end if;
            Store.Load (DB, Storage, File);
            Into := ADO.Create_Blob (AWA.Storages.Get_Path (File));
         end;
      end if;
   end Load;

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File) is
      use type Stores.Store_Access;
      use type Models.Storage_Type;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.Queries.Context;
      Found   : Boolean;
      Storage : AWA.Storages.Models.Storage_Ref;
      Local   : AWA.Storages.Models.Store_Local_Ref;
      Store   : Stores.Store_Access;
   begin
      if Mode = READ then
         Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Local);
         Query.Bind_Param ("store_id", From);
         Query.Bind_Param ("user_id", User);
         ADO.Sessions.Entities.Bind_Param (Query, "table",
                                           AWA.Workspaces.Models.WORKSPACE_TABLE, DB);
         Local.Find (DB, Query, Found);
         if Found then
            Into.Path := Local.Get_Path;
            return;
         end if;
      end if;

      Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Storage);
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, DB);
      Storage.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      Ctx.Start;
      Store := Storage_Service'Class (Service).Get_Store (Storage.Get_Storage);
      Store.Load (Session => DB,
                  From    => Storage,
                  Into    => Into);
      Ctx.Commit;
   end Get_Local_File;

   procedure Create_Local_File (Service : in Storage_Service;
                                Into    : out Storage_File) is
   begin
      null;
   end Create_Local_File;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class) is
      Ctx : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Id  : constant ADO.Identifier := ADO.Objects.Get_Value (Storage.Get_Key);
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Id));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Id);

      Ctx.Start;
      Storage_Lifecycle.Notify_Delete (Service, Storage);
      Storage.Delete (DB);
      Ctx.Commit;
   end Delete;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier) is
      use type Stores.Store_Access;

      Ctx  : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB   : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      S    : AWA.Storages.Models.Storage_Ref;
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (AWA.Storages.Models.Query_Storage_Delete_Local);
      Store : Stores.Store_Access;
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Storage));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Storage);

      Ctx.Start;
      S.Load (Id => Storage, Session => DB);

      Store := Storage_Service'Class (Service).Get_Store (S.Get_Storage);
      if Store = null then
         Log.Error ("There is no store associated with storage item {0}",
                    ADO.Identifier'Image (Storage));
      else
         Store.Delete (DB, S);
      end if;

      Storage_Lifecycle.Notify_Delete (Service, S);

      --  Delete the storage instance and all storage that refer to it.
      declare
         Stmt : ADO.Statements.Delete_Statement
           := DB.Create_Statement (AWA.Storages.Models.STORAGE_TABLE);
      begin
         Stmt.Set_Filter (Filter => "id = ? OR original_id = ?");
         Stmt.Add_Param (Value => Storage);
         Stmt.Add_Param (Value => Storage);
         Stmt.Execute;
      end;
      --  Delete the local storage instances.
      Query.Bind_Param ("store_id", Storage);
      Query.Execute;
      S.Delete (DB);
      Ctx.Commit;
   end Delete;

end AWA.Storages.Services;

-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;

with Util.Log.Loggers;

with ADO.Objects;
with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Permissions;
with AWA.Storages.Stores.Files;
package body AWA.Storages.Services is

   use AWA.Services;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Services");

   --  ------------------------------
   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   --  ------------------------------
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access is
   begin
      return Service.Stores (Kind);
   end Get_Store;

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class) is
      Root : constant String := Module.Get_Config (Stores.Files.Root_Directory_Parameter.P);
      Tmp  : constant String := Module.Get_Config (Stores.Files.Tmp_Directory_Parameter.P);
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);
      Service.Stores (Storages.Models.DATABASE) := Service.Database_Store'Unchecked_Access;
      Service.Stores (Storages.Models.FILE) := AWA.Storages.Stores.Files.Create_File_Store (Root);
      Service.Stores (Storages.Models.TMP) := AWA.Storages.Stores.Files.Create_File_Store (Tmp);
      Service.Database_Store.Tmp := Service.Stores (Storages.Models.TMP);
   end Initialize;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
   begin
      if not Folder.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Folder.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Folder.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create folder permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Folder.Permission,
                             Entity     => Workspace);

      Ctx.Start;
      if not Folder.Is_Inserted then
         Folder.Set_Create_Date (Ada.Calendar.Clock);
         Folder.Set_Owner (Ctx.Get_User);
      end if;
      Folder.Save (DB);
      Ctx.Commit;
   end Save_Folder;

   --  ------------------------------
   --  Load the folder instance identified by the given identifier.
   --  ------------------------------
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier) is
      pragma Unreferenced (Service);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Folder.Load (Session => DB, Id => Id);
   end Load_Folder;

   --  ------------------------------
   --  Load the storage instance identified by the given identifier.
   --  ------------------------------
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Service);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
   begin
      Storage.Load (Session => DB, Id => Id);
   end Load_Storage;

   --  ------------------------------
   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type) is
   begin
      Storage_Service'Class (Service).Save (Into, Data.Get_Local_Filename, Storage);
   end Save;

   --  ------------------------------
   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type) is
      use type AWA.Storages.Models.Storage_Type;
      use type Stores.Store_Access;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
      Store     : Stores.Store_Access;
      Created   : Boolean;
   begin
      Log.Info ("Save {0} in storage space", Path);

      Into.Set_Storage (Storage);
      Store := Storage_Service'Class (Service).Get_Store (Into.Get_Storage);
      if Store = null then
         Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Storage));
      end if;

      if not Into.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Into.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Into.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Storage.Permission,
                             Entity     => Workspace);

      Ctx.Start;
      Created := not Into.Is_Inserted;
      if Created then
         Into.Set_Create_Date (Ada.Calendar.Clock);
         Into.Set_Owner (Ctx.Get_User);
      end if;
      Into.Save (DB);
      Store.Save (DB, Into, Path);
      Into.Save (DB);

      --  Notify the listeners.
      if Created then
         Storage_Lifecycle.Notify_Create (Service, Into);
      else
         Storage_Lifecycle.Notify_Update (Service, Into);
      end if;
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   --  ------------------------------
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref) is
      use type AWA.Storages.Models.Storage_Type;
      use type AWA.Storages.Stores.Store_Access;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (Models.Query_Storage_Get_Data);
      Kind  : AWA.Storages.Models.Storage_Type;
   begin
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, DB);

      Query.Execute;
      if not Query.Has_Elements then
         Log.Warn ("Storage entity {0} not found", ADO.Identifier'Image (From));
         raise ADO.Objects.NOT_FOUND;
      end if;
      Mime := Query.Get_Unbounded_String (0);
      Date := Query.Get_Time (1);
      Name := Query.Get_Unbounded_String (2);
      Kind := AWA.Storages.Models.Storage_Type'Val (Query.Get_Integer (4));
      if Kind = AWA.Storages.Models.DATABASE then
         Into := Query.Get_Blob (5);
      else
         declare
            Store   : Stores.Store_Access;
            Storage : AWA.Storages.Models.Storage_Ref;
            File    : AWA.Storages.Storage_File;
            Found   : Boolean;
         begin
            Store := Storage_Service'Class (Service).Get_Store (Kind);
            if Store = null then
               Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Kind));
            end if;
            Storage.Load (DB, From, Found);
            if not Found then
               Log.Warn ("Storage entity {0} not found", ADO.Identifier'Image (From));
               raise ADO.Objects.NOT_FOUND;
            end if;
            Store.Load (DB, Storage, File);
            Into := ADO.Create_Blob (AWA.Storages.Get_Path (File));
         end;
      end if;
   end Load;

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File) is
      use type Stores.Store_Access;
      use type Models.Storage_Type;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.Queries.Context;
      Found   : Boolean;
      Storage : AWA.Storages.Models.Storage_Ref;
      Local   : AWA.Storages.Models.Store_Local_Ref;
      Store   : Stores.Store_Access;
   begin
      if Mode = READ then
         Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Local);
         Query.Bind_Param ("store_id", From);
         Query.Bind_Param ("user_id", User);
         ADO.Sessions.Entities.Bind_Param (Query, "table",
                                           AWA.Workspaces.Models.WORKSPACE_TABLE, DB);
         Local.Find (DB, Query, Found);
         if Found then
            Into.Path := Local.Get_Path;
            return;
         end if;
      end if;

      Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Storage);
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, DB);
      Storage.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      Ctx.Start;
      Store := Storage_Service'Class (Service).Get_Store (Storage.Get_Storage);
      Store.Load (Session => DB,
                  From    => Storage,
                  Into    => Into);
      Ctx.Commit;
   end Get_Local_File;

   procedure Create_Local_File (Service : in Storage_Service;
                                Into    : out Storage_File) is
   begin
      null;
   end Create_Local_File;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class) is
      Ctx : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Id  : constant ADO.Identifier := ADO.Objects.Get_Value (Storage.Get_Key);
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Id));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Id);

      Ctx.Start;
      Storage_Lifecycle.Notify_Delete (Service, Storage);
      Storage.Delete (DB);
      Ctx.Commit;
   end Delete;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier) is
      use type Stores.Store_Access;

      Ctx  : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB   : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      S    : AWA.Storages.Models.Storage_Ref;
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (AWA.Storages.Models.Query_Storage_Delete_Local);
      Store : Stores.Store_Access;
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Storage));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Storage);

      Ctx.Start;
      S.Load (Id => Storage, Session => DB);

      Store := Storage_Service'Class (Service).Get_Store (S.Get_Storage);
      if Store = null then
         Log.Error ("There is no store associated with storage item {0}",
                    ADO.Identifier'Image (Storage));
      else
         Store.Delete (DB, S);
      end if;

      Storage_Lifecycle.Notify_Delete (Service, S);

      --  Delete the storage instance and all storage that refer to it.
      declare
         Stmt : ADO.Statements.Delete_Statement
           := DB.Create_Statement (AWA.Storages.Models.STORAGE_TABLE);
      begin
         Stmt.Set_Filter (Filter => "id = ? OR original_id = ?");
         Stmt.Add_Param (Value => Storage);
         Stmt.Add_Param (Value => Storage);
         Stmt.Execute;
      end;
      --  Delete the local storage instances.
      Query.Bind_Param ("store_id", Storage);
      Query.Execute;
      S.Delete (DB);
      Ctx.Commit;
   end Delete;

end AWA.Storages.Services;

Use the Check permission by using the database object so that we can check for null object


-----------------------------------------------------------------------
--  awa-mail-clients-aws_smtp -- Mail client implementation on top of AWS SMTP client
--  Copyright (C) 2012, 2016, 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Ada.Finalization;

with Util.Properties;

with AWS.SMTP;
with AWS.SMTP.Authentication.Plain;
private with AWS.Attachments;

--  The AWA.Mail.Clients.AWS_SMTP package provides an implementation of the
--  mail client interfaces on top of AWS SMTP client API.
package AWA.Mail.Clients.AWS_SMTP is

   NAME : constant String := "smtp";

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The Mail_Message represents an abstract mail message that can be initialized
   --  before being sent.
   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with private;
   type AWS_Mail_Message_Access is access all AWS_Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String);

   --  Add a recipient for the message.
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String);

   --  Set the subject of the message.
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String);

   --  Set the body of the message.
   overriding
   procedure Set_Body (Message      : in out AWS_Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String);

   --  Add an attachment with the given content.
   overriding
   procedure Add_Attachment (Message      : in out AWS_Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String);

   --  Send the email message.
   overriding
   procedure Send (Message : in out AWS_Mail_Message);

   --  Deletes the mail message.
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message);

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type AWS_Mail_Manager is new Mail_Manager with private;
   type AWS_Mail_Manager_Access is access all AWS_Mail_Manager'Class;

   --  Create a SMTP based mail manager and configure it according to the properties.
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access;

   --  Create a new mail message.
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access;

private

   type Recipients_Access is access all AWS.SMTP.Recipients;

   type Recipients_Array is array (Recipient_Type) of Recipients_Access;

   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with record
      Manager     : AWS_Mail_Manager_Access;
      From        : AWS.SMTP.E_Mail_Data;
      Subject     : Ada.Strings.Unbounded.Unbounded_String;
      To          : Recipients_Array;
      Attachments : AWS.Attachments.List;
   end record;

   type AWS_Mail_Manager is new Mail_Manager with record
      Self    : AWS_Mail_Manager_Access;
      Server  : AWS.SMTP.Receiver;
      Creds   : aliased AWS.SMTP.Authentication.Plain.Credential;
      Port    : Positive := 25;
      Enable  : Boolean := True;
      Secure  : Boolean := False;
      Auth    : Boolean := False;
   end record;

   procedure Initialize (Client : in out AWS_Mail_Manager'Class;
                         Props  : in Util.Properties.Manager'Class);

end AWA.Mail.Clients.AWS_SMTP;

-----------------------------------------------------------------------
--  awa-mail-clients-aws_smtp -- Mail client implementation on top of AWS SMTP client
--  Copyright (C) 2012, 2016, 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Ada.Finalization;

with Util.Properties;

with AWS.SMTP;
with AWS.SMTP.Authentication.Plain;
private with AWS.Attachments;

--  The AWA.Mail.Clients.AWS_SMTP package provides an implementation of the
--  mail client interfaces on top of AWS SMTP client API.
package AWA.Mail.Clients.AWS_SMTP is

   NAME : constant String := "smtp";

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The Mail_Message represents an abstract mail message that can be initialized
   --  before being sent.
   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with private;
   type AWS_Mail_Message_Access is access all AWS_Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String);

   --  Add a recipient for the message.
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String);

   --  Set the subject of the message.
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String);

   --  Set the body of the message.
   overriding
   procedure Set_Body (Message      : in out AWS_Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String);

   --  Add an attachment with the given content.
   overriding
   procedure Add_Attachment (Message      : in out AWS_Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String);

   --  Add a file attachment.
   overriding
   procedure Add_File_Attachment (Message      : in out AWS_Mail_Message;
                                  Filename     : in String;
                                  Content_Id   : in String;
                                  Content_Type : in String);

   --  Send the email message.
   overriding
   procedure Send (Message : in out AWS_Mail_Message);

   --  Deletes the mail message.
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message);

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type AWS_Mail_Manager is new Mail_Manager with private;
   type AWS_Mail_Manager_Access is access all AWS_Mail_Manager'Class;

   --  Create a SMTP based mail manager and configure it according to the properties.
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access;

   --  Create a new mail message.
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access;

private

   type Recipients_Access is access all AWS.SMTP.Recipients;

   type Recipients_Array is array (Recipient_Type) of Recipients_Access;

   type AWS_Mail_Message is new Ada.Finalization.Limited_Controlled and Mail_Message with record
      Manager     : AWS_Mail_Manager_Access;
      From        : AWS.SMTP.E_Mail_Data;
      Subject     : Ada.Strings.Unbounded.Unbounded_String;
      To          : Recipients_Array;
      Attachments : AWS.Attachments.List;
   end record;

   type AWS_Mail_Manager is new Mail_Manager with record
      Self    : AWS_Mail_Manager_Access;
      Server  : AWS.SMTP.Receiver;
      Creds   : aliased AWS.SMTP.Authentication.Plain.Credential;
      Port    : Positive := 25;
      Enable  : Boolean := True;
      Secure  : Boolean := False;
      Auth    : Boolean := False;
   end record;

   procedure Initialize (Client : in out AWS_Mail_Manager'Class;
                         Props  : in Util.Properties.Manager'Class);

end AWA.Mail.Clients.AWS_SMTP;

Declare the Add_File_Attachment procedure