-----------------------------------------------------------------------
--  encrypt -- Encrypt file using Util.Streams.AES
--  Copyright (C) 2019, 2021 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Streams.Stream_IO;
with Util.Streams.Files;
with Util.Streams.AES;
with Util.Encoders.AES;
with Util.Encoders.KDF.PBKDF2_HMAC_SHA256;
procedure Encrypt is

   use Util.Encoders.KDF;

   procedure Crypt_File (Source      : in String;
                         Destination : in String;
                         Password    : in String);

   procedure Crypt_File (Source      : in String;
                         Destination : in String;
                         Password    : in String) is
      In_Stream    : aliased Util.Streams.Files.File_Stream;
      Out_Stream   : aliased Util.Streams.Files.File_Stream;
      Cipher       : aliased Util.Streams.AES.Encoding_Stream;
      Password_Key : constant Util.Encoders.Secret_Key := Util.Encoders.Create (Password);
      Salt         : constant Util.Encoders.Secret_Key := Util.Encoders.Create ("fake-salt");
      Key          : Util.Encoders.Secret_Key (Length => Util.Encoders.AES.AES_256_Length);
   begin
      --  Generate a derived key from the password.
      PBKDF2_HMAC_SHA256 (Password => Password_Key,
                          Salt     => Salt,
                          Counter  => 20000,
                          Result   => Key);

      --  Setup file -> input and cipher -> output file streams.
      In_Stream.Open (Ada.Streams.Stream_IO.In_File, Source);
      Out_Stream.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Destination);
      Cipher.Produces (Output => Out_Stream'Access, Size   => 32768);
      Cipher.Set_Key (Secret => Key, Mode => Util.Encoders.AES.ECB);

      --  Copy input to output through the cipher.
      Util.Streams.Copy (From => In_Stream, Into => Cipher);
   end Crypt_File;

begin
   if Ada.Command_Line.Argument_Count /= 3 then
      Ada.Text_IO.Put_Line ("Usage: encrypt source password destination");
      return;
   end if;

   Crypt_File (Source      => Ada.Command_Line.Argument (1),
               Destination => Ada.Command_Line.Argument (3),
               Password    => Ada.Command_Line.Argument (2));
end Encrypt;

-----------------------------------------------------------------------
--  encrypt -- Encrypt file using Util.Streams.AES
--  Copyright (C) 2019, 2021, 2022 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.Text_IO;
with Ada.Command_Line;
with Ada.Streams.Stream_IO;
with Util.Streams.Files;
with Util.Streams.AES;
with Util.Encoders.AES;
with Util.Encoders.KDF.PBKDF2_HMAC_SHA256;
procedure Encrypt is

   use Util.Encoders.KDF;

   procedure Crypt_File (Source      : in String;
                         Destination : in String;
                         Password    : in String);

   procedure Crypt_File (Source      : in String;
                         Destination : in String;
                         Password    : in String) is
      In_Stream    : aliased Util.Streams.Files.File_Stream;
      Out_Stream   : aliased Util.Streams.Files.File_Stream;
      Cipher       : aliased Util.Streams.AES.Encoding_Stream;
      Password_Key : constant Util.Encoders.Secret_Key := Util.Encoders.Create (Password);
      Salt         : constant Util.Encoders.Secret_Key := Util.Encoders.Create ("fake-salt");
      Key          : Util.Encoders.Secret_Key (Length => Util.Encoders.AES.AES_256_Length);
   begin
      --  Generate a derived key from the password.
      PBKDF2_HMAC_SHA256 (Password => Password_Key,
                          Salt     => Salt,
                          Counter  => 20000,
                          Result   => Key);

      --  Setup file -> input and cipher -> output file streams.
      In_Stream.Open (Ada.Streams.Stream_IO.In_File, Source);
      Out_Stream.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Destination);
      Cipher.Produces (Output => Out_Stream'Unchecked_Access, Size   => 32768);
      Cipher.Set_Key (Secret => Key, Mode => Util.Encoders.AES.ECB);

      --  Copy input to output through the cipher.
      Util.Streams.Copy (From => In_Stream, Into => Cipher);
   end Crypt_File;

begin
   if Ada.Command_Line.Argument_Count /= 3 then
      Ada.Text_IO.Put_Line ("Usage: encrypt source password destination");
      return;
   end if;

   Crypt_File (Source      => Ada.Command_Line.Argument (1),
               Destination => Ada.Command_Line.Argument (3),
               Password    => Ada.Command_Line.Argument (2));
end Encrypt;

Fix the example

Fix the example


-----------------------------------------------------------------------
--  util-beans-objects-readers -- Datasets
--  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.
-----------------------------------------------------------------------
package body Util.Beans.Objects.Readers is

   use type Maps.Map_Bean_Access;
   use type Vectors.Vector_Bean_Access;

   --  Start a document.
   overriding
   procedure Start_Document (Handler : in out Reader) is
   begin
      Object_Stack.Clear (Handler.Context);
      Object_Stack.Push (Handler.Context);
      Object_Stack.Current (Handler.Context).Map := new Maps.Map_Bean;
   end Start_Document;

   --  -----------------------
   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  <b>Set_Member</b> procedure will associate the name/value pair on the
   --  new object.
   --  -----------------------
   overriding
   procedure Start_Object (Handler : in out Reader;
                           Name    : in String;
                           Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Logger);
      Current : constant Object_Context_Access := Object_Stack.Current (Handler.Context);
      Next    : Object_Context_Access;
   begin
      Object_Stack.Push (Handler.Context);
      Next := Object_Stack.Current (Handler.Context);
      Next.Map := new Maps.Map_Bean;
      if Current.Map /= null then
         Current.Map.Include (Name, To_Object (Next.List, DYNAMIC));
      else
         Current.List.Append (To_Object (Next.List, DYNAMIC));
      end if;
   end Start_Object;

   --  -----------------------
   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   --  -----------------------
   overriding
   procedure Finish_Object (Handler : in out Reader;
                            Name    : in String;
                            Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Name, Logger);
   begin
      Object_Stack.Pop (Handler.Context);
   end Finish_Object;

   overriding
   procedure Start_Array (Handler : in out Reader;
                          Name    : in String;
                          Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Logger);
      Current : constant Object_Context_Access := Object_Stack.Current (Handler.Context);
      Next    : Object_Context_Access;
   begin
      Object_Stack.Push (Handler.Context);
      Next := Object_Stack.Current (Handler.Context);
      Next.List := new Vectors.Vector_Bean;
      if Current.Map /= null then
         Current.Map.Include (Name, To_Object (Next.List, DYNAMIC));
      else
         Current.List.Append (To_Object (Next.List, DYNAMIC));
      end if;
   end Start_Array;

   overriding
   procedure Finish_Array (Handler : in out Reader;
                           Name    : in String;
                           Count   : in Natural;
                           Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Name, Count, Logger);
   begin
      Object_Stack.Pop (Handler.Context);
   end Finish_Array;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   overriding
   procedure Set_Member (Handler   : in out Reader;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Logger    : in out Util.Log.Logging'Class;
                         Attribute : in Boolean := False) is
      pragma Unreferenced (Logger, Attribute);
      Current : constant Object_Context_Access := Object_Stack.Current (Handler.Context);
   begin
      if Current.Map /= null then
         Current.Map.Set_Value (Name, Value);
      else
         Current.List.Append (Value);
      end if;
   end Set_Member;

end Util.Beans.Objects.Readers;

-----------------------------------------------------------------------
--  util-beans-objects-readers -- Datasets
--  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.
-----------------------------------------------------------------------
package body Util.Beans.Objects.Readers is

   use type Maps.Map_Bean_Access;
   use type Vectors.Vector_Bean_Access;

   --  Start a document.
   overriding
   procedure Start_Document (Handler : in out Reader) is
   begin
      Object_Stack.Clear (Handler.Context);
      Object_Stack.Push (Handler.Context);
      Object_Stack.Current (Handler.Context).Map := new Maps.Map_Bean;
      Handler.Root := To_Object (Object_Stack.Current (Handler.Context).Map, DYNAMIC);
   end Start_Document;

   --  -----------------------
   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  <b>Set_Member</b> procedure will associate the name/value pair on the
   --  new object.
   --  -----------------------
   overriding
   procedure Start_Object (Handler : in out Reader;
                           Name    : in String;
                           Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Logger);
      Current : constant Object_Context_Access := Object_Stack.Current (Handler.Context);
      Next    : Object_Context_Access;
   begin
      Object_Stack.Push (Handler.Context);
      Next := Object_Stack.Current (Handler.Context);
      Next.Map := new Maps.Map_Bean;
      if Current.Map /= null then
         Current.Map.Include (Name, To_Object (Next.Map, DYNAMIC));
      else
         Current.List.Append (To_Object (Next.Map, DYNAMIC));
      end if;
   end Start_Object;

   --  -----------------------
   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   --  -----------------------
   overriding
   procedure Finish_Object (Handler : in out Reader;
                            Name    : in String;
                            Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Name, Logger);
   begin
      Object_Stack.Pop (Handler.Context);
   end Finish_Object;

   overriding
   procedure Start_Array (Handler : in out Reader;
                          Name    : in String;
                          Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Logger);
      Current : constant Object_Context_Access := Object_Stack.Current (Handler.Context);
      Next    : Object_Context_Access;
   begin
      Object_Stack.Push (Handler.Context);
      Next := Object_Stack.Current (Handler.Context);
      Next.List := new Vectors.Vector_Bean;
      if Current.Map /= null then
         Current.Map.Include (Name, To_Object (Next.List, DYNAMIC));
      else
         Current.List.Append (To_Object (Next.List, DYNAMIC));
      end if;
   end Start_Array;

   overriding
   procedure Finish_Array (Handler : in out Reader;
                           Name    : in String;
                           Count   : in Natural;
                           Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Name, Count, Logger);
   begin
      Object_Stack.Pop (Handler.Context);
   end Finish_Array;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   overriding
   procedure Set_Member (Handler   : in out Reader;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Logger    : in out Util.Log.Logging'Class;
                         Attribute : in Boolean := False) is
      pragma Unreferenced (Logger, Attribute);
      Current : constant Object_Context_Access := Object_Stack.Current (Handler.Context);
   begin
      if Current.Map /= null then
         Current.Map.Set_Value (Name, Value);
      else
         Current.List.Append (Value);
      end if;
   end Set_Member;

   --  -----------------------
   --  Get the root object.
   --  -----------------------
   function Get_Root (Handler : in Reader) return Object is
   begin
      return Handler.Root;
   end Get_Root;

end Util.Beans.Objects.Readers;

Implement the Get_Root function Setup the Root object when the document is created Fix creation of objects


--  Copyright (c) 2015 onox <denkpadje@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.Numerics.Generic_Elementary_Functions;

package body GL.Transforms is

   package Elementary_Functions is new Ada.Numerics.Generic_Elementary_Functions (Single);

   function To_Radians (Angle : Single) return Single is
   begin
      return Angle * Ada.Numerics.Pi / 180.0;
   end To_Radians;

   procedure Translate (Matrix : in out Matrix4; Offset : Vector3) is
   begin
      Matrix (W, X) := Matrix (X, X) * Offset (X) + Matrix (Y, X) * Offset (Y) + Matrix (Z, X) * Offset (Z) + Matrix (W, X);
      Matrix (W, Y) := Matrix (X, Y) * Offset (X) + Matrix (Y, Y) * Offset (Y) + Matrix (Z, Y) * Offset (Z) + Matrix (W, Y);
      Matrix (W, Z) := Matrix (X, Z) * Offset (X) + Matrix (Y, Z) * Offset (Y) + Matrix (Z, Z) * Offset (Z) + Matrix (W, Z);
      Matrix (W, W) := Matrix (X, W) * Offset (X) + Matrix (Y, W) * Offset (Y) + Matrix (Z, W) * Offset (Z) + Matrix (W, W);
   end Translate;

   procedure Rotate_X (Matrix : in out Matrix4; Angle : Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (Y, X) := CA * Matrix (Y, X) + SA * Matrix (Z, X);
      Result_Matrix (Y, Y) := CA * Matrix (Y, Y) + SA * Matrix (Z, Y);
      Result_Matrix (Y, Z) := CA * Matrix (Y, Z) + SA * Matrix (Z, Z);
      Result_Matrix (Y, W) := CA * Matrix (Y, W) + SA * Matrix (Z, W);

      Result_Matrix (Z, X) := -SA * Matrix (Y, X) + CA * Matrix (Z, X);
      Result_Matrix (Z, Y) := -SA * Matrix (Y, Y) + CA * Matrix (Z, Y);
      Result_Matrix (Z, Z) := -SA * Matrix (Y, Z) + CA * Matrix (Z, Z);
      Result_Matrix (Z, W) := -SA * Matrix (Y, W) + CA * Matrix (Z, W);

      Matrix := Result_Matrix;
   end Rotate_X;

   procedure Rotate_Y (Matrix : in out Matrix4; Angle : Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (X, X) := CA * Matrix (X, X) - SA * Matrix (Z, X);
      Result_Matrix (X, Y) := CA * Matrix (X, Y) - SA * Matrix (Z, Y);
      Result_Matrix (X, Z) := CA * Matrix (X, Z) - SA * Matrix (Z, Z);
      Result_Matrix (X, W) := CA * Matrix (X, W) - SA * Matrix (Z, W);

      Result_Matrix (Z, X) := SA * Matrix (X, X) + CA * Matrix (Z, X);
      Result_Matrix (Z, Y) := SA * Matrix (X, Y) + CA * Matrix (Z, Y);
      Result_Matrix (Z, Z) := SA * Matrix (X, Z) + CA * Matrix (Z, Z);
      Result_Matrix (Z, W) := SA * Matrix (X, W) + CA * Matrix (Z, W);

      Matrix := Result_Matrix;
   end Rotate_Y;

   procedure Rotate_Z (Matrix : in out Matrix4; Angle : Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (X, X) := CA * Matrix (X, X) + SA * Matrix (Y, X);
      Result_Matrix (X, Y) := CA * Matrix (X, Y) + SA * Matrix (Y, Y);
      Result_Matrix (X, Z) := CA * Matrix (X, Z) + SA * Matrix (Y, Z);
      Result_Matrix (X, W) := CA * Matrix (X, W) + SA * Matrix (Y, W);

      Result_Matrix (Y, X) := -SA * Matrix (X, X) + CA * Matrix (Y, X);
      Result_Matrix (Y, Y) := -SA * Matrix (X, Y) + CA * Matrix (Y, Y);
      Result_Matrix (Y, Z) := -SA * Matrix (X, Z) + CA * Matrix (Y, Z);
      Result_Matrix (Y, W) := -SA * Matrix (X, W) + CA * Matrix (Y, W);

      Matrix := Result_Matrix;
   end Rotate_Z;

   procedure Rotate (Matrix    : in out Matrix4;
                     Direction : in     Vector3;
                     Angle     : in     Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);

      MCA : constant Single := 1.0 - CA;

      MCARXY : constant Single := MCA * Direction (X) * Direction (Y);
      MCARXZ : constant Single := MCA * Direction (X) * Direction (Z);
      MCARYZ : constant Single := MCA * Direction (Y) * Direction (Z);

      RXSA : constant Single := Direction (X) * SA;
      RYSA : constant Single := Direction (Y) * SA;
      RZSA : constant Single := Direction (Z) * SA;

      R11 : constant Single := CA + MCA * Direction (X)**2;
      R12 : constant Single := MCARXY + RZSA;
      R13 : constant Single := MCARXZ - RYSA;

      R21 : constant Single := MCARXY - RZSA;
      R22 : constant Single := CA + MCA * Direction (Y)**2;
      R23 : constant Single := MCARYZ + RXSA;

      R31 : constant Single := MCARXZ + RYSA;
      R32 : constant Single := MCARYZ - RXSA;
      R33 : constant Single := CA + MCA * Direction (Z)**2;

      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (X, X) := R11 * Matrix (X, X) + R12 * Matrix (Y, X) + R13 * Matrix (Z, X);
      Result_Matrix (X, Y) := R11 * Matrix (X, Y) + R12 * Matrix (Y, Y) + R13 * Matrix (Z, X);
      Result_Matrix (X, Z) := R11 * Matrix (X, Z) + R12 * Matrix (Y, Z) + R13 * Matrix (Z, X);
      Result_Matrix (X, W) := R11 * Matrix (X, W) + R12 * Matrix (Y, W) + R13 * Matrix (Z, X);

      Result_Matrix (Y, X) := R21 * Matrix (X, X) + R22 * Matrix (Y, X) + R23 * Matrix (Z, X);
      Result_Matrix (Y, Y) := R21 * Matrix (X, Y) + R22 * Matrix (Y, Y) + R23 * Matrix (Z, X);
      Result_Matrix (Y, Z) := R21 * Matrix (X, Z) + R22 * Matrix (Y, Z) + R23 * Matrix (Z, X);
      Result_Matrix (Y, W) := R21 * Matrix (X, W) + R22 * Matrix (Y, W) + R23 * Matrix (Z, X);

      Result_Matrix (Z, X) := R31 * Matrix (X, X) + R32 * Matrix (Y, X) + R33 * Matrix (Z, X);
      Result_Matrix (Z, Y) := R31 * Matrix (X, Y) + R32 * Matrix (Y, Y) + R33 * Matrix (Z, X);
      Result_Matrix (Z, Z) := R31 * Matrix (X, Z) + R32 * Matrix (Y, Z) + R33 * Matrix (Z, X);
      Result_Matrix (Z, W) := R31 * Matrix (X, W) + R32 * Matrix (Y, W) + R33 * Matrix (Z, X);

      Matrix := Result_Matrix;
   end Rotate;

   procedure Scale (Matrix : in out Matrix4; Factors : Vector3) is
   begin
      Matrix (X, X) := Matrix (X, X) * Factors (X);
      Matrix (X, Y) := Matrix (X, Y) * Factors (X);
      Matrix (X, Z) := Matrix (X, Y) * Factors (X);
      Matrix (X, W) := Matrix (X, W) * Factors (X);

      Matrix (Y, X) := Matrix (Y, X) * Factors (Y);
      Matrix (Y, Y) := Matrix (Y, Y) * Factors (Y);
      Matrix (Y, Z) := Matrix (Y, Z) * Factors (Y);
      Matrix (Y, W) := Matrix (Y, W) * Factors (Y);

      Matrix (Z, X) := Matrix (Z, X) * Factors (Z);
      Matrix (Z, Y) := Matrix (Z, Y) * Factors (Z);
      Matrix (Z, Z) := Matrix (Z, Z) * Factors (Z);
      Matrix (Z, W) := Matrix (Z, W) * Factors (Z);
   end Scale;

   procedure Scale (Matrix : in out Matrix4; Factor : Single) is
      Factors : constant Vector3 := (Factor, Factor, Factor);
   begin
      Scale (Matrix, Factors);
   end Scale;

   function Perspective (FOV, Aspect, Z_Near, Z_Far : Single) return Matrix4 is
      F : constant Single := 1.0 / Elementary_Functions.Tan (FOV / 2.0, 360.0);
      Matrix : Matrix4 := Identity4;
   begin
      Matrix (X, X) := F / Aspect;
      Matrix (Y, Y) := F;
      Matrix (Z, Z) := (Z_Near + Z_Far) / (Z_Near - Z_Far);
      Matrix (W, Z) := (2.0 * Z_Near * Z_Far) / (Z_Near - Z_Far);
      Matrix (Z, W) := Single (-1.0);
      Matrix (W, W) := Single (0.0);
      return Matrix;
   end Perspective;

end GL.Transforms;

--  Copyright (c) 2015 onox <denkpadje@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.Numerics.Generic_Elementary_Functions;

package body GL.Transforms is

   package Elementary_Functions is new Ada.Numerics.Generic_Elementary_Functions (Single);

   function To_Radians (Angle : Single) return Single is
   begin
      return Angle * Ada.Numerics.Pi / 180.0;
   end To_Radians;

   procedure Translate (Matrix : in out Matrix4; Offset : Vector3) is
   begin
      Matrix (W, X) := Matrix (X, X) * Offset (X) + Matrix (Y, X) * Offset (Y) + Matrix (Z, X) * Offset (Z) + Matrix (W, X);
      Matrix (W, Y) := Matrix (X, Y) * Offset (X) + Matrix (Y, Y) * Offset (Y) + Matrix (Z, Y) * Offset (Z) + Matrix (W, Y);
      Matrix (W, Z) := Matrix (X, Z) * Offset (X) + Matrix (Y, Z) * Offset (Y) + Matrix (Z, Z) * Offset (Z) + Matrix (W, Z);
      Matrix (W, W) := Matrix (X, W) * Offset (X) + Matrix (Y, W) * Offset (Y) + Matrix (Z, W) * Offset (Z) + Matrix (W, W);
   end Translate;

   procedure Rotate_X (Matrix : in out Matrix4; Angle : Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (Y, X) := CA * Matrix (Y, X) + SA * Matrix (Z, X);
      Result_Matrix (Y, Y) := CA * Matrix (Y, Y) + SA * Matrix (Z, Y);
      Result_Matrix (Y, Z) := CA * Matrix (Y, Z) + SA * Matrix (Z, Z);
      Result_Matrix (Y, W) := CA * Matrix (Y, W) + SA * Matrix (Z, W);

      Result_Matrix (Z, X) := -SA * Matrix (Y, X) + CA * Matrix (Z, X);
      Result_Matrix (Z, Y) := -SA * Matrix (Y, Y) + CA * Matrix (Z, Y);
      Result_Matrix (Z, Z) := -SA * Matrix (Y, Z) + CA * Matrix (Z, Z);
      Result_Matrix (Z, W) := -SA * Matrix (Y, W) + CA * Matrix (Z, W);

      Matrix := Result_Matrix;
   end Rotate_X;

   procedure Rotate_Y (Matrix : in out Matrix4; Angle : Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (X, X) := CA * Matrix (X, X) - SA * Matrix (Z, X);
      Result_Matrix (X, Y) := CA * Matrix (X, Y) - SA * Matrix (Z, Y);
      Result_Matrix (X, Z) := CA * Matrix (X, Z) - SA * Matrix (Z, Z);
      Result_Matrix (X, W) := CA * Matrix (X, W) - SA * Matrix (Z, W);

      Result_Matrix (Z, X) := SA * Matrix (X, X) + CA * Matrix (Z, X);
      Result_Matrix (Z, Y) := SA * Matrix (X, Y) + CA * Matrix (Z, Y);
      Result_Matrix (Z, Z) := SA * Matrix (X, Z) + CA * Matrix (Z, Z);
      Result_Matrix (Z, W) := SA * Matrix (X, W) + CA * Matrix (Z, W);

      Matrix := Result_Matrix;
   end Rotate_Y;

   procedure Rotate_Z (Matrix : in out Matrix4; Angle : Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (X, X) := CA * Matrix (X, X) + SA * Matrix (Y, X);
      Result_Matrix (X, Y) := CA * Matrix (X, Y) + SA * Matrix (Y, Y);
      Result_Matrix (X, Z) := CA * Matrix (X, Z) + SA * Matrix (Y, Z);
      Result_Matrix (X, W) := CA * Matrix (X, W) + SA * Matrix (Y, W);

      Result_Matrix (Y, X) := -SA * Matrix (X, X) + CA * Matrix (Y, X);
      Result_Matrix (Y, Y) := -SA * Matrix (X, Y) + CA * Matrix (Y, Y);
      Result_Matrix (Y, Z) := -SA * Matrix (X, Z) + CA * Matrix (Y, Z);
      Result_Matrix (Y, W) := -SA * Matrix (X, W) + CA * Matrix (Y, W);

      Matrix := Result_Matrix;
   end Rotate_Z;

   procedure Rotate (Matrix    : in out Matrix4;
                     Direction : in     Vector3;
                     Angle     : in     Single) is
      CA : constant Single := Elementary_Functions.Cos (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);
      SA : constant Single := Elementary_Functions.Sin (To_Radians (Angle), 2.0 * Ada.Numerics.Pi);

      MCA : constant Single := 1.0 - CA;

      MCARXY : constant Single := MCA * Direction (X) * Direction (Y);
      MCARXZ : constant Single := MCA * Direction (X) * Direction (Z);
      MCARYZ : constant Single := MCA * Direction (Y) * Direction (Z);

      RXSA : constant Single := Direction (X) * SA;
      RYSA : constant Single := Direction (Y) * SA;
      RZSA : constant Single := Direction (Z) * SA;

      R11 : constant Single := CA + MCA * Direction (X)**2;
      R12 : constant Single := MCARXY + RZSA;
      R13 : constant Single := MCARXZ - RYSA;

      R21 : constant Single := MCARXY - RZSA;
      R22 : constant Single := CA + MCA * Direction (Y)**2;
      R23 : constant Single := MCARYZ + RXSA;

      R31 : constant Single := MCARXZ + RYSA;
      R32 : constant Single := MCARYZ - RXSA;
      R33 : constant Single := CA + MCA * Direction (Z)**2;

      Result_Matrix : Matrix4 := Matrix;
   begin
      Result_Matrix (X, X) := R11 * Matrix (X, X) + R12 * Matrix (Y, X) + R13 * Matrix (Z, X);
      Result_Matrix (X, Y) := R11 * Matrix (X, Y) + R12 * Matrix (Y, Y) + R13 * Matrix (Z, X);
      Result_Matrix (X, Z) := R11 * Matrix (X, Z) + R12 * Matrix (Y, Z) + R13 * Matrix (Z, X);
      Result_Matrix (X, W) := R11 * Matrix (X, W) + R12 * Matrix (Y, W) + R13 * Matrix (Z, X);

      Result_Matrix (Y, X) := R21 * Matrix (X, X) + R22 * Matrix (Y, X) + R23 * Matrix (Z, X);
      Result_Matrix (Y, Y) := R21 * Matrix (X, Y) + R22 * Matrix (Y, Y) + R23 * Matrix (Z, X);
      Result_Matrix (Y, Z) := R21 * Matrix (X, Z) + R22 * Matrix (Y, Z) + R23 * Matrix (Z, X);
      Result_Matrix (Y, W) := R21 * Matrix (X, W) + R22 * Matrix (Y, W) + R23 * Matrix (Z, X);

      Result_Matrix (Z, X) := R31 * Matrix (X, X) + R32 * Matrix (Y, X) + R33 * Matrix (Z, X);
      Result_Matrix (Z, Y) := R31 * Matrix (X, Y) + R32 * Matrix (Y, Y) + R33 * Matrix (Z, X);
      Result_Matrix (Z, Z) := R31 * Matrix (X, Z) + R32 * Matrix (Y, Z) + R33 * Matrix (Z, X);
      Result_Matrix (Z, W) := R31 * Matrix (X, W) + R32 * Matrix (Y, W) + R33 * Matrix (Z, X);

      Matrix := Result_Matrix;
   end Rotate;

   procedure Scale (Matrix : in out Matrix4; Factors : Vector3) is
   begin
      Matrix (X, X) := Matrix (X, X) * Factors (X);
      Matrix (X, Y) := Matrix (X, Y) * Factors (X);
      Matrix (X, Z) := Matrix (X, Z) * Factors (X);
      Matrix (X, W) := Matrix (X, W) * Factors (X);

      Matrix (Y, X) := Matrix (Y, X) * Factors (Y);
      Matrix (Y, Y) := Matrix (Y, Y) * Factors (Y);
      Matrix (Y, Z) := Matrix (Y, Z) * Factors (Y);
      Matrix (Y, W) := Matrix (Y, W) * Factors (Y);

      Matrix (Z, X) := Matrix (Z, X) * Factors (Z);
      Matrix (Z, Y) := Matrix (Z, Y) * Factors (Z);
      Matrix (Z, Z) := Matrix (Z, Z) * Factors (Z);
      Matrix (Z, W) := Matrix (Z, W) * Factors (Z);
   end Scale;

   procedure Scale (Matrix : in out Matrix4; Factor : Single) is
      Factors : constant Vector3 := (Factor, Factor, Factor);
   begin
      Scale (Matrix, Factors);
   end Scale;

   function Perspective (FOV, Aspect, Z_Near, Z_Far : Single) return Matrix4 is
      F : constant Single := 1.0 / Elementary_Functions.Tan (FOV / 2.0, 360.0);
      Matrix : Matrix4 := Identity4;
   begin
      Matrix (X, X) := F / Aspect;
      Matrix (Y, Y) := F;
      Matrix (Z, Z) := (Z_Near + Z_Far) / (Z_Near - Z_Far);
      Matrix (W, Z) := (2.0 * Z_Near * Z_Far) / (Z_Near - Z_Far);
      Matrix (Z, W) := Single (-1.0);
      Matrix (W, W) := Single (0.0);
      return Matrix;
   end Perspective;

end GL.Transforms;

Fix typo in Scale procedure

gl: Fix typo in Scale procedure

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


-----------------------------------------------------------------------
--  files.tests -- Unit tests for files
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2019, 2022 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 System;
with Ada.Directories;
with Util.Systems.Constants;
with Util.Test_Caller;
package body Util.Files.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Files");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Files.Read_File",
                       Test_Read_File'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Read_File (missing)",
                       Test_Read_File_Missing'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Read_File (truncate)",
                       Test_Read_File'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Write_File",
                       Test_Write_File'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Iterate_Path",
                       Test_Iterate_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Find_File_Path",
                       Test_Find_File_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Compose_Path",
                       Test_Compose_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Get_Relative_Path",
                       Test_Get_Relative_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Delete_Tree",
                       Test_Delete_Tree'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a file into a string
   --  Reads this ada source file and checks we have read it correctly
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      Result : Unbounded_String;
   begin
      Read_File (Path => "regtests/util-files-tests.adb", Into => Result);
      T.Assert (Index (Result, "Util.Files.Tests") > 0,
                "Content returned by Read_File is not correct");
      T.Assert (Index (Result, "end Util.Files.Tests;") > 0,
                "Content returned by Read_File is not correct");
   end Test_Read_File;

   procedure Test_Read_File_Missing (T : in out Test) is
      Result : Unbounded_String;

      pragma Unreferenced (Result);
   begin
      Read_File (Path => "regtests/files-test--util.adb", Into => Result);
      T.Assert (False, "No exception raised");
   exception
      when others =>
         null;
   end Test_Read_File_Missing;

   procedure Test_Read_File_Truncate (T : in out Test) is
      Result : Unbounded_String;
   begin
      Read_File (Path => "regtests/util-files-tests.adb", Into => Result,
                 Max_Size => 50);
      Assert_Equals (T, Length (Result), 50,
                     "Read_File did not truncate correctly");
      T.Assert (Index (Result, "Apache License") > 0,
                "Content returned by Read_File is not correct");
   end Test_Read_File_Truncate;

   --  ------------------------------
   --  Check writing a file
   --  ------------------------------
   procedure Test_Write_File (T : in out Test) is
      Path   : constant String := Util.Tests.Get_Test_Path ("test-write.txt");
      Content : constant String := "Testing Util.Files.Write_File" & ASCII.LF;
      Result : Unbounded_String;
   begin
      Write_File (Path => Path, Content => Content);
      Read_File (Path => Path, Into => Result);
      Assert_Equals (T, To_String (Result), Content,
                     "Invalid content written or read");
   end Test_Write_File;

   --  ------------------------------
   --  Check Find_File_Path
   --  ------------------------------
   procedure Test_Find_File_Path (T : in out Test) is
      Dir   : constant String := Util.Tests.Get_Path ("regtests");
      Paths : constant String := ".;" & Dir;
   begin
      declare
         P : constant String := Util.Files.Find_File_Path ("test.properties", Paths);
      begin
         Assert_Equals (T, Dir & "/test.properties", P,
                        "Invalid path returned");
      end;
      Assert_Equals (T, "blablabla.properties",
                     Util.Files.Find_File_Path ("blablabla.properties", Paths));
   end Test_Find_File_Path;

   --  ------------------------------
   --  Check Iterate_Path
   --  ------------------------------
   procedure Test_Iterate_Path (T : in out Test) is
      procedure Check_Path (Dir : in String;
                            Done : out Boolean);

      Last : Unbounded_String;

      procedure Check_Path (Dir : in String;
                            Done : out Boolean) is
      begin
         if Dir = "a" or Dir = "bc" or Dir = "de" then
            Done := False;
         else
            Done := True;
         end if;
         Last := To_Unbounded_String (Dir);
      end Check_Path;

   begin
      Iterate_Path ("a;bc;de;f", Check_Path'Access);
      Assert_Equals (T, "f", Last, "Invalid last path");

      Iterate_Path ("de;bc;de;b", Check_Path'Access);
      Assert_Equals (T, "b", Last, "Invalid last path");

      Iterate_Path ("de;bc;de;a", Check_Path'Access, Ada.Strings.Backward);
      Assert_Equals (T, "de", Last, "Invalid last path");

   end Test_Iterate_Path;

   --  ------------------------------
   --  Test the Compose_Path operation
   --  ------------------------------
   procedure Test_Compose_Path (T : in out Test) is
   begin
      Assert_Equals (T, "src/sys/processes/os-none",
                     Compose_Path ("src;regtests;src/sys/processes", "os-none"),
                     "Invalid path composition");
      Assert_Equals (T, "regtests/bundles",
                     Compose_Path ("src;regtests", "bundles"),
                     "Invalid path composition");
      if Ada.Directories.Exists ("/usr/bin") then
         Assert_Equals (T, "/usr/bin;/usr/local/bin;/usr/bin",
                        Compose_Path ("/usr;/usr/local;/usr", "bin"),
                        "Invalid path composition");
      end if;
   end Test_Compose_Path;

   --  ------------------------------
   --  Test the Get_Relative_Path operation.
   --  ------------------------------
   procedure Test_Get_Relative_Path (T : in out Test) is
   begin
      Assert_Equals (T, "../util",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/util"),
                     "Invalid relative path");
      Assert_Equals (T, "../util",
                     Get_Relative_Path ("/home/john/src/asf/", "/home/john/src/util"),
                     "Invalid relative path");
      Assert_Equals (T, "../util/b",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/util/b"),
                     "Invalid relative path");
      Assert_Equals (T, "../as",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/as"),
                     "Invalid relative path");
      Assert_Equals (T, "../../",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john"),
                     "Invalid relative path");
      Assert_Equals (T, "/usr/share/admin",
                     Get_Relative_Path ("/home/john/src/asf", "/usr/share/admin"),
                     "Invalid absolute path");
      Assert_Equals (T, "/home/john",
                     Get_Relative_Path ("home/john/src/asf", "/home/john"),
                     "Invalid relative path");
      Assert_Equals (T, "e",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/asf/e"),
                     "Invalid relative path");
      Assert_Equals (T, ".",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/asf/"),
                     "Invalid relative path");
   end Test_Get_Relative_Path;

   function Sys_Symlink (Target : in System.Address; Link : in System.Address) return Integer
     with Import => True, Convention => C,
          Link_Name => Util.Systems.Constants.SYMBOL_PREFIX & "symlink";
   pragma Weak_External (Sys_Symlink);

   --  ------------------------------
   --  Test the Delete_Tree operation.
   --  ------------------------------
   procedure Test_Delete_Tree (T : in out Test) is
      use type System.Address;

      Path : constant String := Util.Tests.Get_Test_Path ("test-delete-tree");
   begin
      if Ada.Directories.Exists (Path) then
         Delete_Tree (Path);
      end if;

      --  Create a directory tree with symlink links that point to a non-existing file.
      Ada.Directories.Create_Directory (Path);
      for I in 1 .. 10 loop
         declare
            P : constant String := Compose (Path, Util.Strings.Image (I));
            S : String (1 .. P'Length + 3);
            R : Integer;
         begin
            Ada.Directories.Create_Directory (P);
            S (1 .. P'Length) := P;
            S (P'Length + 1) := '/';
            S (P'Length + 2) := 'A';
            S (S'Last) := ASCII.NUL;
            for J in 1 .. 5 loop
               Ada.Directories.Create_Path (Compose (P, Util.Strings.Image (J)));
            end loop;
            if Sys_Symlink'Address /= System.Null_Address then
               R := Sys_Symlink (S'Address, S'Address);
               Util.Tests.Assert_Equals (T, 0, R, "symlink creation failed");
            end if;
         end;
      end loop;
      T.Assert (Ada.Directories.Exists (Path), "Directory must exist");

      --  Ada.Directories.Delete_Tree (Path) fails to delete the tree.
      Delete_Tree (Path);
      T.Assert (not Ada.Directories.Exists (Path), "Directory must have been deleted");
   end Test_Delete_Tree;

end Util.Files.Tests;

-----------------------------------------------------------------------
--  files.tests -- Unit tests for files
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2019, 2022 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 System;
with Ada.Directories;
with Util.Systems.Constants;
with Util.Test_Caller;
package body Util.Files.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Files");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Files.Read_File",
                       Test_Read_File'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Read_File (missing)",
                       Test_Read_File_Missing'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Read_File (truncate)",
                       Test_Read_File'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Write_File",
                       Test_Write_File'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Iterate_Path",
                       Test_Iterate_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Find_File_Path",
                       Test_Find_File_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Compose_Path",
                       Test_Compose_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Get_Relative_Path",
                       Test_Get_Relative_Path'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Delete_Tree",
                       Test_Delete_Tree'Access);
      Caller.Add_Test (Suite, "Test Util.Files.Realpath",
                       Test_Realpath'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a file into a string
   --  Reads this ada source file and checks we have read it correctly
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      Result : Unbounded_String;
   begin
      Read_File (Path => "regtests/util-files-tests.adb", Into => Result);
      T.Assert (Index (Result, "Util.Files.Tests") > 0,
                "Content returned by Read_File is not correct");
      T.Assert (Index (Result, "end Util.Files.Tests;") > 0,
                "Content returned by Read_File is not correct");
   end Test_Read_File;

   procedure Test_Read_File_Missing (T : in out Test) is
      Result : Unbounded_String;

      pragma Unreferenced (Result);
   begin
      Read_File (Path => "regtests/files-test--util.adb", Into => Result);
      T.Assert (False, "No exception raised");
   exception
      when others =>
         null;
   end Test_Read_File_Missing;

   procedure Test_Read_File_Truncate (T : in out Test) is
      Result : Unbounded_String;
   begin
      Read_File (Path => "regtests/util-files-tests.adb", Into => Result,
                 Max_Size => 50);
      Assert_Equals (T, Length (Result), 50,
                     "Read_File did not truncate correctly");
      T.Assert (Index (Result, "Apache License") > 0,
                "Content returned by Read_File is not correct");
   end Test_Read_File_Truncate;

   --  ------------------------------
   --  Check writing a file
   --  ------------------------------
   procedure Test_Write_File (T : in out Test) is
      Path   : constant String := Util.Tests.Get_Test_Path ("test-write.txt");
      Content : constant String := "Testing Util.Files.Write_File" & ASCII.LF;
      Result : Unbounded_String;
   begin
      Write_File (Path => Path, Content => Content);
      Read_File (Path => Path, Into => Result);
      Assert_Equals (T, To_String (Result), Content,
                     "Invalid content written or read");
   end Test_Write_File;

   --  ------------------------------
   --  Check Find_File_Path
   --  ------------------------------
   procedure Test_Find_File_Path (T : in out Test) is
      Dir   : constant String := Util.Tests.Get_Path ("regtests");
      Paths : constant String := ".;" & Dir;
   begin
      declare
         P : constant String := Util.Files.Find_File_Path ("test.properties", Paths);
      begin
         Assert_Equals (T, Dir & "/test.properties", P,
                        "Invalid path returned");
      end;
      Assert_Equals (T, "blablabla.properties",
                     Util.Files.Find_File_Path ("blablabla.properties", Paths));
   end Test_Find_File_Path;

   --  ------------------------------
   --  Check Iterate_Path
   --  ------------------------------
   procedure Test_Iterate_Path (T : in out Test) is
      procedure Check_Path (Dir : in String;
                            Done : out Boolean);

      Last : Unbounded_String;

      procedure Check_Path (Dir : in String;
                            Done : out Boolean) is
      begin
         if Dir = "a" or Dir = "bc" or Dir = "de" then
            Done := False;
         else
            Done := True;
         end if;
         Last := To_Unbounded_String (Dir);
      end Check_Path;

   begin
      Iterate_Path ("a;bc;de;f", Check_Path'Access);
      Assert_Equals (T, "f", Last, "Invalid last path");

      Iterate_Path ("de;bc;de;b", Check_Path'Access);
      Assert_Equals (T, "b", Last, "Invalid last path");

      Iterate_Path ("de;bc;de;a", Check_Path'Access, Ada.Strings.Backward);
      Assert_Equals (T, "de", Last, "Invalid last path");

   end Test_Iterate_Path;

   --  ------------------------------
   --  Test the Compose_Path operation
   --  ------------------------------
   procedure Test_Compose_Path (T : in out Test) is
   begin
      Assert_Equals (T, "src/sys/processes/os-none",
                     Compose_Path ("src;regtests;src/sys/processes", "os-none"),
                     "Invalid path composition");
      Assert_Equals (T, "regtests/bundles",
                     Compose_Path ("src;regtests", "bundles"),
                     "Invalid path composition");
      if Ada.Directories.Exists ("/usr/bin") then
         Assert_Equals (T, "/usr/bin;/usr/local/bin;/usr/bin",
                        Compose_Path ("/usr;/usr/local;/usr", "bin"),
                        "Invalid path composition");
      end if;
   end Test_Compose_Path;

   --  ------------------------------
   --  Test the Get_Relative_Path operation.
   --  ------------------------------
   procedure Test_Get_Relative_Path (T : in out Test) is
   begin
      Assert_Equals (T, "../util",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/util"),
                     "Invalid relative path");
      Assert_Equals (T, "../util",
                     Get_Relative_Path ("/home/john/src/asf/", "/home/john/src/util"),
                     "Invalid relative path");
      Assert_Equals (T, "../util/b",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/util/b"),
                     "Invalid relative path");
      Assert_Equals (T, "../as",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/as"),
                     "Invalid relative path");
      Assert_Equals (T, "../../",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john"),
                     "Invalid relative path");
      Assert_Equals (T, "/usr/share/admin",
                     Get_Relative_Path ("/home/john/src/asf", "/usr/share/admin"),
                     "Invalid absolute path");
      Assert_Equals (T, "/home/john",
                     Get_Relative_Path ("home/john/src/asf", "/home/john"),
                     "Invalid relative path");
      Assert_Equals (T, "e",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/asf/e"),
                     "Invalid relative path");
      Assert_Equals (T, ".",
                     Get_Relative_Path ("/home/john/src/asf", "/home/john/src/asf/"),
                     "Invalid relative path");
   end Test_Get_Relative_Path;

   function Sys_Symlink (Target : in System.Address; Link : in System.Address) return Integer
     with Import => True, Convention => C,
          Link_Name => Util.Systems.Constants.SYMBOL_PREFIX & "symlink";
   pragma Weak_External (Sys_Symlink);

   --  ------------------------------
   --  Test the Delete_Tree operation.
   --  ------------------------------
   procedure Test_Delete_Tree (T : in out Test) is
      use type System.Address;

      Path : constant String := Util.Tests.Get_Test_Path ("test-delete-tree");
   begin
      if Ada.Directories.Exists (Path) then
         Delete_Tree (Path);
      end if;

      --  Create a directory tree with symlink links that point to a non-existing file.
      Ada.Directories.Create_Directory (Path);
      for I in 1 .. 10 loop
         declare
            P : constant String := Compose (Path, Util.Strings.Image (I));
            S : String (1 .. P'Length + 3);
            R : Integer;
         begin
            Ada.Directories.Create_Directory (P);
            S (1 .. P'Length) := P;
            S (P'Length + 1) := '/';
            S (P'Length + 2) := 'A';
            S (S'Last) := ASCII.NUL;
            for J in 1 .. 5 loop
               Ada.Directories.Create_Path (Compose (P, Util.Strings.Image (J)));
            end loop;
            if Sys_Symlink'Address /= System.Null_Address then
               R := Sys_Symlink (S'Address, S'Address);
               Util.Tests.Assert_Equals (T, 0, R, "symlink creation failed");
            end if;
         end;
      end loop;
      T.Assert (Ada.Directories.Exists (Path), "Directory must exist");

      --  Ada.Directories.Delete_Tree (Path) fails to delete the tree.
      Delete_Tree (Path);
      T.Assert (not Ada.Directories.Exists (Path), "Directory must have been deleted");
   end Test_Delete_Tree;

   --  ------------------------------
   --  Test the Realpath function.
   --  ------------------------------
   procedure Test_Realpath (T : in out Test) is
      P : constant String := Util.Files.Realpath ("bin/util_harness");
   begin
      Util.Tests.Assert_Matches (T, ".*/bin/util_harness", P);
   end Test_Realpath;

end Util.Files.Tests;

Add Test_Realpath and register the test for execution


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "64";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "65";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Bump version

Bump version


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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with AWA.Votes.Modules;
with AWA.Votes.Models;

--  === Vote Beans ===
--  The Vote_Bean is a bean intended to be used in presentation files (facelet files)
--  to vote for an item.  The managed bean can be easily configured in the application XML
--  configuration file.  The permission and entity_type are the two properties
--  that should be defined in the configuration.  The permission is the name of the
--  permission that must be used to verify that the user is allowed to vote for the item.
--  The entity_type is the name of the entity (table name) used by the item.
--  The example below defines the bean <tt>questionVote</tt> defined by the question module.
--
--    <managed-bean>
--      <description>The vote bean that allows to vote for a question.</description>
--      <managed-bean-name>questionVote</managed-bean-name>
--      <managed-bean-class>AWA.Votes.Beans.Votes_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>permission</property-name>
--        <property-class>String</property-class>
--        <value>answer-create</value>
--      </managed-property>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--    </managed-bean>
--
--  The vote concerns entities for the <tt>awa_question</tt> entity table.
--  The permission <tt>answer-create</tt> is used to verify for the vote.
--
--  [http://ada-awa.googlecode.com/svn/wiki/awa_votes_bean.png]
--
package AWA.Votes.Beans is

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with private;
   type Vote_Bean_Access is access all Vote_Bean'Class;

   --  Action to vote up.
   overriding
   procedure Vote_Up (Bean    : in out Vote_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Action to vote down.
   overriding
   procedure Vote_Down (Bean    : in out Vote_Bean;
                        Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Action to vote.
   overriding
   procedure Vote (Bean    : in out Vote_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Votes_Bean bean instance.
   function Create_Vote_Bean (Module : in AWA.Votes.Modules.Vote_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

private

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with record
      Module : AWA.Votes.Modules.Vote_Module_Access := null;
   end record;

end AWA.Votes.Beans;

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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with AWA.Votes.Modules;
with AWA.Votes.Models;

--  === Vote Beans ===
--  The <tt>Vote_Bean</tt> is a bean intended to be used in presentation files (XHTML facelet
--  files) to vote for an item.  The managed bean can be easily configured in the application XML
--  configuration file.  The permission and entity_type are the two properties
--  that should be defined in the configuration.  The permission is the name of the
--  permission that must be used to verify that the user is allowed to vote for the item.
--  The entity_type is the name of the entity (table name) used by the item.
--  The example below defines the bean <tt>questionVote</tt> defined by the question module.
--
--    <managed-bean>
--      <description>The vote bean that allows to vote for a question.</description>
--      <managed-bean-name>questionVote</managed-bean-name>
--      <managed-bean-class>AWA.Votes.Beans.Votes_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>permission</property-name>
--        <property-class>String</property-class>
--        <value>answer-create</value>
--      </managed-property>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--    </managed-bean>
--
--  The vote concerns entities for the <tt>awa_question</tt> entity table.
--  The permission <tt>answer-create</tt> is used to verify that the vote is allowed.
--
--  [http://ada-awa.googlecode.com/svn/wiki/awa_votes_bean.png]
--
--  The managed bean defines three operations that can be called: <tt>vote_up</tt>,
--  <tt>vote_down</tt> and <tt>vote</tt> to setup specific ratings.
package AWA.Votes.Beans is

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with private;
   type Vote_Bean_Access is access all Vote_Bean'Class;

   --  Action to vote up.
   overriding
   procedure Vote_Up (Bean    : in out Vote_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Action to vote down.
   overriding
   procedure Vote_Down (Bean    : in out Vote_Bean;
                        Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Action to vote.
   overriding
   procedure Vote (Bean    : in out Vote_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Votes_Bean bean instance.
   function Create_Vote_Bean (Module : in AWA.Votes.Modules.Vote_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

private

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with record
      Module : AWA.Votes.Modules.Vote_Module_Access := null;
   end record;

end AWA.Votes.Beans;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 2016 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.
-----------------------------------------------------------------------

package body Wiki.Nodes is

   --  ------------------------------
   --  Create a text node.
   --  ------------------------------
   function Create_Text (Text : in WString) return Node_Type_Access is
   begin
      return new Node_Type '(Kind => N_TEXT,
                             Len  => Text'Length,
                             Text => Text,
                             others => <>);
   end Create_Text;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Into.Length);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

end Wiki.Nodes;

-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 2016 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.
-----------------------------------------------------------------------

package body Wiki.Nodes is

   --  ------------------------------
   --  Create a text node.
   --  ------------------------------
   function Create_Text (Text : in WString) return Node_Type_Access is
   begin
      return new Node_Type '(Kind => N_TEXT,
                             Len  => Text'Length,
                             Text => Text,
                             others => <>);
   end Create_Text;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access) is
   begin
      Append (Into.Nodes, Node);
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Into.Length);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

end Wiki.Nodes;

Implement the Append procedure on a Document


-----------------------------------------------------------------------
--  wiki -- Ada Wiki Engine
--  Copyright (C) 2016 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 Wiki.Attributes;
with Wiki.Documents;
package Wiki.Nodes is

   pragma Preelaborate;

   subtype Format_Map is Wiki.Documents.Format_Map;
   subtype WString is Wide_Wide_String;

   type Node_Kind is (N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_HEADER,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_TABLE,
                      N_ROW,
                      N_COLUMN);

   --  Node kinds which are simple markers in the document.
   subtype Simple_Node_Kind is Node_Kind range N_LINE_BREAK .. N_PARAGRAPH;

     --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag_Type is
     (
      --  Section 4.1 The root element
      HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag_Type;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag_Type) return String_Access;

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT =>
            Level  : Natural := 0;
            Header : WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : WString (1 .. Len);

         when N_LINK =>
            Image      : Boolean;
            Link_Attr  : Wiki.Attributes.Attribute_List_Type;
            Title      : WString (1 .. Len);

         when N_QUOTE =>
            Quote_Attr : Wiki.Attributes.Attribute_List_Type;
            Quote      : WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag_Type;
            Attributes : Wiki.Attributes.Attribute_List_Type;
            Children   : Node_List_Access;
            Parent     : Node_Type_Access;

         when others =>
            null;

      end case;
   end record;

   --  Create a text node.
   function Create_Text (Text : in WString) return Node_Type_Access;

   type Document is limited private;

   --  Append a node to the document.
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access);

   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind);

   --  Append a HTML tag start node to the document.
   procedure Add_Tag (Document   : in out Wiki.Nodes.Document;
                      Tag        : in Html_Tag_Type;
                      Attributes : in Wiki.Attributes.Attribute_List_Type);

   --     procedure Add_Text (Doc  : in out Document;
--                         Text : in WString);

--     type Renderer is limited interface;
--
--     procedure Render (Engine : in out Renderer;
--                       Doc    : in Document;
--                       Node   : in Node_Type) is abstract;
--
--     procedure Iterate (Doc     : in Document;
--                        Process : access procedure (Doc : in Document; Node : in Node_Type)) is
--        Node : Document_Node_Access := Doc.First;
--     begin
--        while Node /= null loop
--           Process (Doc, Node.Data);
--           Node := Node.Next;
--        end loop;
--     end Iterate;

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   type Document is limited record
      Nodes   : Node_List;
      Current : Node_Type_Access;
   end record;

end Wiki.Nodes;

-----------------------------------------------------------------------
--  wiki -- Ada Wiki Engine
--  Copyright (C) 2016 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 Wiki.Attributes;
with Wiki.Documents;
with Wiki.Strings;
package Wiki.Nodes is

   pragma Preelaborate;

   subtype Format_Map is Wiki.Documents.Format_Map;
   subtype WString is Wide_Wide_String;

   type Node_Kind is (N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_HEADER,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_INDENT,
                      N_TEXT,
                      N_LINK);

   --  Node kinds which are simple markers in the document.
   subtype Simple_Node_Kind is Node_Kind range N_LINE_BREAK .. N_PARAGRAPH;

     --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag_Type is
     (
      --  Section 4.1 The root element
      HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag_Type;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag_Type) return String_Access;

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT =>
            Level  : Natural := 0;
            Header : WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : WString (1 .. Len);

         when N_LINK =>
            Image      : Boolean;
            Link_Attr  : Wiki.Attributes.Attribute_List_Type;
            Title      : WString (1 .. Len);

         when N_QUOTE =>
            Quote_Attr : Wiki.Attributes.Attribute_List_Type;
            Quote      : WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag_Type;
            Attributes : Wiki.Attributes.Attribute_List_Type;
            Children   : Node_List_Access;
            Parent     : Node_Type_Access;

         when others =>
            null;

      end case;
   end record;

   --  Create a text node.
   function Create_Text (Text : in WString) return Node_Type_Access;

   type Document is limited private;

   --  Append a node to the document.
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access);

   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind);

   --  Append a HTML tag start node to the document.
   procedure Add_Tag (Document   : in out Wiki.Nodes.Document;
                      Tag        : in Html_Tag_Type;
                      Attributes : in Wiki.Attributes.Attribute_List_Type);

   --  Append the text with the given format at end of the document.
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map);

   --     procedure Add_Text (Doc  : in out Document;
--                         Text : in WString);

--     type Renderer is limited interface;
--
--     procedure Render (Engine : in out Renderer;
--                       Doc    : in Document;
--                       Node   : in Node_Type) is abstract;
--
--     procedure Iterate (Doc     : in Document;
--                        Process : access procedure (Doc : in Document; Node : in Node_Type)) is
--        Node : Document_Node_Access := Doc.First;
--     begin
--        while Node /= null loop
--           Process (Doc, Node.Data);
--           Node := Node.Next;
--        end loop;
--     end Iterate;

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   type Document is limited record
      Nodes   : Node_List;
      Current : Node_Type_Access;
   end record;

end Wiki.Nodes;

Declare the Append procedure to add a formatted text node to the document


-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 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.Log.Loggers;

with Ada.IO_Exceptions;

package body ADO.Drivers is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers");

   --  Global configuration properties (loaded by Initialize).
   Global_Config : Util.Properties.Manager;

   --  ------------------------------
   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   --  ------------------------------
   procedure Initialize (Config : in String) is
   begin
      Log.Info ("Initialize using property file {0}", Config);

      begin
         Util.Properties.Load_Properties (Global_Config, Config);
      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Error ("Configuration file '{0}' does not exist", Config);
      end;

      Initialize (Global_Config);
   end Initialize;

   --  ------------------------------
   --  Initialize the drivers and the library and configure the runtime with the given properties.
   --  ------------------------------
   procedure Initialize (Config : in Util.Properties.Manager'Class) is
   begin
      Global_Config := Util.Properties.Manager (Config);

      --  Initialize the drivers.
      ADO.Drivers.Initialize;
   end Initialize;

   --  ------------------------------
   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Name    : in String;
                        Default : in String := "") return String is
   begin
      return Global_Config.Get (Name, Default);
   end Get_Config;

   --  ------------------------------
   --  Returns true if the global configuration property is set to true/on.
   --  ------------------------------
   function Is_On (Name   : in String) return Boolean is
      Value : constant String := Global_Config.Get (Name, "");
   begin
      return Value = "on" or Value = "true" or Value = "1";
   end Is_On;

   --  Initialize the drivers which are available.
   procedure Initialize is separate;

end ADO.Drivers;

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

with Util.Log.Loggers;

with Ada.IO_Exceptions;

package body ADO.Drivers is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers");

   --  Global configuration properties (loaded by Initialize).
   Global_Config : Util.Properties.Manager;

   --  ------------------------------
   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   --  ------------------------------
   procedure Initialize (Config : in String) is
   begin
      Log.Info ("Initialize using property file {0}", Config);

      begin
         Util.Properties.Load_Properties (Global_Config, Config);
      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Error ("Configuration file '{0}' does not exist", Config);
      end;

      Initialize (Global_Config);
   end Initialize;

   --  ------------------------------
   --  Initialize the drivers and the library and configure the runtime with the given properties.
   --  ------------------------------
   procedure Initialize (Config : in Util.Properties.Manager'Class) is
   begin
      Global_Config := Util.Properties.Manager (Config);

      --  Initialize the drivers.
      ADO.Drivers.Initialize;
   end Initialize;

   --  ------------------------------
   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Name    : in String;
                        Default : in String := "") return String is
   begin
      return Global_Config.Get (Name, Default);
   end Get_Config;

   --  ------------------------------
   --  Returns true if the global configuration property is set to true/on.
   --  ------------------------------
   function Is_On (Name   : in String) return Boolean is
      Value : constant String := Global_Config.Get (Name, "");
   begin
      return Value = "on" or Value = "true" or Value = "1";
   end Is_On;

   --  Initialize the drivers which are available.
   procedure Initialize is separate;

end ADO.Drivers;

Update header

Update header