-----------------------------------------------------------------------
--  AWA.Comments.Models -- AWA.Comments.Models
-----------------------------------------------------------------------
--  File generated by ada-gen DO NOT MODIFY
--  Template used: templates/model/package-spec.xhtml
--  Ada Generator: https://ada-gen.googlecode.com/svn/trunk Revision 1095
-----------------------------------------------------------------------
--  Copyright (C) 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.
-----------------------------------------------------------------------
pragma Warnings (Off);
with ADO.Sessions;
with ADO.Objects;
with ADO.Statements;
with ADO.SQL;
with ADO.Schemas;
with ADO.Queries;
with ADO.Queries.Loaders;
with Ada.Calendar;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded;
with Util.Beans.Objects;
with Util.Beans.Objects.Enums;
with Util.Beans.Basic.Lists;
with ADO.Audits;
with AWA.Users.Models;
with Util.Beans.Methods;
pragma Warnings (On);
package AWA.Comments.Models is

   pragma Style_Checks ("-mr");

   --  --------------------
   --  The format type defines the message format type.
   --  --------------------
   type Format_Type is (FORMAT_TEXT, FORMAT_WIKI, FORMAT_HTML);
   for Format_Type use (FORMAT_TEXT => 0, FORMAT_WIKI => 1, FORMAT_HTML => 2);
   package Format_Type_Objects is
      new Util.Beans.Objects.Enums (Format_Type);

   --  --------------------
   --  The status type defines whether the comment is visible or not.
   --  The comment can be put in the COMMENT_WAITING state so that
   --  it is not immediately visible. It must be put in the COMMENT_PUBLISHED
   --  state to be visible.
   --  --------------------
   type Status_Type is (COMMENT_PUBLISHED, COMMENT_WAITING, COMMENT_SPAM, COMMENT_BLOCKED, COMMENT_ARCHIVED);
   for Status_Type use (COMMENT_PUBLISHED => 0, COMMENT_WAITING => 1, COMMENT_SPAM => 2, COMMENT_BLOCKED => 3, COMMENT_ARCHIVED => 4);
   package Status_Type_Objects is
      new Util.Beans.Objects.Enums (Status_Type);

   type Comment_Ref is new ADO.Objects.Object_Ref with null record;

   --  --------------------
   --  The Comment table records a user comment associated with a database entity.
   --  The comment can be associated with any other database record.
   --  --------------------
   --  Create an object key for Comment.
   function Comment_Key (Id : in ADO.Identifier) return ADO.Objects.Object_Key;
   --  Create an object key for Comment from a string.
   --  Raises Constraint_Error if the string cannot be converted into the object key.
   function Comment_Key (Id : in String) return ADO.Objects.Object_Key;

   Null_Comment : constant Comment_Ref;
   function "=" (Left, Right : Comment_Ref'Class) return Boolean;

   --  Set the comment publication date
   procedure Set_Create_Date (Object : in out Comment_Ref;
                              Value  : in Ada.Calendar.Time);

   --  Get the comment publication date
   function Get_Create_Date (Object : in Comment_Ref)
                 return Ada.Calendar.Time;

   --  Set the comment message.
   procedure Set_Message (Object : in out Comment_Ref;
                          Value  : in Ada.Strings.Unbounded.Unbounded_String);
   procedure Set_Message (Object : in out Comment_Ref;
                          Value : in String);

   --  Get the comment message.
   function Get_Message (Object : in Comment_Ref)
                 return Ada.Strings.Unbounded.Unbounded_String;
   function Get_Message (Object : in Comment_Ref)
                 return String;

   --  Set the entity identifier to which this comment is associated
   procedure Set_Entity_Id (Object : in out Comment_Ref;
                            Value  : in ADO.Identifier);

   --  Get the entity identifier to which this comment is associated
   function Get_Entity_Id (Object : in Comment_Ref)
                 return ADO.Identifier;

   --  Set the comment identifier
   procedure Set_Id (Object : in out Comment_Ref;
                     Value  : in ADO.Identifier);

   --  Get the comment identifier
   function Get_Id (Object : in Comment_Ref)
                 return ADO.Identifier;
   --  Get the optimistic lock version.
   function Get_Version (Object : in Comment_Ref)
                 return Integer;

   --  Set the entity type that identifies the table to which the comment is associated.
   procedure Set_Entity_Type (Object : in out Comment_Ref;
                              Value  : in ADO.Entity_Type);

   --  Get the entity type that identifies the table to which the comment is associated.
   function Get_Entity_Type (Object : in Comment_Ref)
                 return ADO.Entity_Type;

   --  Set the comment status to decide whether the comment is visible (published) or not.
   procedure Set_Status (Object : in out Comment_Ref;
                         Value  : in AWA.Comments.Models.Status_Type);

   --  Get the comment status to decide whether the comment is visible (published) or not.
   function Get_Status (Object : in Comment_Ref)
                 return AWA.Comments.Models.Status_Type;

   --  Set the comment format type.
   procedure Set_Format (Object : in out Comment_Ref;
                         Value  : in AWA.Comments.Models.Format_Type);

   --  Get the comment format type.
   function Get_Format (Object : in Comment_Ref)
                 return AWA.Comments.Models.Format_Type;

   --
   procedure Set_Author (Object : in out Comment_Ref;
                         Value  : in AWA.Users.Models.User_Ref'Class);

   --
   function Get_Author (Object : in Comment_Ref)
                 return AWA.Users.Models.User_Ref'Class;

   --  Load the entity identified by 'Id'.
   --  Raises the NOT_FOUND exception if it does not exist.
   procedure Load (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier);

   --  Load the entity identified by 'Id'.
   --  Returns True in Found if the object was found and False if it does not exist.
   procedure Load (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier;
                   Found   : out Boolean);

   --  Find and load the entity.
   overriding
   procedure Find (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   --  Save the entity.  If the entity does not have an identifier, an identifier is allocated
   --  and it is inserted in the table.  Otherwise, only data fields which have been changed
   --  are updated.
   overriding
   procedure Save (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Master_Session'Class);

   --  Delete the entity.
   overriding
   procedure Delete (Object  : in out Comment_Ref;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   function Get_Value (From : in Comment_Ref;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Table definition
   COMMENT_TABLE : constant ADO.Schemas.Class_Mapping_Access;

   --  Internal method to allocate the Object_Record instance
   overriding
   procedure Allocate (Object : in out Comment_Ref);

   --  Copy of the object.
   procedure Copy (Object : in Comment_Ref;
                   Into   : in out Comment_Ref);

   --  --------------------
   --    The comment information.
   --  --------------------
   type Comment_Info is
     new Util.Beans.Basic.Bean with  record

      --  the comment identifier.
      Id : ADO.Identifier;

      --  the comment author's name.
      Author : Ada.Strings.Unbounded.Unbounded_String;

      --  the comment author's email.
      Email : Ada.Strings.Unbounded.Unbounded_String;

      --  the comment date.
      Date : Ada.Calendar.Time;

      --  the comment format type.
      Format : AWA.Comments.Models.Format_Type;

      --  the comment text.
      Comment : Ada.Strings.Unbounded.Unbounded_String;

      --  the comment status.
      Status : AWA.Comments.Models.Status_Type;
   end record;

   --  Get the bean attribute identified by the name.
   overriding
   function Get_Value (From : in Comment_Info;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the bean attribute identified by the name.
   overriding
   procedure Set_Value (Item  : in out Comment_Info;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   package Comment_Info_Beans is
      new Util.Beans.Basic.Lists (Element_Type => Comment_Info);
   package Comment_Info_Vectors renames Comment_Info_Beans.Vectors;
   subtype Comment_Info_List_Bean is Comment_Info_Beans.List_Bean;

   type Comment_Info_List_Bean_Access is access all Comment_Info_List_Bean;

   --  Run the query controlled by Context and append the list in Object.
   procedure List (Object  : in out Comment_Info_List_Bean'Class;
                   Session : in out ADO.Sessions.Session'Class;
                   Context : in out ADO.Queries.Context'Class);

   subtype Comment_Info_Vector is Comment_Info_Vectors.Vector;

   --  Run the query controlled by Context and append the list in Object.
   procedure List (Object  : in out Comment_Info_Vector;
                   Session : in out ADO.Sessions.Session'Class;
                   Context : in out ADO.Queries.Context'Class);

   Query_Comment_List : constant ADO.Queries.Query_Definition_Access;

   Query_All_Comment_List : constant ADO.Queries.Query_Definition_Access;

   type Comment_Bean is abstract new AWA.Comments.Models.Comment_Ref
     and Util.Beans.Basic.Bean and Util.Beans.Methods.Method_Bean with null record;

   --  This bean provides some methods that can be used in a Method_Expression.
   overriding
   function Get_Method_Bindings (From : in Comment_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Set the bean attribute identified by the name.
   overriding
   procedure Set_Value (Item  : in out Comment_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   procedure Create (Bean : in out Comment_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

   procedure Delete (Bean : in out Comment_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

   procedure Save (Bean : in out Comment_Bean;
                  Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

   procedure Publish (Bean : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

private
   COMMENT_NAME : aliased constant String := "awa_comment";
   COL_0_1_NAME : aliased constant String := "create_date";
   COL_1_1_NAME : aliased constant String := "message";
   COL_2_1_NAME : aliased constant String := "entity_id";
   COL_3_1_NAME : aliased constant String := "id";
   COL_4_1_NAME : aliased constant String := "version";
   COL_5_1_NAME : aliased constant String := "entity_type";
   COL_6_1_NAME : aliased constant String := "status";
   COL_7_1_NAME : aliased constant String := "format";
   COL_8_1_NAME : aliased constant String := "author_id";

   COMMENT_DEF : aliased constant ADO.Schemas.Class_Mapping :=
     (Count   => 9,
      Table   => COMMENT_NAME'Access,
      Members => (
         1 => COL_0_1_NAME'Access,
         2 => COL_1_1_NAME'Access,
         3 => COL_2_1_NAME'Access,
         4 => COL_3_1_NAME'Access,
         5 => COL_4_1_NAME'Access,
         6 => COL_5_1_NAME'Access,
         7 => COL_6_1_NAME'Access,
         8 => COL_7_1_NAME'Access,
         9 => COL_8_1_NAME'Access)
     );
   COMMENT_TABLE : constant ADO.Schemas.Class_Mapping_Access
      := COMMENT_DEF'Access;

   COMMENT_AUDIT_DEF : aliased constant ADO.Audits.Auditable_Mapping :=
     (Count    => 3,
      Of_Class => COMMENT_DEF'Access,
      Members  => (
         1 => 1,
         2 => 6,
         3 => 7)
     );
   COMMENT_AUDIT_TABLE : constant ADO.Audits.Auditable_Mapping_Access
      := COMMENT_AUDIT_DEF'Access;

   Null_Comment : constant Comment_Ref
      := Comment_Ref'(ADO.Objects.Object_Ref with null record);

   type Comment_Impl is
      new ADO.Audits.Auditable_Object_Record (Key_Type => ADO.Objects.KEY_INTEGER,
                                     Of_Class => COMMENT_DEF'Access,
                                     With_Audit => COMMENT_AUDIT_DEF'Access)
   with record
       Create_Date : Ada.Calendar.Time;
       Message : Ada.Strings.Unbounded.Unbounded_String;
       Entity_Id : ADO.Identifier;
       Version : Integer;
       Entity_Type : ADO.Entity_Type;
       Status : AWA.Comments.Models.Status_Type;
       Format : AWA.Comments.Models.Format_Type;
       Author : AWA.Users.Models.User_Ref;
   end record;

   type Comment_Access is access all Comment_Impl;

   overriding
   procedure Destroy (Object : access Comment_Impl);

   overriding
   procedure Find (Object  : in out Comment_Impl;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   overriding
   procedure Load (Object  : in out Comment_Impl;
                   Session : in out ADO.Sessions.Session'Class);
   procedure Load (Object  : in out Comment_Impl;
                   Stmt    : in out ADO.Statements.Query_Statement'Class;
                   Session : in out ADO.Sessions.Session'Class);

   overriding
   procedure Save (Object  : in out Comment_Impl;
                   Session : in out ADO.Sessions.Master_Session'Class);

   procedure Create (Object  : in out Comment_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   procedure Delete (Object  : in out Comment_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   procedure Set_Field (Object : in out Comment_Ref'Class;
                        Impl   : out Comment_Access);

   package File_1 is
      new ADO.Queries.Loaders.File (Path => "comment-queries.xml",
                                    Sha1 => "80302F51E2EC9855EFAFB43954D724A697C1F8E6");

   package Def_Commentinfo_Comment_List is
      new ADO.Queries.Loaders.Query (Name => "comment-list",
                                     File => File_1.File'Access);
   Query_Comment_List : constant ADO.Queries.Query_Definition_Access
   := Def_Commentinfo_Comment_List.Query'Access;

   package Def_Commentinfo_All_Comment_List is
      new ADO.Queries.Loaders.Query (Name => "all-comment-list",
                                     File => File_1.File'Access);
   Query_All_Comment_List : constant ADO.Queries.Query_Definition_Access
   := Def_Commentinfo_All_Comment_List.Query'Access;
end AWA.Comments.Models;

-----------------------------------------------------------------------
--  AWA.Comments.Models -- AWA.Comments.Models
-----------------------------------------------------------------------
--  File generated by ada-gen DO NOT MODIFY
--  Template used: templates/model/package-spec.xhtml
--  Ada Generator: https://ada-gen.googlecode.com/svn/trunk Revision 1095
-----------------------------------------------------------------------
--  Copyright (C) 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.
-----------------------------------------------------------------------
pragma Warnings (Off);
with ADO.Sessions;
with ADO.Objects;
with ADO.Statements;
with ADO.SQL;
with ADO.Schemas;
with ADO.Queries;
with ADO.Queries.Loaders;
with Ada.Calendar;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded;
with Util.Beans.Objects;
with Util.Beans.Objects.Enums;
with Util.Beans.Basic.Lists;
with ADO.Audits;
with AWA.Users.Models;
with Util.Beans.Methods;
pragma Warnings (On);
package AWA.Comments.Models is

   pragma Style_Checks ("-mr");

   --  --------------------
   --  The format type defines the message format type.
   --  --------------------
   type Format_Type is (FORMAT_TEXT, FORMAT_WIKI, FORMAT_HTML);
   for Format_Type use (FORMAT_TEXT => 0, FORMAT_WIKI => 1, FORMAT_HTML => 2);
   package Format_Type_Objects is
      new Util.Beans.Objects.Enums (Format_Type);

   type Nullable_Format_Type is record
      Is_Null : Boolean := True;
      Value   : Format_Type;
   end record;

   --  --------------------
   --  The status type defines whether the comment is visible or not.
   --  The comment can be put in the COMMENT_WAITING state so that
   --  it is not immediately visible. It must be put in the COMMENT_PUBLISHED
   --  state to be visible.
   --  --------------------
   type Status_Type is (COMMENT_PUBLISHED, COMMENT_WAITING, COMMENT_SPAM, COMMENT_BLOCKED, COMMENT_ARCHIVED);
   for Status_Type use (COMMENT_PUBLISHED => 0, COMMENT_WAITING => 1, COMMENT_SPAM => 2, COMMENT_BLOCKED => 3, COMMENT_ARCHIVED => 4);
   package Status_Type_Objects is
      new Util.Beans.Objects.Enums (Status_Type);

   type Nullable_Status_Type is record
      Is_Null : Boolean := True;
      Value   : Status_Type;
   end record;

   type Comment_Ref is new ADO.Objects.Object_Ref with null record;

   --  --------------------
   --  The Comment table records a user comment associated with a database entity.
   --  The comment can be associated with any other database record.
   --  --------------------
   --  Create an object key for Comment.
   function Comment_Key (Id : in ADO.Identifier) return ADO.Objects.Object_Key;
   --  Create an object key for Comment from a string.
   --  Raises Constraint_Error if the string cannot be converted into the object key.
   function Comment_Key (Id : in String) return ADO.Objects.Object_Key;

   Null_Comment : constant Comment_Ref;
   function "=" (Left, Right : Comment_Ref'Class) return Boolean;

   --  Set the comment publication date
   procedure Set_Create_Date (Object : in out Comment_Ref;
                              Value  : in Ada.Calendar.Time);

   --  Get the comment publication date
   function Get_Create_Date (Object : in Comment_Ref)
                 return Ada.Calendar.Time;

   --  Set the comment message.
   procedure Set_Message (Object : in out Comment_Ref;
                          Value  : in Ada.Strings.Unbounded.Unbounded_String);
   procedure Set_Message (Object : in out Comment_Ref;
                          Value : in String);

   --  Get the comment message.
   function Get_Message (Object : in Comment_Ref)
                 return Ada.Strings.Unbounded.Unbounded_String;
   function Get_Message (Object : in Comment_Ref)
                 return String;

   --  Set the entity identifier to which this comment is associated
   procedure Set_Entity_Id (Object : in out Comment_Ref;
                            Value  : in ADO.Identifier);

   --  Get the entity identifier to which this comment is associated
   function Get_Entity_Id (Object : in Comment_Ref)
                 return ADO.Identifier;

   --  Set the comment identifier
   procedure Set_Id (Object : in out Comment_Ref;
                     Value  : in ADO.Identifier);

   --  Get the comment identifier
   function Get_Id (Object : in Comment_Ref)
                 return ADO.Identifier;
   --  Get the optimistic lock version.
   function Get_Version (Object : in Comment_Ref)
                 return Integer;

   --  Set the entity type that identifies the table to which the comment is associated.
   procedure Set_Entity_Type (Object : in out Comment_Ref;
                              Value  : in ADO.Entity_Type);

   --  Get the entity type that identifies the table to which the comment is associated.
   function Get_Entity_Type (Object : in Comment_Ref)
                 return ADO.Entity_Type;

   --  Set the comment status to decide whether the comment is visible (published) or not.
   procedure Set_Status (Object : in out Comment_Ref;
                         Value  : in AWA.Comments.Models.Status_Type);

   --  Get the comment status to decide whether the comment is visible (published) or not.
   function Get_Status (Object : in Comment_Ref)
                 return AWA.Comments.Models.Status_Type;

   --  Set the comment format type.
   procedure Set_Format (Object : in out Comment_Ref;
                         Value  : in AWA.Comments.Models.Format_Type);

   --  Get the comment format type.
   function Get_Format (Object : in Comment_Ref)
                 return AWA.Comments.Models.Format_Type;

   --
   procedure Set_Author (Object : in out Comment_Ref;
                         Value  : in AWA.Users.Models.User_Ref'Class);

   --
   function Get_Author (Object : in Comment_Ref)
                 return AWA.Users.Models.User_Ref'Class;

   --  Load the entity identified by 'Id'.
   --  Raises the NOT_FOUND exception if it does not exist.
   procedure Load (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier);

   --  Load the entity identified by 'Id'.
   --  Returns True in Found if the object was found and False if it does not exist.
   procedure Load (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier;
                   Found   : out Boolean);

   --  Find and load the entity.
   overriding
   procedure Find (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   --  Save the entity.  If the entity does not have an identifier, an identifier is allocated
   --  and it is inserted in the table.  Otherwise, only data fields which have been changed
   --  are updated.
   overriding
   procedure Save (Object  : in out Comment_Ref;
                   Session : in out ADO.Sessions.Master_Session'Class);

   --  Delete the entity.
   overriding
   procedure Delete (Object  : in out Comment_Ref;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   function Get_Value (From : in Comment_Ref;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Table definition
   COMMENT_TABLE : constant ADO.Schemas.Class_Mapping_Access;

   --  Internal method to allocate the Object_Record instance
   overriding
   procedure Allocate (Object : in out Comment_Ref);

   --  Copy of the object.
   procedure Copy (Object : in Comment_Ref;
                   Into   : in out Comment_Ref);

   --  --------------------
   --    The comment information.
   --  --------------------
   type Comment_Info is
     new Util.Beans.Basic.Bean with  record

      --  the comment identifier.
      Id : ADO.Identifier;

      --  the comment author's name.
      Author : Ada.Strings.Unbounded.Unbounded_String;

      --  the comment author's email.
      Email : Ada.Strings.Unbounded.Unbounded_String;

      --  the comment date.
      Date : Ada.Calendar.Time;

      --  the comment format type.
      Format : AWA.Comments.Models.Format_Type;

      --  the comment text.
      Comment : Ada.Strings.Unbounded.Unbounded_String;

      --  the comment status.
      Status : AWA.Comments.Models.Status_Type;
   end record;

   --  Get the bean attribute identified by the name.
   overriding
   function Get_Value (From : in Comment_Info;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the bean attribute identified by the name.
   overriding
   procedure Set_Value (Item  : in out Comment_Info;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   package Comment_Info_Beans is
      new Util.Beans.Basic.Lists (Element_Type => Comment_Info);
   package Comment_Info_Vectors renames Comment_Info_Beans.Vectors;
   subtype Comment_Info_List_Bean is Comment_Info_Beans.List_Bean;

   type Comment_Info_List_Bean_Access is access all Comment_Info_List_Bean;

   --  Run the query controlled by Context and append the list in Object.
   procedure List (Object  : in out Comment_Info_List_Bean'Class;
                   Session : in out ADO.Sessions.Session'Class;
                   Context : in out ADO.Queries.Context'Class);

   subtype Comment_Info_Vector is Comment_Info_Vectors.Vector;

   --  Run the query controlled by Context and append the list in Object.
   procedure List (Object  : in out Comment_Info_Vector;
                   Session : in out ADO.Sessions.Session'Class;
                   Context : in out ADO.Queries.Context'Class);

   Query_Comment_List : constant ADO.Queries.Query_Definition_Access;

   Query_All_Comment_List : constant ADO.Queries.Query_Definition_Access;

   type Comment_Bean is abstract new AWA.Comments.Models.Comment_Ref
     and Util.Beans.Basic.Bean and Util.Beans.Methods.Method_Bean with null record;

   --  This bean provides some methods that can be used in a Method_Expression.
   overriding
   function Get_Method_Bindings (From : in Comment_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Set the bean attribute identified by the name.
   overriding
   procedure Set_Value (Item  : in out Comment_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   procedure Create (Bean : in out Comment_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

   procedure Delete (Bean : in out Comment_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

   procedure Save (Bean : in out Comment_Bean;
                  Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

   procedure Publish (Bean : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is abstract;

private
   COMMENT_NAME : aliased constant String := "awa_comment";
   COL_0_1_NAME : aliased constant String := "create_date";
   COL_1_1_NAME : aliased constant String := "message";
   COL_2_1_NAME : aliased constant String := "entity_id";
   COL_3_1_NAME : aliased constant String := "id";
   COL_4_1_NAME : aliased constant String := "version";
   COL_5_1_NAME : aliased constant String := "entity_type";
   COL_6_1_NAME : aliased constant String := "status";
   COL_7_1_NAME : aliased constant String := "format";
   COL_8_1_NAME : aliased constant String := "author_id";

   COMMENT_DEF : aliased constant ADO.Schemas.Class_Mapping :=
     (Count   => 9,
      Table   => COMMENT_NAME'Access,
      Members => (
         1 => COL_0_1_NAME'Access,
         2 => COL_1_1_NAME'Access,
         3 => COL_2_1_NAME'Access,
         4 => COL_3_1_NAME'Access,
         5 => COL_4_1_NAME'Access,
         6 => COL_5_1_NAME'Access,
         7 => COL_6_1_NAME'Access,
         8 => COL_7_1_NAME'Access,
         9 => COL_8_1_NAME'Access)
     );
   COMMENT_TABLE : constant ADO.Schemas.Class_Mapping_Access
      := COMMENT_DEF'Access;

   COMMENT_AUDIT_DEF : aliased constant ADO.Audits.Auditable_Mapping :=
     (Count    => 3,
      Of_Class => COMMENT_DEF'Access,
      Members  => (
         1 => 1,
         2 => 6,
         3 => 7)
     );
   COMMENT_AUDIT_TABLE : constant ADO.Audits.Auditable_Mapping_Access
      := COMMENT_AUDIT_DEF'Access;

   Null_Comment : constant Comment_Ref
      := Comment_Ref'(ADO.Objects.Object_Ref with null record);

   type Comment_Impl is
      new ADO.Audits.Auditable_Object_Record (Key_Type => ADO.Objects.KEY_INTEGER,
                                     Of_Class => COMMENT_DEF'Access,
                                     With_Audit => COMMENT_AUDIT_DEF'Access)
   with record
       Create_Date : Ada.Calendar.Time;
       Message : Ada.Strings.Unbounded.Unbounded_String;
       Entity_Id : ADO.Identifier;
       Version : Integer;
       Entity_Type : ADO.Entity_Type;
       Status : AWA.Comments.Models.Status_Type;
       Format : AWA.Comments.Models.Format_Type;
       Author : AWA.Users.Models.User_Ref;
   end record;

   type Comment_Access is access all Comment_Impl;

   overriding
   procedure Destroy (Object : access Comment_Impl);

   overriding
   procedure Find (Object  : in out Comment_Impl;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   overriding
   procedure Load (Object  : in out Comment_Impl;
                   Session : in out ADO.Sessions.Session'Class);
   procedure Load (Object  : in out Comment_Impl;
                   Stmt    : in out ADO.Statements.Query_Statement'Class;
                   Session : in out ADO.Sessions.Session'Class);

   overriding
   procedure Save (Object  : in out Comment_Impl;
                   Session : in out ADO.Sessions.Master_Session'Class);

   procedure Create (Object  : in out Comment_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   procedure Delete (Object  : in out Comment_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   procedure Set_Field (Object : in out Comment_Ref'Class;
                        Impl   : out Comment_Access);

   package File_1 is
      new ADO.Queries.Loaders.File (Path => "comment-queries.xml",
                                    Sha1 => "80302F51E2EC9855EFAFB43954D724A697C1F8E6");

   package Def_Commentinfo_Comment_List is
      new ADO.Queries.Loaders.Query (Name => "comment-list",
                                     File => File_1.File'Access);
   Query_Comment_List : constant ADO.Queries.Query_Definition_Access
   := Def_Commentinfo_Comment_List.Query'Access;

   package Def_Commentinfo_All_Comment_List is
      new ADO.Queries.Loaders.Query (Name => "all-comment-list",
                                     File => File_1.File'Access);
   Query_All_Comment_List : constant ADO.Queries.Query_Definition_Access
   := Def_Commentinfo_All_Comment_List.Query'Access;
end AWA.Comments.Models;

Rebuild the model files

Rebuild the model files


with Ada.Text_IO;
with PrimeUtilities;

package body Problem_70 is
   package IO renames Ada.Text_IO;
   subtype Ten_Million is Integer range 1 .. 9_999_999;
   package Ten_Million_Primes is new PrimeUtilities(Ten_Million);
   type Long_Sieve is Array (Positive range <>) of Long_Float;
   type Digit_Count is Array(Character range '0' .. '9') of Natural;
   Max_Double : constant := Long_Float(Ten_Million'Last);

   function Make_Long_Float_Sieve return Long_Sieve is
      old_sieve : constant Ten_Million_Primes.Sieve := Ten_Million_Primes.Generate_Sieve(Ten_Million'Last / 2);
      new_sieve : Long_Sieve(1 .. old_sieve'Last);
   begin
      for i in new_sieve'Range loop
         new_sieve(i) := Long_Float(old_sieve(i));
      end loop;
      return new_sieve;
   end Make_Long_Float_Sieve;

   procedure Solve is
      sieve : constant Long_Sieve := Make_Long_Float_Sieve;
      best : Ten_Million := 1;
      best_ratio : Long_Float := 0.0;
      function Convert(num : Long_Float) return Digit_Count is
         num_cnv : constant Ten_Million := Ten_Million(Long_Float'Rounding(num));
         str : constant String := Ten_Million'Image(num_cnv);
         counts : Digit_Count := (others => 0);
      begin
         for i in 2 .. str'Last loop
            counts(str(i)) := counts(str(i)) + 1;
         end loop;
         return counts;
      end Convert;
      procedure Check(num, ratio : Long_Float) is
         euler : constant Long_Float := num * ratio;
         num_c : constant Digit_Count := Convert(num);
         euler_c : constant Digit_Count := Convert(euler);
      begin
         for c in num_c'Range loop
            if num_c(c) /= euler_c(c) then
               return;
            end if;
         end loop;
         best := Ten_Million(Long_Float'Rounding(num));
         best_ratio := ratio;
      end Check;
      procedure Solve_Recursive(min_index : Positive; start_ratio : Long_Float; So_Far : Long_Float) is
         prime : Long_Float;
         total : Long_Float;
         ratio : Long_Float;
      begin
         for prime_index in min_index .. sieve'Last loop
            prime := sieve(prime_index);
            total := So_Far * prime;
            ratio := start_ratio * ((prime - 1.0) / prime);
            exit when total > Max_Double or ratio < 0.1;
            loop
               if ratio > best_ratio then
                  Check(total, ratio);
               end if;
               Solve_Recursive(prime_index + 1, ratio, total);
               total := total * prime;
               exit when total > Max_Double;
            end loop;
         end loop;
      end Solve_Recursive;
   begin
      Solve_Recursive(sieve'First, 1.0, 1.0);
      IO.Put_Line(Integer'Image(best));
   end Solve;

end Problem_70;

with Ada.Text_IO;
with PrimeUtilities;

package body Problem_70 is
   package IO renames Ada.Text_IO;
   subtype Ten_Million is Integer range 1 .. 9_999_999;
   package Ten_Million_Primes is new PrimeUtilities(Ten_Million);
   type Digit_Count is Array(Character range '0' .. '9') of Natural;
   procedure Solve is
      sieve : constant Ten_Million_Primes.Sieve := Ten_Million_Primes.Generate_Sieve(Ten_Million'Last / 2);
      best : Ten_Million := 1;
      best_ratio : Long_Float := 0.0;
      function Convert(num : Ten_Million) return Digit_Count is
         str : constant String := Ten_Million'Image(num);
         counts : Digit_Count := (others => 0);
      begin
         for i in 2 .. str'Last loop
            counts(str(i)) := counts(str(i)) + 1;
         end loop;
         return counts;
      end Convert;
      procedure Check(num, euler : Ten_Million; ratio : Long_Float) is
         num_c : constant Digit_Count := Convert(num);
         euler_c : constant Digit_Count := Convert(euler);
      begin
         for c in num_c'Range loop
            if num_c(c) /= euler_c(c) then
               return;
            end if;
         end loop;
         best := num;
         best_ratio := ratio;
      end Check;
      procedure Solve_Recursive(min_index : Positive; start_ratio : Long_Float; start_euler, so_far : Ten_Million) is
         prime : Ten_Million;
         total : Ten_Million;
         euler : Ten_Million;
         ratio : Long_Float;
      begin
         for prime_index in min_index .. sieve'Last loop
            prime := sieve(prime_index);
            exit when Ten_Million'Last / prime < so_far;
            total := so_far * prime;
            euler := start_euler * (prime - 1);
            ratio := start_ratio * (1.0 - 1.0 / Long_Float(prime));
            exit when ratio < 0.1;
            loop
               if ratio > best_ratio then
                  Check(total, euler, ratio);
               end if;
               Solve_Recursive(prime_index + 1, ratio, euler, total);
               exit when Ten_Million'Last / prime < total;
               total := total * prime;
               euler := euler * prime;
            end loop;
         end loop;
      end Solve_Recursive;
   begin
      Solve_Recursive(sieve'First, 1.0, 1, 1);
      IO.Put_Line(Integer'Image(best));
   end Solve;

end Problem_70;

Convert problem 70 to be all integer math.

I lose a fair chunk of time because I still stay within domains at all
times so I do a divide before I multiply instead of getting the
overflow if my numbers are large enough, but it still ends up ~50 ms
faster than the previous attempt and doesn't look as odd from using
doubles everywhere for integer math.


-----------------------------------------------------------------------
--  awa-mail-components -- Mail UI Components
--  Copyright (C) 2012, 2017 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 ASF.Components.Core;

with AWA.Mail.Clients;

--  == Components ==
--  The AWA.Mail.Components package defines several UI components that represent
--  a mail message in an ASF view.  The components allow the creation, formatting and
--  sending of a mail message using the same mechanism as the application presentation layer.
--  Example:
--
--    <f:view xmlns="mail:http://code.google.com/p/ada-awa/mail">
--      <mail:message>
--        <mail:subject>Welcome</mail:subject>
--        <mail:to name="Iorek Byrnison">Iorek.Byrnison@svalbard.com</mail:to>
--        <mail:body>
--            ...
--        </mail:body>
--      </mail:message>
--    </f:view>
--
--  When the view which contains these components is rendered, a mail message is built
--  and initialized by rendering the inner components.  The body and other components can use
--  other application UI components to render useful content.  The email is send after
--  the mail:message has finished to render its inner children.
--
--  The mail:subject component describes the mail subject.
--
--  The mail:to component define the mail recipient.  There can be several recepients.
--
--  The mail:body component contains the mail body.
package AWA.Mail.Components is

   type UIMailComponent is new ASF.Components.Core.UIComponentBase with private;

   --  Get the mail message instance.
   function Get_Message (UI      : in UIMailComponent) return AWA.Mail.Clients.Mail_Message_Access;

private

   type UIMailComponent is new ASF.Components.Core.UIComponentBase with null record;

end AWA.Mail.Components;

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

with ASF.Components.Core;

with AWA.Mail.Clients;

--  == Components ==
--  The `AWA.Mail.Components` package defines several UI components that represent
--  a mail message in an ASF view.  The components allow the creation, formatting
--  and sending of a mail message using the same mechanism as the application
--  presentation layer.  Example:
--
--    <f:view xmlns="mail:http://code.google.com/p/ada-awa/mail">
--      <mail:message>
--        <mail:subject>Welcome</mail:subject>
--        <mail:to name="Iorek Byrnison">Iorek.Byrnison@svalbard.com</mail:to>
--        <mail:body>
--            ...
--        </mail:body>
--        <mail:attachment value="/images/mail-image.jpg"
--           fileName="image.jpg"
--           contentType="image/jpg"/>
--      </mail:message>
--    </f:view>
--
--  When the view which contains these components is rendered, a mail message
--  is built and initialized by rendering the inner components.  The body and
--  other components can use other application UI components to render useful
--  content.  The email is send after the `mail:message` has finished to render
--  its inner children.
--
--  The `mail:subject` component describes the mail subject.
--
--  The `mail:to` component define the mail recipient.
--  There can be several recepients.
--
--  The `mail:body` component contains the mail body.
--
--  The `mail:attachment` component allows to include some attachment.
package AWA.Mail.Components is

   type UIMailComponent is new ASF.Components.Core.UIComponentBase with private;

   --  Get the mail message instance.
   function Get_Message (UI      : in UIMailComponent) return AWA.Mail.Clients.Mail_Message_Access;

private

   type UIMailComponent is new ASF.Components.Core.UIComponentBase with null record;

end AWA.Mail.Components;

Clarify the documentation to format a mail message


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

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

--  == Wiki Renderer ==
--  The <tt>Wiki_Renderer</tt> allows to render a wiki document into another wiki content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Wiki is

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine   : in out Wiki_Renderer;
                                Stream   : in Streams.Output_Stream_Access;
                                Format   : in Wiki_Syntax);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document;
                     Node   : in Nodes.Node_Type);

   --  Add a section header in the document.
   procedure Render_Header (Engine : in out Wiki_Renderer;
                            Header : in Wide_Wide_String;
                            Level  : in Positive);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Engine : in out Wiki_Renderer);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Engine : in out Wiki_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Engine : in out Wiki_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Render a link.
   procedure Render_Link (Engine : in out Wiki_Renderer;
                          Name     : in Strings.WString;
                          Attrs    : in Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine : in out Wiki_Renderer;
                           Link   : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Add a text block with the given format.
   procedure Render_Text (Engine : in out Wiki_Renderer;
                          Text   : in Wide_Wide_String;
                          Format : in Format_Map);

   --  Render a text block that is pre-formatted.
   procedure Render_Preformatted (Engine : in out Wiki_Renderer;
                                  Text   : in Strings.WString;
                                  Format : in Strings.WString);

   procedure Render_Tag (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document);

   --  Set the text style format.
   procedure Set_Format (Engine : in out Wiki_Renderer;
                         Format   : in Format_Map);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Quote_Start, Quote_End, Quote_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break, Escape_Rule,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Format_Type) of Wide_String_Access;

   --  Emit a new line.
   procedure New_Line (Engine : in out Wiki_Renderer);

   procedure Close_Paragraph (Engine : in out Wiki_Renderer);
   procedure Open_Paragraph (Engine : in out Wiki_Renderer);
   procedure Start_Keep_Content (Engine : in out Wiki_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Renderer with record
      Output              : Streams.Output_Stream_Access := null;
      Syntax              : Wiki_Syntax := SYNTAX_CREOLE;
      Format              : Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Escape_Set          : Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Set;
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Empty_Line          : Boolean := True;
      Keep_Content        : Boolean := False;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

end Wiki.Render.Wiki;

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

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

--  == Wiki Renderer ==
--  The <tt>Wiki_Renderer</tt> allows to render a wiki document into another wiki content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Wiki is

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine   : in out Wiki_Renderer;
                                Stream   : in Streams.Output_Stream_Access;
                                Format   : in Wiki_Syntax);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document;
                     Node   : in Nodes.Node_Type);

   --  Add a section header in the document.
   procedure Render_Header (Engine : in out Wiki_Renderer;
                            Header : in Wide_Wide_String;
                            Level  : in Positive);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Engine : in out Wiki_Renderer);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Engine : in out Wiki_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Engine : in out Wiki_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Render a link.
   procedure Render_Link (Engine : in out Wiki_Renderer;
                          Name     : in Strings.WString;
                          Attrs    : in Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine : in out Wiki_Renderer;
                           Link   : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Add a text block with the given format.
   procedure Render_Text (Engine : in out Wiki_Renderer;
                          Text   : in Wide_Wide_String;
                          Format : in Format_Map);

   --  Render a text block that is pre-formatted.
   procedure Render_Preformatted (Engine : in out Wiki_Renderer;
                                  Text   : in Strings.WString;
                                  Format : in Strings.WString);

   procedure Render_Tag (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Engine : in out Wiki_Renderer;
                     Doc    : in Documents.Document);

   --  Set the text style format.
   procedure Set_Format (Engine : in out Wiki_Renderer;
                         Format   : in Format_Map);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Quote_Start, Quote_End, Quote_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break, Escape_Rule,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Format_Type) of Wide_String_Access;

   --  Emit a new line.
   procedure New_Line (Engine : in out Wiki_Renderer);

   procedure Close_Paragraph (Engine : in out Wiki_Renderer);
   procedure Open_Paragraph (Engine : in out Wiki_Renderer);
   procedure Start_Keep_Content (Engine : in out Wiki_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Renderer with record
      Output              : Streams.Output_Stream_Access := null;
      Syntax              : Wiki_Syntax := SYNTAX_CREOLE;
      Format              : Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Escape_Set          : Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Set;
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Empty_Line          : Boolean := True;
      Keep_Content        : Boolean := False;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Link_First          : Boolean := False;
      Html_Blockquote     : Boolean := False;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

end Wiki.Render.Wiki;

Add Link_First and Html_Blockquote attributes in the renderer


-----------------------------------------------------------------------
--  druss-commands -- Commands available for Druss
--  Copyright (C) 2017 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.Strings;
with Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
with Druss.Commands.Wifi;
with Druss.Commands.Devices;
with Druss.Commands.Ping;
package body Druss.Commands is

   function Uptime_Image (Value : in Natural) return String;

   Help_Command    : aliased Druss.Commands.Drivers.Help_Command_Type;
   Bbox_Commands   : aliased Druss.Commands.Bboxes.Command_Type;
   Get_Commands    : aliased Druss.Commands.Get.Command_Type;
   Wifi_Commands   : aliased Druss.Commands.Wifi.Command_Type;
   Status_Commands : aliased Druss.Commands.Status.Command_Type;
   Device_Commands : aliased Druss.Commands.Devices.Command_Type;
   Ping_Commands   : aliased Druss.Commands.Ping.Command_Type;

   procedure Gateway_Command (Command   : in Drivers.Command_Type'Class;
                              Args      : in Util.Commands.Argument_List'Class;
                              Arg_Pos   : in Positive;
                              Process   : access procedure (Gateway : in out Gateways.Gateway_Type;
                                                            Param   : in String);
                              Context   : in out Context_Type) is
      pragma Unreferenced (Command);
   begin
      if Args.Get_Count < Arg_Pos then
         Context.Console.Notice (N_USAGE, "Missing argument for command");
         Druss.Commands.Driver.Usage (Args);
      end if;
      declare
         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type);

         Param  : constant String := Args.Get_Argument (Arg_Pos);
         Gw     : Druss.Gateways.Gateway_Ref;

         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type) is
         begin
            Process (Gateway, Param);
         end Operation;

      begin
         if Args.Get_Count = Arg_Pos then
            Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Operation'Access);
         else
            for I in Arg_Pos + 1 .. Args.Get_Count loop
               Gw := Druss.Gateways.Find_IP (Context.Gateways, Args.Get_Argument (I));
               if not Gw.Is_Null then
                  Operation (Gw.Value.all);
               end if;
            end loop;
         end if;
      end;
   end Gateway_Command;

   procedure Initialize is
   begin
      Driver.Set_Description ("Druss - The Bbox master controller");
      Driver.Set_Usage ("[-v] [-o file] [-c config] <command> [<args>]" & ASCII.LF &
                          "where:" & ASCII.LF &
                          "  -v         Verbose execution mode" & ASCII.LF &
                          "  -c config  Use the configuration file" &
                          " (instead of $HOME/.config/druss/druss.properties)" & ASCII.LF &
                          "  -o file    The output file to use");
      Driver.Add_Command ("help", Help_Command'Access);
      Driver.Add_Command ("bbox", Bbox_Commands'Access);
      Driver.Add_Command ("get", Get_Commands'Access);
      Driver.Add_Command ("wifi", Wifi_Commands'Access);
      Driver.Add_Command ("status", Status_Commands'Access);
      Driver.Add_Command ("devices", Device_Commands'Access);
      Driver.Add_Command ("ping", Ping_Commands'Access);
   end Initialize;

   --  ------------------------------
   --  Print the bbox API status.
   --  ------------------------------
   procedure Print_Status (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "2" then
         Console.Print_Field (Field, "OK");
      elsif Value = "-1" then
         Console.Print_Field (Field, "KO");
      elsif Value = "1" then
         Console.Print_Field (Field, "Starting");
      elsif Value = "0" then
         Console.Print_Field (Field, "Stopped");
      else
         Console.Print_Field (Field, "?");
      end if;
   end Print_Status;

   --  ------------------------------
   --  Print a ON/OFF status.
   --  ------------------------------
   procedure Print_On_Off (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "1" then
         Console.Print_Field (Field, "ON");
      elsif Value = "0" then
         Console.Print_Field (Field, "OFF");
      else
         Console.Print_Field (Field, "");
      end if;
   end Print_On_Off;

   function Uptime_Image (Value : in Natural) return String is
      D : constant Natural := Value / 86400;
      R : constant Natural := Value mod 86400;
      H : constant Natural := R / 3600;
      M : constant Natural := (R mod 3600) / 60;
      S : constant Natural := (R mod 3600) mod 60;
   begin
      if D > 0 then
         return Util.Strings.Image (D) & "d"
           & (if H > 0 then Natural'Image (H) & "h" else "")
           & (if M > 0 then Natural'Image (M) & "m" else "");
      elsif H > 0 then
         return Util.Strings.Image (H) & "h"
           & (if M > 0 then Natural'Image (M) & "m" else "");
      else
         return Util.Strings.Image (M) & "m"
           & Natural'Image (S) & "s";
      end if;
   end Uptime_Image;

   --  Print a uptime.
   procedure Print_Uptime (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      else
         Console.Print_Field (Field, Uptime_Image (Natural'Value (Value)));
      end if;

   exception
      when others =>
            Console.Print_Field (Field, Value);
   end Print_Uptime;

end Druss.Commands;

-----------------------------------------------------------------------
--  druss-commands -- Commands available for Druss
--  Copyright (C) 2017 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.Strings;
with Druss.Commands.Bboxes;
with Druss.Commands.Get;
with Druss.Commands.Status;
with Druss.Commands.Wifi;
with Druss.Commands.Devices;
with Druss.Commands.Ping;
package body Druss.Commands is

   function Uptime_Image (Value : in Natural) return String;

   Help_Command    : aliased Druss.Commands.Drivers.Help_Command_Type;
   Bbox_Commands   : aliased Druss.Commands.Bboxes.Command_Type;
   Get_Commands    : aliased Druss.Commands.Get.Command_Type;
   Wifi_Commands   : aliased Druss.Commands.Wifi.Command_Type;
   Status_Commands : aliased Druss.Commands.Status.Command_Type;
   Device_Commands : aliased Druss.Commands.Devices.Command_Type;
   Ping_Commands   : aliased Druss.Commands.Ping.Command_Type;

   procedure Gateway_Command (Command   : in Drivers.Command_Type'Class;
                              Args      : in Util.Commands.Argument_List'Class;
                              Arg_Pos   : in Positive;
                              Process   : access procedure (Gateway : in out Gateways.Gateway_Type;
                                                            Param   : in String);
                              Context   : in out Context_Type) is
      pragma Unreferenced (Command);
   begin
      if Args.Get_Count < Arg_Pos then
         Context.Console.Notice (N_USAGE, "Missing argument for command");
         Druss.Commands.Driver.Usage (Args);
      end if;
      declare
         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type);

         Param  : constant String := Args.Get_Argument (Arg_Pos);
         Gw     : Druss.Gateways.Gateway_Ref;

         procedure Operation (Gateway : in out Druss.Gateways.Gateway_Type) is
         begin
            Process (Gateway, Param);
         end Operation;

      begin
         if Args.Get_Count = Arg_Pos then
            Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Operation'Access);
         else
            for I in Arg_Pos + 1 .. Args.Get_Count loop
               Gw := Druss.Gateways.Find_IP (Context.Gateways, Args.Get_Argument (I));
               if not Gw.Is_Null then
                  Operation (Gw.Value.all);
               end if;
            end loop;
         end if;
      end;
   end Gateway_Command;

   procedure Initialize is
   begin
      Driver.Set_Description ("Druss - The Bbox master controller");
      Driver.Set_Usage ("[-v] [-o file] [-c config] <command> [<args>]" & ASCII.LF &
                          "where:" & ASCII.LF &
                          "  -v         Verbose execution mode" & ASCII.LF &
                          "  -c config  Use the configuration file" &
                          " (instead of $HOME/.config/druss/druss.properties)" & ASCII.LF &
                          "  -o file    The output file to use");
      Driver.Add_Command ("help", Help_Command'Access);
      Driver.Add_Command ("bbox", Bbox_Commands'Access);
      Driver.Add_Command ("get", Get_Commands'Access);
      Driver.Add_Command ("wifi", Wifi_Commands'Access);
      Driver.Add_Command ("status", Status_Commands'Access);
      Driver.Add_Command ("devices", Device_Commands'Access);
      Driver.Add_Command ("ping", Ping_Commands'Access);
   end Initialize;

   --  ------------------------------
   --  Print the bbox API status.
   --  ------------------------------
   procedure Print_Status (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "2" then
         Console.Print_Field (Field, "OK");
      elsif Value = "-1" then
         Console.Print_Field (Field, "KO");
      elsif Value = "1" then
         Console.Print_Field (Field, "Starting");
      elsif Value = "0" then
         Console.Print_Field (Field, "Stopped");
      else
         Console.Print_Field (Field, "?");
      end if;
   end Print_Status;

   --  ------------------------------
   --  Print a ON/OFF status.
   --  ------------------------------
   procedure Print_On_Off (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "1" then
         Console.Print_Field (Field, "ON");
      elsif Value = "0" then
         Console.Print_Field (Field, "OFF");
      else
         Console.Print_Field (Field, "");
      end if;
   end Print_On_Off;

   function Uptime_Image (Value : in Natural) return String is
      D : constant Natural := Value / 86400;
      R : constant Natural := Value mod 86400;
      H : constant Natural := R / 3600;
      M : constant Natural := (R mod 3600) / 60;
      S : constant Natural := (R mod 3600) mod 60;
   begin
      if D > 0 then
         return Util.Strings.Image (D) & "d"
           & (if H > 0 then Natural'Image (H) & "h" else "")
           & (if M > 0 then Natural'Image (M) & "m" else "");
      elsif H > 0 then
         return Util.Strings.Image (H) & "h"
           & (if M > 0 then Natural'Image (M) & "m" else "");
      else
         return Util.Strings.Image (M) & "m"
           & Natural'Image (S) & "s";
      end if;
   end Uptime_Image;

   --  ------------------------------
   --  Print a uptime.
   --  ------------------------------
   procedure Print_Uptime (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String) is
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      else
         Console.Print_Field (Field, Uptime_Image (Natural'Value (Value)));
      end if;

   exception
      when others =>
            Console.Print_Field (Field, Value);
   end Print_Uptime;

   --  ------------------------------
   --  Print a performance measure in us or ms.
   --  ------------------------------
   procedure Print_Perf (Console : in Consoles.Console_Access;
                         Field   : in Field_Type;
                         Value   : in String) is
      use Commands.Consoles;
   begin
      if Value = "" then
         Console.Print_Field (Field, Value);
      elsif Value'Length <= 3 then
         Console.Print_Field (Field, Value & " us", J_RIGHT);
      elsif Value'Length <= 6 then
         Console.Print_Field (Field, Value (Value'First .. Value'Last - 3) & "."
                              & Value (Value'Last - 2 .. Value'Last) & " ms", J_RIGHT);
      else
         Console.Print_Field (Field, Value (Value'First .. Value'Last - 6) & "."
                              & Value (Value'Last - 5 .. Value'Last - 3) & " s", J_RIGHT);
      end if;
   end Print_Perf;

end Druss.Commands;

Implement the Print_Perf procedure

Implement the Print_Perf procedure


with GL.Types;

with Orka.Logging;
with Orka.Resources.Locations.Directories;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Drawing;

with AWT.Windows;

package body Package_Test is

   use all type Orka.Logging.Source;
   use all type Orka.Logging.Severity;
   use Orka.Logging;

   procedure Log is new Orka.Logging.Generic_Log (Window_System);

   overriding
   function On_Close (Object : Test_Window) return Boolean is
   begin
      Log (Debug, "User is trying to close window");
      return True;
   end On_Close;

   overriding
   procedure On_Drag
     (Object : in out Test_Window;
      X, Y   : AWT.Inputs.Fixed)
   is
      use all type AWT.Inputs.Action_Kind;
      use type AWT.Inputs.Fixed;
   begin
      Log (Debug, "User dragged something to " &
        "(" & Trim (X'Image) & ", " & Trim (Y'Image) & ")");
      AWT.Drag_And_Drop.Set_Action (if X < 300.0 and Y < 300.0 then Copy else None);
   end On_Drag;

   overriding
   procedure On_Drop
     (Object : in out Test_Window)
   is
      use all type AWT.Inputs.Action_Kind;

      Action : constant AWT.Inputs.Action_Kind := AWT.Drag_And_Drop.Valid_Action;
   begin
      Log (Info, "User dropped something. Action is " & Action'Image);

      if Action /= None then
         Object.Drag_And_Drop_Signal.Set;
      end if;
   end On_Drop;

   procedure Initialize_Framebuffer (Object : in out Test_Window) is
      Alpha : constant Orka.Float_32 := (if Object.State.Transparent then 0.5 else 1.0);
   begin
      Object.FB :=
        Orka.Rendering.Framebuffers.Create_Default_Framebuffer (Object.Width, Object.Height);
      Object.FB.Set_Default_Values ((Color => (0.0, 0.0, 0.0, Alpha), others => <>));
      Object.FB.Use_Framebuffer;
      Log (Debug, "Changed size of framebuffer to " &
        Trim (Object.Width'Image) & " × " & Trim (Object.Height'Image));
   end Initialize_Framebuffer;

   procedure Post_Initialize (Object : in out Test_Window) is
      Location_Shaders : constant Orka.Resources.Locations.Location_Ptr :=
        Orka.Resources.Locations.Directories.Create_Location ("data");
   begin
      Object.Initialize_Framebuffer;

      Object.Program  := Orka.Rendering.Programs.Create_Program
        (Orka.Rendering.Programs.Modules.Create_Module
           (Location_Shaders,
            VS => "cursor.vert",
            FS => "cursor.frag"));
      Object.Program.Use_Program;

      Object.Cursor := Object.Program.Uniform ("cursor");
   end Post_Initialize;

   procedure Render (Object : in out Test_Window) is
      use type Orka.Float_32;
      use AWT.Inputs;

      Window_State  : constant AWT.Windows.Window_State := Object.State;
      Pointer_State : constant AWT.Inputs.Pointer_State := Object.State;

      subtype Float_32 is Orka.Float_32;

      Width  : constant Float_32 := Float_32 (Window_State.Width + 2 * Window_State.Margin);
      Height : constant Float_32 := Float_32 (Window_State.Height + 2 * Window_State.Margin);

      PX : constant Float_32 := Float_32 (Pointer_State.Position (X));
      PY : constant Float_32 := Float_32 (Pointer_State.Position (Y));

      Horizontal : constant Float_32 := PX / Width * 2.0 - 1.0;
      Vertical   : constant Float_32 := PY / Height * 2.0 - 1.0;
   begin
      if Object.Framebuffer_Resized then
         Object.Initialize_Framebuffer;
      end if;

      Object.FB.Clear ((Color => True, others => False));

      Object.Cursor.Set_Vector (Orka.Float_32_Array'(Horizontal, Vertical));
      Orka.Rendering.Drawing.Draw (GL.Types.Points, 0, 1);

      Object.Swap_Buffers;
   end Render;

   overriding
   function Create_Window
     (Context            : aliased Orka.Contexts.Surface_Context'Class;
      Width, Height      : Positive;
      Title              : String  := "";
      Samples            : Natural := 0;
      Visible, Resizable : Boolean := True;
      Transparent        : Boolean := False) return Test_Window is
   begin
      return Result : constant Test_Window :=
        (Orka.Contexts.AWT.Create_Window
          (Context, Width, Height, Title, Samples,
           Visible     => Visible,
           Resizable   => Resizable,
           Transparent => Transparent) with others => <>);
   end Create_Window;

end Package_Test;

with GL.Types;

with Orka.Logging.Default;
with Orka.Resources.Locations.Directories;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Drawing;

with AWT.Windows;

package body Package_Test is

   use all type Orka.Logging.Default_Module;
   use all type Orka.Logging.Severity;
   use Orka.Logging;

   procedure Log is new Orka.Logging.Default.Generic_Log (Window_System);

   overriding
   function On_Close (Object : Test_Window) return Boolean is
   begin
      Log (Debug, "User is trying to close window");
      return True;
   end On_Close;

   overriding
   procedure On_Drag
     (Object : in out Test_Window;
      X, Y   : AWT.Inputs.Fixed)
   is
      use all type AWT.Inputs.Action_Kind;
      use type AWT.Inputs.Fixed;
   begin
      Log (Debug, "User dragged something to " &
        "(" & Trim (X'Image) & ", " & Trim (Y'Image) & ")");
      AWT.Drag_And_Drop.Set_Action (if X < 300.0 and Y < 300.0 then Copy else None);
   end On_Drag;

   overriding
   procedure On_Drop
     (Object : in out Test_Window)
   is
      use all type AWT.Inputs.Action_Kind;

      Action : constant AWT.Inputs.Action_Kind := AWT.Drag_And_Drop.Valid_Action;
   begin
      Log (Info, "User dropped something. Action is " & Action'Image);

      if Action /= None then
         Object.Drag_And_Drop_Signal.Set;
      end if;
   end On_Drop;

   procedure Initialize_Framebuffer (Object : in out Test_Window) is
      Alpha : constant Orka.Float_32 := (if Object.State.Transparent then 0.5 else 1.0);
   begin
      Object.FB :=
        Orka.Rendering.Framebuffers.Create_Default_Framebuffer (Object.Width, Object.Height);
      Object.FB.Set_Default_Values ((Color => (0.0, 0.0, 0.0, Alpha), others => <>));
      Object.FB.Use_Framebuffer;
      Log (Debug, "Changed size of framebuffer to " &
        Trim (Object.Width'Image) & " × " & Trim (Object.Height'Image));
   end Initialize_Framebuffer;

   procedure Post_Initialize (Object : in out Test_Window) is
      Location_Shaders : constant Orka.Resources.Locations.Location_Ptr :=
        Orka.Resources.Locations.Directories.Create_Location ("data");
   begin
      Object.Initialize_Framebuffer;

      Object.Program  := Orka.Rendering.Programs.Create_Program
        (Orka.Rendering.Programs.Modules.Create_Module
           (Location_Shaders,
            VS => "cursor.vert",
            FS => "cursor.frag"));
      Object.Program.Use_Program;

      Object.Cursor := Object.Program.Uniform ("cursor");
   end Post_Initialize;

   procedure Render (Object : in out Test_Window) is
      use type Orka.Float_32;
      use AWT.Inputs;

      Window_State  : constant AWT.Windows.Window_State := Object.State;
      Pointer_State : constant AWT.Inputs.Pointer_State := Object.State;

      subtype Float_32 is Orka.Float_32;

      Width  : constant Float_32 := Float_32 (Window_State.Width + 2 * Window_State.Margin);
      Height : constant Float_32 := Float_32 (Window_State.Height + 2 * Window_State.Margin);

      PX : constant Float_32 := Float_32 (Pointer_State.Position (X));
      PY : constant Float_32 := Float_32 (Pointer_State.Position (Y));

      Horizontal : constant Float_32 := PX / Width * 2.0 - 1.0;
      Vertical   : constant Float_32 := PY / Height * 2.0 - 1.0;
   begin
      if Object.Framebuffer_Resized then
         Object.Initialize_Framebuffer;
      end if;

      Object.FB.Clear ((Color => True, others => False));

      Object.Cursor.Set_Vector (Orka.Float_32_Array'(Horizontal, Vertical));
      Orka.Rendering.Drawing.Draw (GL.Types.Points, 0, 1);

      Object.Swap_Buffers;
   end Render;

   overriding
   function Create_Window
     (Context            : aliased Orka.Contexts.Surface_Context'Class;
      Width, Height      : Positive;
      Title              : String  := "";
      Samples            : Natural := 0;
      Visible, Resizable : Boolean := True;
      Transparent        : Boolean := False) return Test_Window is
   begin
      return Result : constant Test_Window :=
        (Orka.Contexts.AWT.Create_Window
          (Context, Width, Height, Title, Samples,
           Visible     => Visible,
           Resizable   => Resizable,
           Transparent => Transparent) with others => <>);
   end Create_Window;

end Package_Test;

awt: Fix compile error in example due to changed API of Orka.Logging

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


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

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies (yellow).  The framework defines a simple role based security policy and an URL
--  security policy intended to provide security in web applications.  The security policy manager
--  reads some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth.
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance (blue).  Additional security policy context can be added depending
--  on the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--
--  == Principal ==
--  A principal is created by using either the [Security_OpenID OpenID],
--  the [Security_OAuth OAuth] or another authentication mechanism.  The authentication produces
--  an object that must implement the <tt>Principal</tt> interface.  For example:
--
--    P : Security.OpenID.Principal_Access := Security.OpenID.Create_Principal (Auth);
--
--  or
--
--    P : Security.OAuth.Clients.Access_Token_Access := Security.OAuth.Clients.Create_Access_Token
--
--  The principal is then stored in a security context.
--
--  @include security-contexts.ads
--
--  [Security_Policies Security Policies]
--  [Security_OpenID OpenID]
--  [Security_OAuth OAuth]
--
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

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

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies (yellow).  The framework defines a simple role based security policy and an URL
--  security policy intended to provide security in web applications.  The security policy manager
--  reads some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth.
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance (blue).  Additional security policy context can be added depending
--  on the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--
--  == Principal ==
--  A principal is created by using either the [Security_Auth OpenID],
--  the [Security_OAuth OAuth] or another authentication mechanism.  The authentication produces
--  an object that must implement the <tt>Principal</tt> interface.  For example:
--
--    P : Security.Auth.Principal_Access := Security.Auth.Create_Principal (Auth);
--
--  or
--
--    P : Security.OAuth.Clients.Access_Token_Access := Security.OAuth.Clients.Create_Access_Token
--
--  The principal is then stored in a security context.
--
--  @include security-contexts.ads
--
--  [Security_Policies Security Policies]
--  [Security_Auth OpenID]
--  [Security_OAuth OAuth]
--
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  babel-Streams -- Stream management
--  Copyright (C) 2014, 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 Ada.Finalization;
with Babel.Files.Buffers;
package Babel.Streams is

   type Stream_Type is abstract tagged limited private;
   type Stream_Access is access all Stream_Type'Class;

   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access) is abstract;

   --  Write the buffer in the data stream.
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access) is abstract;

   --  Flush the data stream.
   procedure Flush (Stream : in out Stream_Type) is null;

   --  Close the data stream.
   procedure Close (Stream : in out Stream_Type) is null;

   --  Prepare to read again the data stream from the beginning.
   procedure Rewind (Stream : in out Stream_Type) is null;

private

   type Stream_Type is abstract limited new Ada.Finalization.Limited_Controlled with null record;

end Babel.Streams;

-----------------------------------------------------------------------
--  babel-Streams -- Stream management
--  Copyright (C) 2014, 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 Ada.Finalization;
with Babel.Files.Buffers;
package Babel.Streams is

   type Stream_Type is abstract tagged limited private;
   type Stream_Access is access all Stream_Type'Class;

   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access) is abstract;

   --  Write the buffer in the data stream.
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access) is abstract;

   --  Flush the data stream.
   procedure Flush (Stream : in out Stream_Type) is null;

   --  Close the data stream.
   procedure Close (Stream : in out Stream_Type) is null;

   --  Prepare to read again the data stream from the beginning.
   procedure Rewind (Stream : in out Stream_Type) is null;

   --  Set the internal buffer that the stream can use.
   procedure Set_Buffer (Stream : in out Stream_Type;
                         Buffer : in Babel.Files.Buffers.Buffer_Access) is null;

private

   type Stream_Type is abstract limited new Ada.Finalization.Limited_Controlled with null record;

end Babel.Streams;

Declare the Set_Buffer procedure

Declare the Set_Buffer procedure