-----------------------------------------------------------------------
--  components -- Component tree
--  Copyright (C) 2009, 2010 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.
-----------------------------------------------------------------------

--  The <bASF.Components describes the components that form the
--  tree view.  Each component has attributes and children.  Children
--  represent sub-components and attributes control the rendering and
--  behavior of the component.
--
--  The component tree is created from the ASF.Views tag nodes
--  for each request.  Unlike tag nodes, the component tree is not shared.
with Ada.Strings.Unbounded;
with EL.Objects;
with EL.Expressions;
--  with EL.Contexts;
with ASF.Contexts.Faces;
--  limited with ASF.Contexts.Facelets;
limited with ASF.Views.Nodes;
limited with ASF.Converters;
package ASF.Components is

   use Ada.Strings.Unbounded;
   use ASF.Contexts.Faces;
   type UIComponent_List is private;

   --  ------------------------------
   --  Attribute of a component
   --  ------------------------------
   type UIAttribute is private;

--     type UIComponent is new Ada.Finalization.Controlled with private;
   type UIComponent is tagged limited private;
   type UIComponent_Access is access all UIComponent'Class;

   --  Get the parent component.
   --  Returns null if the node is the root element.
   function Get_Parent (UI : UIComponent) return UIComponent_Access;

   --  Return a client-side identifier for this component, generating
   --  one if necessary.
   function Get_Client_Id (UI : UIComponent) return Unbounded_String;

   --  Get the list of children.
   function Get_Children (UI : UIComponent) return UIComponent_List;

   --  Get the number of children.
   function Get_Children_Count (UI : UIComponent) return Natural;

   --  Get the first child component.
   --  Returns null if the component has no children.
   function Get_First_Child (UI : UIComponent) return UIComponent_Access;

   --  Initialize the component when restoring the view.
   --  The default initialization gets the client ID and allocates it if necessary.
   procedure Initialize (UI      : in out UIComponent;
                         Context : in out Faces_Context'Class);

   procedure Append (UI    : in UIComponent_Access;
                     Child : in UIComponent_Access;
                     Tag   : access ASF.Views.Nodes.Tag_Node'Class);

   --  Search for and return the {@link UIComponent} with an id
   --  that matches the specified search expression (if any), according to
   --  the algorithm described below.
   function Find (UI : UIComponent;
                  Name : String) return UIComponent_Access;

   --  Check whether the component and its children must be rendered.
   function Is_Rendered (UI : UIComponent;
                         Context : Faces_Context'Class) return Boolean;

   --  Set whether the component is rendered.
   procedure Set_Rendered (UI       : in out UIComponent;
                           Rendered : in Boolean);

   function Get_Attribute (UI      : UIComponent;
                           Context : Faces_Context'Class;
                           Name    : String) return EL.Objects.Object;

   --  Get the attribute tag
   function Get_Attribute (UI      : UIComponent;
                           Name    : String) return access ASF.Views.Nodes.Tag_Attribute;

   procedure Set_Attribute (UI    : in out UIComponent;
                            Name  : in String;
                            Value : in EL.Objects.Object);

   procedure Set_Attribute (UI    : in out UIComponent;
                            Def   : access ASF.Views.Nodes.Tag_Attribute;
                            Value : in EL.Expressions.Expression);

   --  Get the converter associated with the component
   function Get_Converter (UI      : in UIComponent;
                           Context : in Faces_Context'Class)
                           return access ASF.Converters.Converter'Class;

   --  Convert the string into a value.  If a converter is specified on the component,
   --  use it to convert the value.
   function Convert_Value (UI      : in UIComponent;
                           Value   : in String;
                           Context : in Faces_Context'Class) return EL.Objects.Object;

   --  Get the value expression
   function Get_Value_Expression (UI   : in UIComponent;
                                  Name : in String) return EL.Expressions.Value_Expression;

   procedure Encode_Begin (UI      : in UIComponent;
                           Context : in out Faces_Context'Class);

   procedure Encode_Children (UI      : in UIComponent;
                              Context : in out Faces_Context'Class);

   procedure Encode_End (UI      : in UIComponent;
                         Context : in out Faces_Context'Class);

   procedure Encode_All (UI      : in UIComponent'Class;
                         Context : in out Faces_Context'Class);

   procedure Decode (UI      : in out UIComponent;
                     Context : in out Faces_Context'Class);

   procedure Decode_Children (UI      : in UIComponent'Class;
                              Context : in out Faces_Context'Class);

   procedure Process_Decodes (UI      : in out UIComponent;
                              Context : in out Faces_Context'Class);

   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   procedure Process_Validators (UI      : in out UIComponent;
                                 Context : in out Faces_Context'Class);

   procedure Process_Updates (UI      : in out UIComponent;
                              Context : in out Faces_Context'Class);

   type UIComponent_Array is array (Natural range <>) of UIComponent_Access;

   type UIComponent_Array_Access is access UIComponent_Array;

   --  type UIOutput is new UIComponent;

   function Get_Context (UI : in UIComponent)
                         return ASF.Contexts.Faces.Faces_Context_Access;

   --  Get the attribute value.
   function Get_Value (Attr : UIAttribute;
                       UI   : UIComponent'Class) return EL.Objects.Object;

--   function Create_UIComponent (Parent  : UIComponent_Access;
--                                Context : ASF.Contexts.Facelets.Facelet_Context'Class;
--                                Tag    : access ASF.Views.Nodes.Tag_Node'Class)
--                                return UIComponent_Access;

   --  Iterate over the children of the component and execute
   --  the Process procedure.
   generic
      with procedure Process (Child   : in UIComponent_Access);
   procedure Iterate (UI : in UIComponent'Class);

   --  Iterate over the attributes defined on the component and
   --  execute the Process procedure.
   generic
      with procedure Process (Name : in String;
                              Attr : in UIAttribute);
   procedure Iterate_Attributes (UI : in UIComponent'Class);

private

   --  Delete the component tree recursively.
   procedure Delete (UI : in out UIComponent_Access);

   type UIAttribute_Access is access all UIAttribute;

   type UIAttribute is record
      Definition : access ASF.Views.Nodes.Tag_Attribute;
      Name       : Unbounded_String;
      Value      : EL.Objects.Object;
      Expr       : El.Expressions.Expression;
      Next_Attr  : UIAttribute_Access;
   end record;

   type UIComponent_List is record
      Child : UIComponent_Access := null;
   end record;

   type UIComponent is tagged limited record
      Id          : Unbounded_String;
      Tag         : access ASF.Views.Nodes.Tag_Node'Class;
      Parent      : UIComponent_Access;
      First_Child : UIComponent_Access;
      Last_Child  : UIComponent_Access;
      Next        : UIComponent_Access;
      Attributes  : UIAttribute_Access;
   end record;

end ASF.Components;

-----------------------------------------------------------------------
--  components -- Component tree
--  Copyright (C) 2009, 2010 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.
-----------------------------------------------------------------------

--  The <bASF.Components describes the components that form the
--  tree view.  Each component has attributes and children.  Children
--  represent sub-components and attributes control the rendering and
--  behavior of the component.
--
--  The component tree is created from the ASF.Views tag nodes
--  for each request.  Unlike tag nodes, the component tree is not shared.
with Ada.Strings.Unbounded;
with EL.Objects;
with EL.Expressions;
--  with EL.Contexts;
with ASF.Contexts.Faces;
--  limited with ASF.Contexts.Facelets;
limited with ASF.Views.Nodes;
limited with ASF.Converters;
package ASF.Components is

   use Ada.Strings.Unbounded;
   use ASF.Contexts.Faces;
   type UIComponent_List is private;

   --  ------------------------------
   --  Attribute of a component
   --  ------------------------------
   type UIAttribute is private;

--     type UIComponent is new Ada.Finalization.Controlled with private;
   type UIComponent is tagged limited private;
   type UIComponent_Access is access all UIComponent'Class;

   --  Get the parent component.
   --  Returns null if the node is the root element.
   function Get_Parent (UI : UIComponent) return UIComponent_Access;

   --  Return a client-side identifier for this component, generating
   --  one if necessary.
   function Get_Client_Id (UI : UIComponent) return Unbounded_String;

   --  Get the list of children.
   function Get_Children (UI : UIComponent) return UIComponent_List;

   --  Get the number of children.
   function Get_Children_Count (UI : UIComponent) return Natural;

   --  Get the first child component.
   --  Returns null if the component has no children.
   function Get_First_Child (UI : UIComponent) return UIComponent_Access;

   --  Initialize the component when restoring the view.
   --  The default initialization gets the client ID and allocates it if necessary.
   procedure Initialize (UI      : in out UIComponent;
                         Context : in out Faces_Context'Class);

   procedure Append (UI    : in UIComponent_Access;
                     Child : in UIComponent_Access;
                     Tag   : access ASF.Views.Nodes.Tag_Node'Class);

   --  Search for and return the {@link UIComponent} with an id
   --  that matches the specified search expression (if any), according to
   --  the algorithm described below.
   function Find (UI : UIComponent;
                  Name : String) return UIComponent_Access;

   --  Check whether the component and its children must be rendered.
   function Is_Rendered (UI : UIComponent;
                         Context : Faces_Context'Class) return Boolean;

   --  Set whether the component is rendered.
   procedure Set_Rendered (UI       : in out UIComponent;
                           Rendered : in Boolean);

   function Get_Attribute (UI      : UIComponent;
                           Context : Faces_Context'Class;
                           Name    : String) return EL.Objects.Object;

   --  Get the attribute tag
   function Get_Attribute (UI      : UIComponent;
                           Name    : String) return access ASF.Views.Nodes.Tag_Attribute;

   procedure Set_Attribute (UI    : in out UIComponent;
                            Name  : in String;
                            Value : in EL.Objects.Object);

   procedure Set_Attribute (UI    : in out UIComponent;
                            Def   : access ASF.Views.Nodes.Tag_Attribute;
                            Value : in EL.Expressions.Expression);

   --  Get the converter associated with the component
   function Get_Converter (UI      : in UIComponent;
                           Context : in Faces_Context'Class)
                           return access ASF.Converters.Converter'Class;

   --  Convert the string into a value.  If a converter is specified on the component,
   --  use it to convert the value.
   function Convert_Value (UI      : in UIComponent;
                           Value   : in String;
                           Context : in Faces_Context'Class) return EL.Objects.Object;

   --  Get the value expression
   function Get_Value_Expression (UI   : in UIComponent;
                                  Name : in String) return EL.Expressions.Value_Expression;

   procedure Encode_Begin (UI      : in UIComponent;
                           Context : in out Faces_Context'Class);

   procedure Encode_Children (UI      : in UIComponent;
                              Context : in out Faces_Context'Class);

   procedure Encode_End (UI      : in UIComponent;
                         Context : in out Faces_Context'Class);

   procedure Encode_All (UI      : in UIComponent'Class;
                         Context : in out Faces_Context'Class);

   procedure Decode (UI      : in out UIComponent;
                     Context : in out Faces_Context'Class);

   procedure Decode_Children (UI      : in UIComponent'Class;
                              Context : in out Faces_Context'Class);

   procedure Process_Decodes (UI      : in out UIComponent;
                              Context : in out Faces_Context'Class);

   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   procedure Process_Validators (UI      : in out UIComponent;
                                 Context : in out Faces_Context'Class);

   procedure Process_Updates (UI      : in out UIComponent;
                              Context : in out Faces_Context'Class);

   type UIComponent_Array is array (Natural range <>) of UIComponent_Access;

   type UIComponent_Array_Access is access UIComponent_Array;

   --  type UIOutput is new UIComponent;

   function Get_Context (UI : in UIComponent)
                         return ASF.Contexts.Faces.Faces_Context_Access;

   --  Get the attribute value.
   function Get_Value (Attr : UIAttribute;
                       UI   : UIComponent'Class) return EL.Objects.Object;

--   function Create_UIComponent (Parent  : UIComponent_Access;
--                                Context : ASF.Contexts.Facelets.Facelet_Context'Class;
--                                Tag    : access ASF.Views.Nodes.Tag_Node'Class)
--                                return UIComponent_Access;

   --  Iterate over the children of the component and execute
   --  the Process procedure.
   generic
      with procedure Process (Child   : in UIComponent_Access);
   procedure Iterate (UI : in UIComponent'Class);

   --  Iterate over the attributes defined on the component and
   --  execute the Process procedure.
   generic
      with procedure Process (Name : in String;
                              Attr : in UIAttribute);
   procedure Iterate_Attributes (UI : in UIComponent'Class);

   --  ------------------------------
   --  Value Holder
   --  ------------------------------
   type Value_Holder is limited interface;

   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   function Get_Local_Value (Holder : in Value_Holder) return EL.Objects.Object is abstract;

   --  Get the value of the component.  If the component has a local
   --  value which is not null, returns it.  Otherwise, if we have a Value_Expression
   --  evaluate and returns the value.
   function Get_Value (Holder : in Value_Holder) return EL.Objects.Object is abstract;

   --  Set the value of the component.
   procedure Set_Value (Holder : in out Value_Holder;
                        Value  : in EL.Objects.Object) is abstract;

   --  Get the converter that is registered on the component.
   function Get_Converter (Holder : in Value_Holder)
                           return access ASF.Converters.Converter'Class is abstract;

   --  Set the converter to be used on the component.
   procedure Set_Converter (Holder    : in out Value_Holder;
                            Converter : access ASF.Converters.Converter'Class) is abstract;

private

   --  Delete the component tree recursively.
   procedure Delete (UI : in out UIComponent_Access);

   type UIAttribute_Access is access all UIAttribute;

   type UIAttribute is record
      Definition : access ASF.Views.Nodes.Tag_Attribute;
      Name       : Unbounded_String;
      Value      : EL.Objects.Object;
      Expr       : El.Expressions.Expression;
      Next_Attr  : UIAttribute_Access;
   end record;

   type UIComponent_List is record
      Child : UIComponent_Access := null;
   end record;

   type UIComponent is tagged limited record
      Id          : Unbounded_String;
      Tag         : access ASF.Views.Nodes.Tag_Node'Class;
      Parent      : UIComponent_Access;
      First_Child : UIComponent_Access;
      Last_Child  : UIComponent_Access;
      Next        : UIComponent_Access;
      Attributes  : UIAttribute_Access;
   end record;

end ASF.Components;

Define the Value_Holder interface

Define the Value_Holder interface


------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC                                                             --
--                                                                          --
--                    Copyright © 2015 darkestkhan                          --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Imago.IL;
use Imago;

with Lumen.GL;
use Lumen;
package Imago.ILUT is

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

                        -----------------------
                        -- C O N S T A N T S --
                        -----------------------

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

  ILUT_VERSION_1_7_8                        : constant IL.Enum := 1;
  ILUT_VERSION                              : constant IL.Enum := 178;

  -- Attribute Bits.
  ILUT_OPENGL_BIT                           : constant IL.Enum := 16#00000001#;
  ILUT_D3D_BIT                              : constant IL.Enum := 16#00000002#;
  ILUT_ALL_ATTRIB_BITS                      : constant IL.Enum := 16#000FFFFF#;

  -- Error Types.
  ILUT_INVALID_ENUM                         : constant IL.Enum := 16#0501#;
  ILUT_OUT_OF_MEMORY                        : constant IL.Enum := 16#0502#;
  ILUT_INVALID_VALUE                        : constant IL.Enum := 16#0505#;
  ILUT_ILLEGAL_OPERATION                    : constant IL.Enum := 16#0506#;
  ILUT_INVALID_PARAM                        : constant IL.Enum := 16#0509#;
  ILUT_COULD_NOT_OPEN_FILE                  : constant IL.Enum := 16#050A#;
  ILUT_STACK_OVERFLOW                       : constant IL.Enum := 16#050E#;
  ILUT_STACK_UNDERFLOW                      : constant IL.Enum := 16#050F#;
  ILUT_BAD_DIMENSIONS                       : constant IL.Enum := 16#0511#;
  ILUT_NOT_SUPPORTED                        : constant IL.Enum := 16#0550#;

  -- State Definitions.
  ILUT_PALETTE_MODE                         : constant IL.Enum := 16#0600#;
  ILUT_OPENGL_CONV                          : constant IL.Enum := 16#0610#;
  ILUT_D3D_MIPLEVELS                        : constant IL.Enum := 16#0620#;
  ILUT_MAXTEX_WIDTH                         : constant IL.Enum := 16#0630#;
  ILUT_MAXTEX_HEIGHT                        : constant IL.Enum := 16#0631#;
  ILUT_MAXTEX_DEPTH                         : constant IL.Enum := 16#0632#;
  ILUT_GL_USE_S3TC                          : constant IL.Enum := 16#0634#;
  ILUT_D3D_USE_DXTC                         : constant IL.Enum := 16#0634#;
  ILUT_GL_GEN_S3TC                          : constant IL.Enum := 16#0635#;
  ILUT_D3D_GEN_DXTC                         : constant IL.Enum := 16#0635#;
  ILUT_S3TC_FORMAT                          : constant IL.Enum := 16#0705#;
  ILUT_DXTC_FORMAT                          : constant IL.Enum := 16#0705#;
  ILUT_D3D_POOL                             : constant IL.Enum := 16#0706#;
  ILUT_D3D_ALPHA_KEY_COLOR                  : constant IL.Enum := 16#0707#;
  ILUT_D3D_ALPHA_KEY_COLOUR                 : constant IL.Enum := 16#0707#;
  ILUT_FORCE_INTEGER_FORMAT                 : constant IL.Enum := 16#0636#;

  -- This new state does automatic texture target detection
  -- if enabled. Currently, only cubemap detection is supported.
  -- if the current image is no cubemap, the 2d texture is chosen.
  ILUT_GL_AUTODETECT_TEXTURE_TARGET         : constant IL.Enum := 16#0807#;

  -- Values.
  ILUT_VERSION_NUM                    : constant IL.Enum := IL.IL_VERSION_NUM;
  ILUT_VENDOR                         : constant IL.Enum := IL.IL_VENDOR;

  -- The different rendering api's.
  -- NOTE:  Imago has support only for OpenGL functions.
  --        Addition of support for other bindings is not planned.
  ILUT_OPENGL                               : constant IL.Enum := 0;
  ILUT_ALLEGRO                              : constant IL.Enum := 1;
  ILUT_WIN32                                : constant IL.Enum := 2;
  ILUT_DIRECT3D8                            : constant IL.Enum := 3;
  ILUT_DIRECT3D9                            : constant IL.Enum := 4;
  ILUT_X11                                  : constant IL.Enum := 5;
  ILUT_DIRECT3D10                           : constant IL.Enum := 6;

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

                      ---------------------------
                      -- S U B P R O G R A M S --
                      ---------------------------

  --------------------------------------------------------------------------
  -- ImageLib Utility Toolkit Functions.
  function Disable (Mode: in IL.Enum) return IL.Bool;

  function Enable (Mode: in IL.Enum) return IL.Bool;

  function Get_Boolean (Mode: in IL.Enum) return IL.Bool;

  procedure Get_Boolean (Mode: in IL.Enum; Param: in IL.Pointer);
  pragma Inline (Get_Boolean);

  function Get_Integer (Mode: in IL.Enum) return IL.Int;

  procedure Get_Integer (Mode: in IL.Enum; Param: in IL.Pointer);
  pragma Inline (Get_Integer);

  function Get_String (String_Name: in IL.Enum) return String;
  pragma Inline (Get_String);

  procedure Init;

  function Is_Disabled (Mode: in IL.Enum) return IL.Bool;

  function Is_Enabled (Mode: in IL.Enum) return IL.Bool;

  procedure Pop_Attrib;

  procedure Push_Attrib (Bits: in IL.UInt);

  procedure Set_Integer (Mode: in IL.Enum; Param: in IL.Int);

  function Renderer (Renderer: in IL.Enum) return IL.Bool;

  -- ImageLib Utility Toolkit's OpenGL Functions.
  function GL_Bind_Tex_Image return GL.UInt;

  function GL_Bind_Mipmaps return GL.UInt;

  function GL_Build_Mipmaps return IL.Bool;

  function GL_Load_Image (File_Name: in String) return GL.UInt;
  pragma Inline (GL_Load_Image);

  function GL_Screen return IL.Bool;

  function GL_Screenie return IL.Bool;

  function GL_Save_Image
    ( File_Name: in String; Tex_ID: in GL.UInt
    ) return IL.Bool;
  pragma Inline (GL_Save_Image);

  function GL_Sub_Tex
    ( Tex_ID: in GL.UInt; XOff: in IL.UInt; YOff: in IL.UInt
    ) return IL.Bool;

  function GL_Sub_Tex
    ( Tex_ID: in GL.UInt; XOff: in IL.UInt;
      YOff: in IL.UInt; ZOff: in IL.UInt
    ) return IL.Bool;
  pragma Inline (GL_Sub_Tex);

  function GL_Set_Tex_2D (Tex_ID: in GL.UInt) return IL.Bool;
  pragma Import (StdCall, GL_Set_Tex_2D, "ilutGLSetTex2D");

  function GL_Set_Tex_3D (Tex_ID: in GL.UInt) return IL.Bool;
  pragma Import (StdCall, GL_Set_Tex_3D, "ilutGLSetTex3D");

  function GL_Tex_Image (Level: in GL.UInt) return IL.Bool;
  pragma Import (StdCall, GL_Tex_Image, "ilutGLTexImage");

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

private

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

                            -------------------
                            -- I M P O R T S --
                            -------------------

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

  pragma Import (StdCall, Disable, "ilutDisable");
  pragma Import (StdCall, Enable, "ilutEnable");
  pragma Import (StdCall, Init, "ilutInit");
  pragma Import (StdCall, Is_Disabled, "ilutIsDisabled");
  pragma Import (StdCall, Is_Enabled, "ilutIsEnabled");
  pragma Import (StdCall, Pop_Attrib, "ilutPopAttrib");
  pragma Import (StdCall, Push_Attrib, "ilutPushAttrib");
  pragma Import (StdCall, Set_Integer, "ilutSetInteger");
  pragma Import (StdCall, Renderer, "ilutRenderer");

  -- OpenGL dependent subprograms
  pragma Import (StdCall, GL_Bind_Tex_Image, "ilutGLBindTexImage");
  pragma Import (StdCall, GL_Bind_Mipmaps, "ilutGLBindMipmaps");
  pragma Import (StdCall, GL_Build_Mipmaps, "ilutGLBuildMipmaps");
  pragma Import (StdCall, GL_Screen, "ilutGLScreen");
  pragma Import (StdCall, GL_Screenie, "ilutGLScreenie");

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

end Imago.ILUT;

------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC                                                             --
--                                                                          --
--                    Copyright © 2015  - 2016 darkestkhan                  --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Imago.IL;
use Imago;

with Lumen.GL;
use Lumen;
package Imago.ILUT is

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

                        -----------------------
                        -- C O N S T A N T S --
                        -----------------------

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

  ILUT_VERSION_1_7_8                        : constant IL.Enum := 1;
  ILUT_VERSION                              : constant IL.Enum := 178;

  -- Attribute Bits.
  ILUT_OPENGL_BIT                           : constant IL.Enum := 16#00000001#;
  ILUT_D3D_BIT                              : constant IL.Enum := 16#00000002#;
  ILUT_ALL_ATTRIB_BITS                      : constant IL.Enum := 16#000FFFFF#;

  -- Error Types.
  ILUT_INVALID_ENUM                         : constant IL.Enum := 16#0501#;
  ILUT_OUT_OF_MEMORY                        : constant IL.Enum := 16#0502#;
  ILUT_INVALID_VALUE                        : constant IL.Enum := 16#0505#;
  ILUT_ILLEGAL_OPERATION                    : constant IL.Enum := 16#0506#;
  ILUT_INVALID_PARAM                        : constant IL.Enum := 16#0509#;
  ILUT_COULD_NOT_OPEN_FILE                  : constant IL.Enum := 16#050A#;
  ILUT_STACK_OVERFLOW                       : constant IL.Enum := 16#050E#;
  ILUT_STACK_UNDERFLOW                      : constant IL.Enum := 16#050F#;
  ILUT_BAD_DIMENSIONS                       : constant IL.Enum := 16#0511#;
  ILUT_NOT_SUPPORTED                        : constant IL.Enum := 16#0550#;

  -- State Definitions.
  ILUT_PALETTE_MODE                         : constant IL.Enum := 16#0600#;
  ILUT_OPENGL_CONV                          : constant IL.Enum := 16#0610#;
  ILUT_D3D_MIPLEVELS                        : constant IL.Enum := 16#0620#;
  ILUT_MAXTEX_WIDTH                         : constant IL.Enum := 16#0630#;
  ILUT_MAXTEX_HEIGHT                        : constant IL.Enum := 16#0631#;
  ILUT_MAXTEX_DEPTH                         : constant IL.Enum := 16#0632#;
  ILUT_GL_USE_S3TC                          : constant IL.Enum := 16#0634#;
  ILUT_D3D_USE_DXTC                         : constant IL.Enum := 16#0634#;
  ILUT_GL_GEN_S3TC                          : constant IL.Enum := 16#0635#;
  ILUT_D3D_GEN_DXTC                         : constant IL.Enum := 16#0635#;
  ILUT_S3TC_FORMAT                          : constant IL.Enum := 16#0705#;
  ILUT_DXTC_FORMAT                          : constant IL.Enum := 16#0705#;
  ILUT_D3D_POOL                             : constant IL.Enum := 16#0706#;
  ILUT_D3D_ALPHA_KEY_COLOR                  : constant IL.Enum := 16#0707#;
  ILUT_D3D_ALPHA_KEY_COLOUR                 : constant IL.Enum := 16#0707#;
  ILUT_FORCE_INTEGER_FORMAT                 : constant IL.Enum := 16#0636#;

  -- This new state does automatic texture target detection
  -- if enabled. Currently, only cubemap detection is supported.
  -- if the current image is no cubemap, the 2d texture is chosen.
  ILUT_GL_AUTODETECT_TEXTURE_TARGET         : constant IL.Enum := 16#0807#;

  -- Values.
  ILUT_VERSION_NUM                    : constant IL.Enum := IL.IL_VERSION_NUM;
  ILUT_VENDOR                         : constant IL.Enum := IL.IL_VENDOR;

  -- The different rendering api's.
  -- NOTE:  Imago has support only for OpenGL functions.
  --        Addition of support for other bindings is not planned.
  ILUT_OPENGL                               : constant IL.Enum := 0;
  ILUT_ALLEGRO                              : constant IL.Enum := 1;
  ILUT_WIN32                                : constant IL.Enum := 2;
  ILUT_DIRECT3D8                            : constant IL.Enum := 3;
  ILUT_DIRECT3D9                            : constant IL.Enum := 4;
  ILUT_X11                                  : constant IL.Enum := 5;
  ILUT_DIRECT3D10                           : constant IL.Enum := 6;

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

                      ---------------------------
                      -- S U B P R O G R A M S --
                      ---------------------------

  --------------------------------------------------------------------------
  -- ImageLib Utility Toolkit Functions.
  function Disable (Mode: in IL.Enum) return IL.Bool;

  function Enable (Mode: in IL.Enum) return IL.Bool;

  function Get_Boolean (Mode: in IL.Enum) return IL.Bool;

  procedure Get_Boolean (Mode: in IL.Enum; Param: in IL.Pointer);
  pragma Inline (Get_Boolean);

  function Get_Integer (Mode: in IL.Enum) return IL.Int;

  procedure Get_Integer (Mode: in IL.Enum; Param: in IL.Pointer);
  pragma Inline (Get_Integer);

  function Get_String (String_Name: in IL.Enum) return String;
  pragma Inline (Get_String);

  procedure Init;

  function Is_Disabled (Mode: in IL.Enum) return IL.Bool;

  function Is_Enabled (Mode: in IL.Enum) return IL.Bool;

  procedure Pop_Attrib;

  procedure Push_Attrib (Bits: in IL.UInt);

  procedure Set_Integer (Mode: in IL.Enum; Param: in IL.Int);

  function Renderer (Renderer: in IL.Enum) return IL.Bool;

  -- ImageLib Utility Toolkit's OpenGL Functions.
  function GL_Bind_Tex_Image return GL.UInt;

  function GL_Bind_Mipmaps return GL.UInt;

  function GL_Build_Mipmaps return IL.Bool;

  function GL_Load_Image (File_Name: in String) return GL.UInt;
  pragma Inline (GL_Load_Image);

  function GL_Screen return IL.Bool;

  function GL_Screenie return IL.Bool;

  function GL_Save_Image
    ( File_Name: in String; Tex_ID: in GL.UInt
    ) return IL.Bool;
  pragma Inline (GL_Save_Image);

  function GL_Sub_Tex
    ( Tex_ID: in GL.UInt; XOff: in IL.UInt; YOff: in IL.UInt
    ) return IL.Bool;

  function GL_Sub_Tex
    ( Tex_ID: in GL.UInt; XOff: in IL.UInt;
      YOff: in IL.UInt; ZOff: in IL.UInt
    ) return IL.Bool;
  pragma Inline (GL_Sub_Tex);

  function GL_Set_Tex_2D (Tex_ID: in GL.UInt) return IL.Bool;

  function GL_Set_Tex_3D (Tex_ID: in GL.UInt) return IL.Bool;

  function GL_Tex_Image (Level: in GL.UInt) return IL.Bool;

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

private

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

                            -------------------
                            -- I M P O R T S --
                            -------------------

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

  pragma Import (StdCall, Disable, "ilutDisable");
  pragma Import (StdCall, Enable, "ilutEnable");
  pragma Import (StdCall, Init, "ilutInit");
  pragma Import (StdCall, Is_Disabled, "ilutIsDisabled");
  pragma Import (StdCall, Is_Enabled, "ilutIsEnabled");
  pragma Import (StdCall, Pop_Attrib, "ilutPopAttrib");
  pragma Import (StdCall, Push_Attrib, "ilutPushAttrib");
  pragma Import (StdCall, Set_Integer, "ilutSetInteger");
  pragma Import (StdCall, Renderer, "ilutRenderer");

  -- OpenGL dependent subprograms
  pragma Import (StdCall, GL_Bind_Tex_Image, "ilutGLBindTexImage");
  pragma Import (StdCall, GL_Bind_Mipmaps, "ilutGLBindMipmaps");
  pragma Import (StdCall, GL_Build_Mipmaps, "ilutGLBuildMipmaps");
  pragma Import (StdCall, GL_Screen, "ilutGLScreen");
  pragma Import (StdCall, GL_Screenie, "ilutGLScreenie");
  pragma Import (StdCall, GL_Set_Tex_2D, "ilutGLSetTex2D");
  pragma Import (StdCall, GL_Set_Tex_3D, "ilutGLSetTex3D");
  pragma Import (StdCall, GL_Tex_Image, "ilutGLTexImage");

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

end Imago.ILUT;

Move Import pragmas to private part.

ILUT: Move Import pragmas to private part.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>


------------------------------------------------------------------------------
-- Copyright (c) 2017-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;

package body Natools.Web.ACL.Sx_Backends is

   type Hashed_Token_List_Array is array (Hash_Id range <>)
     of Containers.Unsafe_Atom_Lists.List;

   type Hashed_Token_Map_Array is array (Hash_Id range <>)
     of Token_Maps.Unsafe_Maps.Map;

   type User_Builder (Hash_Id_First, Hash_Id_Last : Hash_Id) is record
      Tokens, Groups : Containers.Unsafe_Atom_Lists.List;
      Hashed : Hashed_Token_List_Array (Hash_Id_First .. Hash_Id_Last);
   end record;

   type Backend_Builder (Hash_Id_First, Hash_Id_Last : Hash_Id) is record
      Map : Token_Maps.Unsafe_Maps.Map;
      Hashed : Hashed_Token_Map_Array (Hash_Id_First .. Hash_Id_Last);
   end record;

   Cookie_Name : constant String := "User-Token";
   Hash_Mark : constant Character := '$';

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Read_DB is new S_Expressions.Interpreter_Loop
     (Backend_Builder, Meaningless_Type, Process_User);

   procedure Read_User is new S_Expressions.Interpreter_Loop
     (User_Builder, Meaningless_Type, Process_User_Element);

   --------------------------
   -- Constructor Elements --
   --------------------------

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      User : User_Builder (Builder.Hash_Id_First, Builder.Hash_Id_Last);
      Identity : Containers.Identity;
   begin
      Read_User (Arguments, User, Meaningless_Value);

      Identity :=
        (User => S_Expressions.Atom_Ref_Constructors.Create (Name),
         Groups => Containers.Create (User.Groups));

      for Token of User.Tokens loop
         Builder.Map.Include (Token, Identity);
      end loop;

      for Id in User.Hashed'Range loop
         for Hashed_Token of User.Hashed (Id) loop
            Builder.Hashed (Id).Include (Hashed_Token, Identity);
         end loop;
      end loop;
   end Process_User;

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      S_Name : constant String := S_Expressions.To_String (Name);
   begin
      if S_Name = "tokens" or else S_Name = "token" then
         Containers.Append_Atoms (Builder.Tokens, Arguments);
      elsif S_Name = "groups" or else S_Name = "group" then
         Containers.Append_Atoms (Builder.Groups, Arguments);
      elsif (S_Name'Length = 8
           or else (S_Name'Length = 9 and then S_Name (S_Name'Last) = 's'))
        and then S_Name (S_Name'First) = Hash_Mark
        and then S_Name (S_Name'First + 2 .. S_Name'First + 7)
           = Hash_Mark & "token"
        and then not Hash_Function_DB.Is_Empty
      then
         declare
            Id : constant Character := S_Name (S_Name'First + 1);
            Acc : constant Hash_Function_Array_Refs.Accessor
              := Hash_Function_DB.Query;
         begin
            if Id in Acc.Data.all'Range and then Acc.Data (Id) /= null then
               Containers.Append_Atoms (Builder.Hashed (Id), Arguments);
            else
               Log (Severities.Error, "Unknown hash function id"
                 & Character'Image (Id));
            end if;
         end;
      else
         Log (Severities.Error, "Unknown user element """ & S_Name & '"');
      end if;
   end Process_User_Element;

   ----------------------
   -- Public Interface --
   ----------------------

   overriding procedure Authenticate
     (Self : in Backend;
      Exchange : in out Exchanges.Exchange)
   is
      Cookie : constant String := Exchange.Cookie (Cookie_Name);
      Identity : Containers.Identity;
   begin
      if Cookie'Length > 3
        and then Cookie (Cookie'First) = Hash_Mark
        and then Cookie (Cookie'First + 2) = Hash_Mark
        and then not Self.Hashed.Is_Empty
        and then Cookie (Cookie'First + 1) in Self.Hashed.Query.Data.all'Range
      then
         declare
            Token : constant S_Expressions.Atom
              := S_Expressions.To_Atom
                 (Cookie (Cookie'First + 3 .. Cookie'Last));
            Hash : constant S_Expressions.Atom
              := Hash_Function_DB.Query.Data (Cookie (Cookie'First + 1)).all
                 (Token);
            Cursor : constant Token_Maps.Cursor
              := Self.Hashed.Query.Data (Cookie (Cookie'First + 1)).Find
                 (Hash);
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      else
         declare
            Cursor : constant Token_Maps.Cursor
              := Self.Map.Find (S_Expressions.To_Atom (Cookie));
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      end if;

      Exchange.Set_Identity (Identity);
   end Authenticate;

   function Create
     (Arguments : in out S_Expressions.Lockable.Descriptor'Class)
     return ACL.Backend'Class
   is
      Hash_Id_First : constant Hash_Id
        := (if Hash_Function_DB.Is_Empty
            then Hash_Id'Last
            else Hash_Function_DB.Query.Data.all'First);
      Hash_Id_Last : constant Hash_Id
        := (if Hash_Function_DB.Is_Empty
            then Hash_Id'First
            else Hash_Function_DB.Query.Data.all'Last);
      Builder : Backend_Builder (Hash_Id_First, Hash_Id_Last);
   begin
      case Arguments.Current_Event is
         when S_Expressions.Events.Open_List =>
            Read_DB (Arguments, Builder, Meaningless_Value);

         when S_Expressions.Events.Add_Atom =>
            declare
               Reader : S_Expressions.File_Readers.S_Reader
                 := S_Expressions.File_Readers.Reader
                    (S_Expressions.To_String (Arguments.Current_Atom));
            begin
               Read_DB (Reader, Builder, Meaningless_Value);
            end;

         when others =>
            Log (Severities.Error, "Unable to create ACL from S-expression"
              & " starting with " & Arguments.Current_Event'Img);
      end case;

      return Result : Backend
        := (Map => Token_Maps.Create (Builder.Map),
            Hashed => <>)
      do
         declare
            Min : Hash_Id := Hash_Id'Last;
            Max : Hash_Id := Hash_Id'First;
         begin
            for Id in Builder.Hashed'Range loop
               if not Builder.Hashed (Id).Is_Empty then
                  --  Hash_Id'Min seems broken, using a basic `if` instead
                  if Id < Min then
                     Min := Id;
                  end if;

                  if Id > Max then
                     Max := Id;
                  end if;
               end if;
            end loop;

            if Min <= Max then
               declare
                  Data : constant Hashed_Token_Array_Refs.Data_Access
                    := new Hashed_Token_Array (Min .. Max);
               begin
                  Result.Hashed := Hashed_Token_Array_Refs.Create (Data);
                  for Id in Min .. Max loop
                     if not Builder.Hashed (Id).Is_Empty then
                        Data (Id) := Token_Maps.Create (Builder.Hashed (Id));
                     end if;
                  end loop;
               end;
            end if;
         end;
      end return;
   end Create;

   procedure Register
     (Id : in Character;
      Fn : in Hash_Function) is
   begin
      if Fn = null then
         null;
      elsif Hash_Function_DB.Is_Empty then
         Hash_Function_DB.Replace (new Hash_Function_Array'(Id => Fn));
      elsif Id in Hash_Function_DB.Query.Data.all'Range then
         Hash_Function_DB.Update.Data.all (Id) := Fn;
      else
         declare
            New_First : constant Hash_Id
              := Hash_Id'Min (Id, Hash_Function_DB.Query.Data.all'First);
            New_Last : constant Hash_Id
              := Hash_Id'Max (Id, Hash_Function_DB.Query.Data.all'Last);
            New_Data : constant Hash_Function_Array_Refs.Data_Access
              := new Hash_Function_Array'(New_First .. New_Last => null);
         begin
            Log (Severities.Info,
              "Adding " & Id'Img & " to "
              & Hash_Function_DB.Query.Data.all'First'Img & " .. "
              & Hash_Function_DB.Query.Data.all'Last'Img & " -> "
              & New_First'Img & " .. " & New_Last'Img);
            New_Data (Hash_Function_DB.Query.Data.all'First
                  ..  Hash_Function_DB.Query.Data.all'Last)
              := Hash_Function_DB.Query.Data.all;
            Hash_Function_DB.Replace (New_Data);
         end;
      end if;
   end Register;

end Natools.Web.ACL.Sx_Backends;

------------------------------------------------------------------------------
-- Copyright (c) 2017-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;

package body Natools.Web.ACL.Sx_Backends is

   type Hashed_Token_List_Array is array (Hash_Id range <>)
     of Containers.Unsafe_Atom_Lists.List;

   type Hashed_Token_Map_Array is array (Hash_Id range <>)
     of Token_Maps.Unsafe_Maps.Map;

   type User_Builder (Hash_Id_First, Hash_Id_Last : Hash_Id) is record
      Tokens, Groups : Containers.Unsafe_Atom_Lists.List;
      Hashed : Hashed_Token_List_Array (Hash_Id_First .. Hash_Id_Last);
   end record;

   type Backend_Builder (Hash_Id_First, Hash_Id_Last : Hash_Id) is record
      Map : Token_Maps.Unsafe_Maps.Map;
      Hashed : Hashed_Token_Map_Array (Hash_Id_First .. Hash_Id_Last);
   end record;

   Cookie_Name : constant String := "User-Token";
   Hash_Mark : constant Character := '$';

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class);

   procedure Read_DB is new S_Expressions.Interpreter_Loop
     (Backend_Builder, Meaningless_Type, Process_User);

   procedure Read_User is new S_Expressions.Interpreter_Loop
     (User_Builder, Meaningless_Type, Process_User_Element);

   --------------------------
   -- Constructor Elements --
   --------------------------

   procedure Process_User
     (Builder : in out Backend_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      User : User_Builder (Builder.Hash_Id_First, Builder.Hash_Id_Last);
      Identity : Containers.Identity;
   begin
      Read_User (Arguments, User, Meaningless_Value);

      Identity :=
        (User => S_Expressions.Atom_Ref_Constructors.Create (Name),
         Groups => Containers.Create (User.Groups));

      for Token of User.Tokens loop
         Builder.Map.Include (Token, Identity);
      end loop;

      for Id in User.Hashed'Range loop
         for Hashed_Token of User.Hashed (Id) loop
            Builder.Hashed (Id).Include (Hashed_Token, Identity);
         end loop;
      end loop;
   end Process_User;

   procedure Process_User_Element
     (Builder : in out User_Builder;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      S_Name : constant String := S_Expressions.To_String (Name);
   begin
      if S_Name = "tokens" or else S_Name = "token" then
         Containers.Append_Atoms (Builder.Tokens, Arguments);
      elsif S_Name = "groups" or else S_Name = "group" then
         Containers.Append_Atoms (Builder.Groups, Arguments);
      elsif (S_Name'Length = 8
           or else (S_Name'Length = 9 and then S_Name (S_Name'Last) = 's'))
        and then S_Name (S_Name'First) = Hash_Mark
        and then S_Name (S_Name'First + 2 .. S_Name'First + 7)
           = Hash_Mark & "token"
        and then not Hash_Function_DB.Is_Empty
      then
         declare
            Id : constant Character := S_Name (S_Name'First + 1);
            Acc : constant Hash_Function_Array_Refs.Accessor
              := Hash_Function_DB.Query;
         begin
            if Id in Acc.Data.all'Range and then Acc.Data (Id) /= null then
               Containers.Append_Atoms (Builder.Hashed (Id), Arguments);
            else
               Log (Severities.Error, "Unknown hash function id"
                 & Character'Image (Id));
            end if;
         end;
      else
         Log (Severities.Error, "Unknown user element """ & S_Name & '"');
      end if;
   end Process_User_Element;

   ----------------------
   -- Public Interface --
   ----------------------

   overriding procedure Authenticate
     (Self : in Backend;
      Exchange : in out Exchanges.Exchange)
   is
      Cookie : constant String := Exchange.Cookie (Cookie_Name);
      Identity : Containers.Identity;
   begin
      if Cookie'Length > 3
        and then Cookie (Cookie'First) = Hash_Mark
        and then Cookie (Cookie'First + 2) = Hash_Mark
        and then not Self.Hashed.Is_Empty
        and then Cookie (Cookie'First + 1) in Self.Hashed.Query.Data.all'Range
      then
         declare
            Token : constant S_Expressions.Atom
              := S_Expressions.To_Atom
                 (Cookie (Cookie'First + 3 .. Cookie'Last));
            Hash : constant S_Expressions.Atom
              := Hash_Function_DB.Query.Data (Cookie (Cookie'First + 1)).all
                 (Token);
            Cursor : constant Token_Maps.Cursor
              := Self.Hashed.Query.Data (Cookie (Cookie'First + 1)).Find
                 (Hash);
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      else
         declare
            Cursor : constant Token_Maps.Cursor
              := Self.Map.Find (S_Expressions.To_Atom (Cookie));
         begin
            if Token_Maps.Has_Element (Cursor) then
               Identity := Token_Maps.Element (Cursor);
            end if;
         end;
      end if;

      Exchange.Set_Identity (Identity);
   end Authenticate;

   function Create
     (Arguments : in out S_Expressions.Lockable.Descriptor'Class)
     return ACL.Backend'Class
   is
      Hash_Id_First : constant Hash_Id
        := (if Hash_Function_DB.Is_Empty
            then Hash_Id'Last
            else Hash_Function_DB.Query.Data.all'First);
      Hash_Id_Last : constant Hash_Id
        := (if Hash_Function_DB.Is_Empty
            then Hash_Id'First
            else Hash_Function_DB.Query.Data.all'Last);
      Builder : Backend_Builder (Hash_Id_First, Hash_Id_Last);
   begin
      case Arguments.Current_Event is
         when S_Expressions.Events.Open_List =>
            Read_DB (Arguments, Builder, Meaningless_Value);

         when S_Expressions.Events.Add_Atom =>
            declare
               Reader : S_Expressions.File_Readers.S_Reader
                 := S_Expressions.File_Readers.Reader
                    (S_Expressions.To_String (Arguments.Current_Atom));
            begin
               Read_DB (Reader, Builder, Meaningless_Value);
            end;

         when others =>
            Log (Severities.Error, "Unable to create ACL from S-expression"
              & " starting with " & Arguments.Current_Event'Img);
      end case;

      return Result : Backend
        := (Map => Token_Maps.Create (Builder.Map),
            Hashed => <>)
      do
         declare
            Min : Hash_Id := Hash_Id'Last;
            Max : Hash_Id := Hash_Id'First;
         begin
            for Id in Builder.Hashed'Range loop
               if not Builder.Hashed (Id).Is_Empty then
                  --  Hash_Id'Min seems broken, using a basic `if` instead
                  if Id < Min then
                     Min := Id;
                  end if;

                  if Id > Max then
                     Max := Id;
                  end if;
               end if;
            end loop;

            if Min <= Max then
               declare
                  Data : constant Hashed_Token_Array_Refs.Data_Access
                    := new Hashed_Token_Array (Min .. Max);
               begin
                  Result.Hashed := Hashed_Token_Array_Refs.Create (Data);
                  for Id in Min .. Max loop
                     if not Builder.Hashed (Id).Is_Empty then
                        Data (Id) := Token_Maps.Create (Builder.Hashed (Id));
                     end if;
                  end loop;
               end;
            end if;
         end;
      end return;
   end Create;

   procedure Register
     (Id : in Character;
      Fn : in Hash_Function) is
   begin
      if Fn = null then
         null;
      elsif Hash_Function_DB.Is_Empty then
         Hash_Function_DB.Replace (new Hash_Function_Array'(Id => Fn));
      elsif Id in Hash_Function_DB.Query.Data.all'Range then
         Hash_Function_DB.Update.Data.all (Id) := Fn;
      else
         declare
            New_First : constant Hash_Id
              := Hash_Id'Min (Id, Hash_Function_DB.Query.Data.all'First);
            New_Last : constant Hash_Id
              := Hash_Id'Max (Id, Hash_Function_DB.Query.Data.all'Last);
            New_Data : constant Hash_Function_Array_Refs.Data_Access
              := new Hash_Function_Array'(New_First .. New_Last => null);
         begin
            New_Data (Hash_Function_DB.Query.Data.all'First
                  ..  Hash_Function_DB.Query.Data.all'Last)
              := Hash_Function_DB.Query.Data.all;
            New_Data (Id) := Fn;
            Hash_Function_DB.Replace (New_Data);
         end;
      end if;
   end Register;

end Natools.Web.ACL.Sx_Backends;

acl-sx_backends: fix a bug when inserting the second hash function


------------------------------------------------------------------------------
--                        Bareboard drivers examples                        --
--                                                                          --
--                     Copyright (C) 2015-2016, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

--  A very simple draw application.
--  Use your finger to draw pixels.

with Last_Chance_Handler;  pragma Unreferenced (Last_Chance_Handler);
--  The "last chance handler" is the user-defined routine that is called when
--  an exception is propagated. We need it in the executable, therefore it
--  must be somewhere in the closure of the context clauses.

with STM32.Board;           use STM32.Board;
with HAL.Bitmap;            use HAL.Bitmap;
with HAL.Touch_Panel;       use HAL.Touch_Panel;
with STM32.Button;

with Bitmapped_Drawing;     use Bitmapped_Drawing;

procedure Draw
is
   procedure Clear;

   -----------
   -- Clear --
   -----------

   procedure Clear is
   begin
      Display.Get_Hidden_Buffer (1).Fill ((Alpha => 255, others => 64));
   end Clear;

begin
   --  Initialize LCD
   Display.Initialize;
   Display.Initialize_Layer (1, RGB_888);

   --  Initialize touch panel
   Touch_Panel.Initialize;

   --  Initialize button
   STM32.Button.Initialize;

   --  Clear LCD (set background)
   Clear;

   --  The application: set pixel where the finger is (so that you
   --  cannot see what you are drawing).
   loop
      if STM32.Button.Has_Been_Pressed then
         Clear;
      else
         declare
            State : constant TP_State := Touch_Panel.Get_All_Touch_Points;
         begin
            for Touch of State loop
               --  Workaround some strange readings from the STM32F429 TP
               Fill_Circle
                 (Display.Get_Hidden_Buffer (1),
                  (Touch.X, Touch.Y), Touch.Weight / 4, HAL.Bitmap.Red);
               Display.Update_Layer (1, Copy_Back => True);
            end loop;
         end;
      end if;
   end loop;
end Draw;

------------------------------------------------------------------------------
--                        Bareboard drivers examples                        --
--                                                                          --
--                     Copyright (C) 2015-2016, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

--  A very simple draw application.
--  Use your finger to draw pixels.

with Last_Chance_Handler;  pragma Unreferenced (Last_Chance_Handler);
--  The "last chance handler" is the user-defined routine that is called when
--  an exception is propagated. We need it in the executable, therefore it
--  must be somewhere in the closure of the context clauses.

with STM32.Board;           use STM32.Board;
with HAL.Bitmap;            use HAL.Bitmap;
with HAL.Touch_Panel;       use HAL.Touch_Panel;
with STM32.Button;

with Bitmapped_Drawing;     use Bitmapped_Drawing;

procedure Draw
is
   procedure Clear;

   -----------
   -- Clear --
   -----------

   procedure Clear is
   begin
      Display.Get_Hidden_Buffer (1).Fill ((Alpha => 255, others => 64));
      Display.Update_Layer (1, Copy_Back => True);
   end Clear;

   Last_X : Integer := -1;
   Last_Y : Integer := -1;

begin
   --  Initialize LCD
   Display.Initialize;
   Display.Initialize_Layer (1, ARGB_8888);

   --  Initialize touch panel
   Touch_Panel.Initialize;

   --  Initialize button
   STM32.Button.Initialize;

   --  Clear LCD (set background)
   Clear;

   --  The application: set pixel where the finger is (so that you
   --  cannot see what you are drawing).
   loop
      if STM32.Button.Has_Been_Pressed then
         Clear;
      end if;

      declare
         State : constant TP_State := Touch_Panel.Get_All_Touch_Points;
      begin
         if State'Length = 0 then
            Last_X := -1;
            Last_Y := -1;

         elsif State'Length = 1 then
            --  Lines can be drawn between two consecutive points only when
            --  one touch point is active: the order of the touch data is not
            --  necessarily preserved by the hardware.
            if Last_X > 0 then
               Draw_Line
                 (Display.Get_Hidden_Buffer (1),
                  Start     => (Last_X, Last_Y),
                  Stop      => (State (State'First).X, State (State'First).Y),
                  Hue       => HAL.Bitmap.Green,
                  Thickness => State (State'First).Weight / 2,
                  Fast      => False);
            end if;

            Last_X := State (State'First).X;
            Last_Y := State (State'First).Y;

         else
            Last_X := -1;
            Last_Y := -1;
         end if;

         for Id in State'Range loop
            Fill_Circle
              (Display.Get_Hidden_Buffer (1),
               Center => (State (Id).X, State (Id).Y),
               Radius => State (Id).Weight / 4,
               Hue    => HAL.Bitmap.Green);
         end loop;

         if State'Length > 0 then
            Display.Update_Layer (1, Copy_Back => True);
         end if;
      end;
   end loop;
end Draw;

Improve the draw example: draws line between two consecutive touch


-----------------------------------------------------------------------
--  applications -- Ada Web Application
--  Copyright (C) 2009, 2010, 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 Util.Properties.Basic;
package body ASF.Applications is

   --  ------------------------------
   --  Get the configuration parameter;
   --  ------------------------------
   function Get (Self  : Config;
                 Param : Config_Param) return String is
   begin
      return Self.Get (Param.Name.all, Param.Default.all);
   end Get;

   --  ------------------------------
   --  Get the configuration parameter;
   --  ------------------------------
   function Get (Self  : Config;
                 Param : Config_Param) return Boolean is
      use Util.Properties.Basic.Boolean_Property;
   begin
      return Get (Self, Param.Name.all, Boolean'Value (Param.Default.all));
   end Get;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

end ASF.Applications;

-----------------------------------------------------------------------
--  applications -- Ada Web Application
--  Copyright (C) 2009, 2010, 2013, 2015 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 Util.Properties.Basic;
package body ASF.Applications is

   --  ------------------------------
   --  Get the configuration parameter;
   --  ------------------------------
   function Get (Self  : Config;
                 Param : Config_Param) return String is
   begin
      return Self.Get (Param.Name.all, Param.Default.all);
   end Get;

   --  ------------------------------
   --  Get the configuration parameter;
   --  ------------------------------
   function Get (Self  : Config;
                 Param : Config_Param) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      if Self.Exists (Param.Name.all) then
         return Self.Get (Param.Name.all);
      else
         return Ada.Strings.Unbounded.To_Unbounded_String (Param.Default.all);
      end if;
   end Get;

   --  ------------------------------
   --  Get the configuration parameter;
   --  ------------------------------
   function Get (Self  : Config;
                 Param : Config_Param) return Boolean is
      use Util.Properties.Basic.Boolean_Property;
   begin
      return Get (Self, Param.Name.all, Boolean'Value (Param.Default.all));
   end Get;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

end ASF.Applications;

Implement new Get function that returns an Unbounded_String


-----------------------------------------------------------------------
--  util-log -- Utility Log Package
--  Copyright (C) 2001 - 2021 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.
-----------------------------------------------------------------------

--  = Logging =
--  The `Util.Log` package and children provide a simple logging framework inspired
--  from the Java Log4j library.  It is intended to provide a subset of logging features
--  available in other languages, be flexible, extensible, small and efficient.  Having
--  log messages in large applications is very helpful to understand, track and fix complex
--  issues, some of them being related to configuration issues or interaction with other
--  systems.  The overhead of calling a log operation is negligible when the log is disabled
--  as it is in the order of 30ns and reasonable for a file appender has it is in the order
--  of 5us.  To use the packages described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Using the log framework ==
--  A bit of terminology:
--
--  * A *logger* is the abstraction that provides operations to emit a message.  The message
--    is composed of a text, optional formatting parameters, a log level and a timestamp.
--  * A *formatter* is the abstraction that takes the information about the log to format
--    the final message.
--  * An *appender* is the abstraction that writes the message either to a console, a file
--    or some other final mechanism.
--
--  == Logger Declaration ==
--  Similar to other logging framework such as Java Log4j and Log4cxx, it is necessary to have
--  and instance of a logger to write a log message.  The logger instance holds the configuration
--  for the log to enable, disable and control the format and the appender that will receive
--  the message.  The logger instance is associated with a name that is used for the
--  configuration.  A good practice is to declare a `Log` instance in the package body or
--  the package private part to make available the log instance to all the package operations.
--  The instance is created by using the `Create` function.  The name used for the configuration
--  is free but using the full package name is helpful to control precisely the logs.
--
--    with Util.Log.Loggers;
--    package body X.Y is
--      Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("X.Y");
--    end X.Y;
--
--  == Logger Messages ==
--  A log message is associated with a log level which is used by the logger instance to
--  decide to emit or drop the log message.  To keep the logging API simple and make it easily
--  usable in the application, several operations are provided to write a message with different
--  log level.
--
--  A log message is a string that contains optional formatting markers that follow more or
--  less the Java `MessageFormat` class.  A parameter is represented by a number enclosed by `{}`.
--  The first parameter is represented by `{0}`, the second by `{1}` and so on.  Parameters are
--  replaced in the final message only when the message is enabled by the log configuration.
--  The use of parameters allows to avoid formatting the log message when the log is not used.
--
--  The example below shows several calls to emit a log message with different levels:
--
--     Log.Error ("Cannot open file {0}: {1}", Path, "File does not exist");
--     Log.Warn ("The file {0} is empty", Path);
--     Log.Info ("Opening file {0}", Path);
--     Log.Debug ("Reading line {0}", Line);
--
--  The logger also provides a special `Error` procedure that accepts an Ada exception
--  occurrence as parameter.  The exception name and message are printed together with
--  the error message.  It is also possible to activate a complete traceback of the
--  exception and report it in the error message.  With this mechanism, an exception
--  can be handled and reported easily:
--
--     begin
--        ...
--     exception
--        when E : others =>
--           Log.Error ("Something bad occurred", E, Trace => True);
--     end;
--
--  == Log Configuration ==
--  The log configuration uses property files close to the Apache Log4j and to the
--  Apache Log4cxx configuration files.
--  The configuration file contains several parts to configure the logging framework:
--
--  * First, the *appender* configuration indicates the appender that exists and can receive
--    a log message.
--  * Second, a root configuration allows to control the default behavior of the logging
--    framework.  The root configuration controls the default log level as well as the
--    appenders that can be used.
--  * Last, a logger configuration is defined to control the logging level more precisely
--    for each logger.
--
--  Here is a simple log configuration that creates a file appender where log messages are
--  written.  The file appender is given the name `result` and is configured to write the
--  messages in the file `my-log-file.log`.  The file appender will use the `level-message`
--  format for the layout of messages.  Last is the configuration of the `X.Y` logger
--  that will enable only messages starting from the `WARN` level.
--
--    log4j.rootCategory=DEBUG,result
--    log4j.appender.result=File
--    log4j.appender.result.File=my-log-file.log
--    log4j.appender.result.layout=level-message
--    log4j.logger.X.Y=WARN
--
--  By default when the `layout` is not set or has an invalid value, the full message is
--  reported and the generated log messages will look as follows:
--
--    [2018-02-07 20:39:51] ERROR - X.Y - Cannot open file test.txt: File does not exist
--    [2018-02-07 20:39:51] WARN  - X.Y - The file test.txt is empty
--    [2018-02-07 20:39:51] INFO  - X.Y - Opening file test.txt
--    [2018-02-07 20:39:51] DEBUG - X.Y - Reading line ......
--
--  When the `layout` configuration is set to `data-level-message`, the message is printed
--  with the date and message level.
--
--    [2018-02-07 20:39:51] ERROR: Cannot open file test.txt: File does not exist
--    [2018-02-07 20:39:51] WARN : The file test.txt is empty
--    [2018-02-07 20:39:51] INFO : X.Y - Opening file test.txt
--    [2018-02-07 20:39:51] DEBUG: X.Y - Reading line ......
--
--  When the `layout` configuration is set to `level-message`, only the message and its
--  level are reported.
--
--    ERROR: Cannot open file test.txt: File does not exist
--    WARN : The file test.txt is empty
--    INFO : X.Y - Opening file test.txt
--    DEBUG: X.Y - Reading line ......
--
--  The last possible configuration for `layout` is `message` which only prints the message.
--
--    Cannot open file test.txt: File does not exist
--    The file test.txt is empty
--    Opening file test.txt
--    Reading line ......
--
--  The `Console` appender recognises the following configurations:
--
--  | Name           | Description                                                          |
--  | -------------- | --------------------------------------------------------------       |
--  | layout         | Defines the format of the message printed by the appender.           |
--  | level          | Defines the minimum level above which messages are printed.          |
--  | stderr         | When 'true' or '1', use the console standard error,                  |
--  |                | by default the appender uses the standard output                     |
--
--  The `File` appender recognises the following configurations:
--
--  | Name           | Description                                                          |
--  | -------------- | --------------------------------------------------------------       |
--  | layout         | Defines the format of the message printed by the appender.           |
--  | level          | Defines the minimum level above which messages are printed.          |
--  | File           | The path used by the appender to create the output file.             |
--  | append         | When 'true' or '1', the file is opened in append mode otherwise      |
--  |                | it is truncated (the default is to truncate).                        |
--  | immediateFlush | When 'true' or '1', the file is flushed after each message log.      |
--  |                | Immediate flush is useful in some situations to have the log file    |
--  |                | updated immediately at the expense of slowing down the processing    |
--  |                | of logs.                                                             |
package Util.Log is

   pragma Preelaborate;

   subtype Level_Type is Natural;

   FATAL_LEVEL : constant Level_Type := 0;
   ERROR_LEVEL : constant Level_Type := 5;
   WARN_LEVEL  : constant Level_Type := 7;
   INFO_LEVEL  : constant Level_Type := 10;
   DEBUG_LEVEL : constant Level_Type := 20;

   --  Get the log level name.
   function Get_Level_Name (Level : Level_Type) return String;

   --  Get the log level from the property value
   function Get_Level (Value   : in String;
                       Default : in Level_Type := INFO_LEVEL) return Level_Type;

   --  The <tt>Logging</tt> interface defines operations that can be implemented for a
   --  type to report errors or messages.
   type Logging is limited interface;

   procedure Error (Log     : in out Logging;
                    Message : in String) is abstract;

end Util.Log;

-----------------------------------------------------------------------
--  util-log -- Utility Log Package
--  Copyright (C) 2001 - 2021 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.
-----------------------------------------------------------------------

--  = Logging =
--  The `Util.Log` package and children provide a simple logging framework inspired
--  from the Java Log4j library.  It is intended to provide a subset of logging features
--  available in other languages, be flexible, extensible, small and efficient.  Having
--  log messages in large applications is very helpful to understand, track and fix complex
--  issues, some of them being related to configuration issues or interaction with other
--  systems.  The overhead of calling a log operation is negligible when the log is disabled
--  as it is in the order of 30ns and reasonable for a file appender has it is in the order
--  of 5us.  To use the packages described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Using the log framework ==
--  A bit of terminology:
--
--  * A *logger* is the abstraction that provides operations to emit a message.  The message
--    is composed of a text, optional formatting parameters, a log level and a timestamp.
--  * A *formatter* is the abstraction that takes the information about the log to format
--    the final message.
--  * An *appender* is the abstraction that writes the message either to a console, a file
--    or some other final mechanism.
--
--  == Logger Declaration ==
--  Similar to other logging framework such as Java Log4j and Log4cxx, it is necessary to have
--  and instance of a logger to write a log message.  The logger instance holds the configuration
--  for the log to enable, disable and control the format and the appender that will receive
--  the message.  The logger instance is associated with a name that is used for the
--  configuration.  A good practice is to declare a `Log` instance in the package body or
--  the package private part to make available the log instance to all the package operations.
--  The instance is created by using the `Create` function.  The name used for the configuration
--  is free but using the full package name is helpful to control precisely the logs.
--
--    with Util.Log.Loggers;
--    package body X.Y is
--      Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("X.Y");
--    end X.Y;
--
--  == Logger Messages ==
--  A log message is associated with a log level which is used by the logger instance to
--  decide to emit or drop the log message.  To keep the logging API simple and make it easily
--  usable in the application, several operations are provided to write a message with different
--  log level.
--
--  A log message is a string that contains optional formatting markers that follow more or
--  less the Java `MessageFormat` class.  A parameter is represented by a number enclosed by `{}`.
--  The first parameter is represented by `{0}`, the second by `{1}` and so on.  Parameters are
--  replaced in the final message only when the message is enabled by the log configuration.
--  The use of parameters allows to avoid formatting the log message when the log is not used.
--
--  The example below shows several calls to emit a log message with different levels:
--
--     Log.Error ("Cannot open file {0}: {1}", Path, "File does not exist");
--     Log.Warn ("The file {0} is empty", Path);
--     Log.Info ("Opening file {0}", Path);
--     Log.Debug ("Reading line {0}", Line);
--
--  The logger also provides a special `Error` procedure that accepts an Ada exception
--  occurrence as parameter.  The exception name and message are printed together with
--  the error message.  It is also possible to activate a complete traceback of the
--  exception and report it in the error message.  With this mechanism, an exception
--  can be handled and reported easily:
--
--     begin
--        ...
--     exception
--        when E : others =>
--           Log.Error ("Something bad occurred", E, Trace => True);
--     end;
--
--  == Log Configuration ==
--  The log configuration uses property files close to the Apache Log4j and to the
--  Apache Log4cxx configuration files.
--  The configuration file contains several parts to configure the logging framework:
--
--  * First, the *appender* configuration indicates the appender that exists and can receive
--    a log message.
--  * Second, a root configuration allows to control the default behavior of the logging
--    framework.  The root configuration controls the default log level as well as the
--    appenders that can be used.
--  * Last, a logger configuration is defined to control the logging level more precisely
--    for each logger.
--
--  Here is a simple log configuration that creates a file appender where log messages are
--  written.  The file appender is given the name `result` and is configured to write the
--  messages in the file `my-log-file.log`.  The file appender will use the `level-message`
--  format for the layout of messages.  Last is the configuration of the `X.Y` logger
--  that will enable only messages starting from the `WARN` level.
--
--    log4j.rootCategory=DEBUG,result
--    log4j.appender.result=File
--    log4j.appender.result.File=my-log-file.log
--    log4j.appender.result.layout=level-message
--    log4j.logger.X.Y=WARN
--
--  By default when the `layout` is not set or has an invalid value, the full message is
--  reported and the generated log messages will look as follows:
--
--    [2018-02-07 20:39:51] ERROR - X.Y - Cannot open file test.txt: File does not exist
--    [2018-02-07 20:39:51] WARN  - X.Y - The file test.txt is empty
--    [2018-02-07 20:39:51] INFO  - X.Y - Opening file test.txt
--    [2018-02-07 20:39:51] DEBUG - X.Y - Reading line ......
--
--  When the `layout` configuration is set to `data-level-message`, the message is printed
--  with the date and message level.
--
--    [2018-02-07 20:39:51] ERROR: Cannot open file test.txt: File does not exist
--    [2018-02-07 20:39:51] WARN : The file test.txt is empty
--    [2018-02-07 20:39:51] INFO : X.Y - Opening file test.txt
--    [2018-02-07 20:39:51] DEBUG: X.Y - Reading line ......
--
--  When the `layout` configuration is set to `level-message`, only the message and its
--  level are reported.
--
--    ERROR: Cannot open file test.txt: File does not exist
--    WARN : The file test.txt is empty
--    INFO : X.Y - Opening file test.txt
--    DEBUG: X.Y - Reading line ......
--
--  The last possible configuration for `layout` is `message` which only prints the message.
--
--    Cannot open file test.txt: File does not exist
--    The file test.txt is empty
--    Opening file test.txt
--    Reading line ......
--
--  @include util-log-appenders-consoles.ads
--  @include util-log-appenders-files.ads
--  @include util-log-appenders-rolling_files.ads
package Util.Log is

   pragma Preelaborate;

   subtype Level_Type is Natural;

   FATAL_LEVEL : constant Level_Type := 0;
   ERROR_LEVEL : constant Level_Type := 5;
   WARN_LEVEL  : constant Level_Type := 7;
   INFO_LEVEL  : constant Level_Type := 10;
   DEBUG_LEVEL : constant Level_Type := 20;

   --  Get the log level name.
   function Get_Level_Name (Level : Level_Type) return String;

   --  Get the log level from the property value
   function Get_Level (Value   : in String;
                       Default : in Level_Type := INFO_LEVEL) return Level_Type;

   --  The <tt>Logging</tt> interface defines operations that can be implemented for a
   --  type to report errors or messages.
   type Logging is limited interface;

   procedure Error (Log     : in out Logging;
                    Message : in String) is abstract;

end Util.Log;

Add documentation for the configuration

Add documentation for the configuration


-----------------------------------------------------------------------
--  gen-commands-page -- Page creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 2017, 2018 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Util.Strings;

package body Gen.Commands.Page is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name);
      use Ada.Strings.Unbounded;

      function Get_Layout return String;
      function Get_Name return String;

      Dir    : constant String := Generator.Get_Result_Directory & "web/";

      function Get_Name return String is
         Name : constant String := Args.Get_Argument (1);
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      function Get_Layout return String is
      begin
         if Args.Get_Count = 1 then
            return "layout";
         end if;
         declare
            Layout : constant String := Args.Get_Argument (2);
         begin
            if Ada.Directories.Exists (Dir & "WEB-INF/layouts/" & Layout & ".xhtml") then
               return Layout;
            end if;

            Generator.Info ("Layout file {0} not found.", Layout);
            return Layout;
         end;
      end Get_Layout;

   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Cmd.Usage (Name);
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      Generator.Set_Global ("pageName", Get_Name);
      Generator.Set_Global ("layout", Get_Layout);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "page");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      use Ada.Directories;

      Path    : constant String := Generator.Get_Result_Directory & "web/WEB-INF/layouts";
      Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
      Search  : Search_Type;
      Ent     : Directory_Entry_Type;
   begin
      Put_Line ("add-page: Add a new web page to the application");
      Put_Line ("Usage: add-page NAME [LAYOUT]");
      New_Line;
      Put_Line ("  The web page is an XHTML file created under the 'web' directory.");
      Put_Line ("  The NAME can contain a directory that will be created if necessary.");
      Put_Line ("  The new web page can be configured to use the given layout.");
      Put_Line ("  The layout file must exist to be used.  The default layout is 'layout'.");
      Put_Line ("  You can create a new layout with 'add-layout' command.");
      Put_Line ("  You can also write your layout by adding an XHTML file in the directory:");
      Put_Line ("     " & Path);
      if Exists (Path) then
         New_Line;
         Put_Line ("  Available layouts:");

         Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name   : constant String := Simple_Name (Ent);
               Layout : constant String := Base_Name (Name);
            begin
               Put_Line ("      " & Layout);
            end;
         end loop;
      end if;
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/<name>.xhtml");
   end Help;

end Gen.Commands.Page;

-----------------------------------------------------------------------
--  gen-commands-page -- Page creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 2017, 2018 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Util.Strings;

package body Gen.Commands.Page is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      use Ada.Strings.Unbounded;

      function Get_Layout return String;
      function Get_Name return String;

      Dir    : constant String := Generator.Get_Result_Directory & "web/";

      function Get_Name return String is
         Name : constant String := Args.Get_Argument (1);
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      function Get_Layout return String is
      begin
         if Args.Get_Count = 1 then
            return "layout";
         end if;
         declare
            Layout : constant String := Args.Get_Argument (2);
         begin
            if Ada.Directories.Exists (Dir & "WEB-INF/layouts/" & Layout & ".xhtml") then
               return Layout;
            end if;

            Generator.Info ("Layout file {0} not found.", Layout);
            return Layout;
         end;
      end Get_Layout;

   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Cmd.Usage (Name);
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      Generator.Set_Global ("pageName", Get_Name);
      Generator.Set_Global ("layout", Get_Layout);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "page");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      use Ada.Directories;

      Path    : constant String := Generator.Get_Result_Directory & "web/WEB-INF/layouts";
      Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
      Search  : Search_Type;
      Ent     : Directory_Entry_Type;
   begin
      Put_Line ("add-page: Add a new web page to the application");
      Put_Line ("Usage: add-page NAME [LAYOUT]");
      New_Line;
      Put_Line ("  The web page is an XHTML file created under the 'web' directory.");
      Put_Line ("  The NAME can contain a directory that will be created if necessary.");
      Put_Line ("  The new web page can be configured to use the given layout.");
      Put_Line ("  The layout file must exist to be used.  The default layout is 'layout'.");
      Put_Line ("  You can create a new layout with 'add-layout' command.");
      Put_Line ("  You can also write your layout by adding an XHTML file in the directory:");
      Put_Line ("     " & Path);
      if Exists (Path) then
         New_Line;
         Put_Line ("  Available layouts:");

         Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name   : constant String := Simple_Name (Ent);
               Layout : constant String := Base_Name (Name);
            begin
               Put_Line ("      " & Layout);
            end;
         end loop;
      end if;
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/<name>.xhtml");
   end Help;

end Gen.Commands.Page;

Fix compilation warnings

Fix compilation warnings