-----------------------------------------------------------------------
--  Logs -- Utility Log Package
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 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.
-----------------------------------------------------------------------

--  = Logging =
--  The `Util.Log` package and children provide a simple logging framework inspired
--  from the Java Log4j library.  It is intended to provide a subset of logging features
--  available in other languages, be flexible, extensible, small and efficient.  Having
--  log messages in large applications is very helpful to understand, track and fix complex
--  issues, some of them being related to configuration issues or interaction with other
--  systems.  The overhead of calling a log operation is negligeable when the log is disabled
--  as it is in the order of 30ns and reasonable for a file appender has it is in the order
--  of 5us.
--
--  == Using the log framework ==
--  A bit of terminology:
--
--  * A *logger* is the abstraction that provides operations to emit a message.  The message
--    is composed of a text, optional formatting parameters, a log level and a timestamp.
--  * A *formatter* is the abstraction that takes the information about the log to format
--    the final message.
--  * An *appender* is the abstraction that writes the message either to a console, a file
--    or some other final mechanism.
--
--  === Logger Declaration ===
--  Similar to other logging framework such as Log4j and Log4cxx, it is necessary to have
--  and instance of a logger to write a log message.  The logger instance holds the configuration
--  for the log to enable, disable and control the format and the appender that will receive
--  the message.  The logger instance is associated with a name that is used for the
--  configuration.  A good practice is to declare a `Log` instance in the package body or
--  the package private part to make available the log instance to all the package operations.
--  The instance is created by using the `Create` function.  The name used for the configuration
--  is free but using the full package name is helpful to control precisely the logs.
--
--    with Util.Log.Loggers;
--    package body X.Y is
--      Log : constant Util.Log.Loggers := Util.Log.Loggers.Create ("X.Y");
--    end X.Y;
--
--  === Logger Messages ===
--  A log message is associated with a log level which is used by the logger instance to
--  decide to emit or drop the log message.  To keep the logging API simple and make it easily
--  usable in the application, several operations are provided to write a message with different
--  log level.
--
--  A log message is a string that contains optional formatting markers that follow more or
--  less the Java MessageFormat class.  A parameter is represented by a number enclosed by `{}`.
--  The first parameter is represented by `{0}`, the second by `{1}` and so on.
--
--  The example below shows several calls to emit a log message with different levels:
--
--     Log.Error ("Cannot open file {0}: {1}", Path, "File does not exist");
--     Log.Warn ("The file {0} is empty", Path);
--     Log.Info ("Opening file {0}", Path);
--     Log.Debug ("Reading line {0}", Line);
--
--  === Log Configuration ===
--  The log configuration uses property files close to the Apache Log4j and to the
--  Apache Log4cxx configuration files.
--  The configuration file contains several parts to configure the logging framework:
--
--  * First, the *appender* configuration indicates the appender that exists and can receive
--    a log message.
--  * Second, a root configuration allows to control the default behavior of the logging
--    framework.  The root configuration controls the default log level as well as the
--    appenders that can be used.
--  * Last, a logger configuration is defined to control the logging level more precisely
--    for each logger.
--
--  Here is a simple log configuration that creates a file appender where log messages are
--  written.  The file appender is given the name `result` and is configured to write the
--  messages in the file `my-log-file.log`.  The file appender will use the `level-message`
--  format for the layout of messages.  Last is the configuration of the `X.Y` logger
--  that will enable only messages starting from the `WARN` level.
--
--    log4j.rootCategory=DEBUG,result
--    log4j.appender.result=File
--    log4j.appender.result.File=my-log-file.log
--    log4j.appender.result.layout=level-message
--    log4j.logger.X.Y=WARN
--
--
package Util.Log is

   pragma Preelaborate;

   subtype Level_Type is Natural;

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

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

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

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

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

end Util.Log;

-----------------------------------------------------------------------
--  util-log -- Utility Log Package
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 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.
-----------------------------------------------------------------------

--  = Logging =
--  The `Util.Log` package and children provide a simple logging framework inspired
--  from the Java Log4j library.  It is intended to provide a subset of logging features
--  available in other languages, be flexible, extensible, small and efficient.  Having
--  log messages in large applications is very helpful to understand, track and fix complex
--  issues, some of them being related to configuration issues or interaction with other
--  systems.  The overhead of calling a log operation is negligeable when the log is disabled
--  as it is in the order of 30ns and reasonable for a file appender has it is in the order
--  of 5us.
--
--  == Using the log framework ==
--  A bit of terminology:
--
--  * A *logger* is the abstraction that provides operations to emit a message.  The message
--    is composed of a text, optional formatting parameters, a log level and a timestamp.
--  * A *formatter* is the abstraction that takes the information about the log to format
--    the final message.
--  * An *appender* is the abstraction that writes the message either to a console, a file
--    or some other final mechanism.
--
--  === Logger Declaration ===
--  Similar to other logging framework such as Log4j and Log4cxx, it is necessary to have
--  and instance of a logger to write a log message.  The logger instance holds the configuration
--  for the log to enable, disable and control the format and the appender that will receive
--  the message.  The logger instance is associated with a name that is used for the
--  configuration.  A good practice is to declare a `Log` instance in the package body or
--  the package private part to make available the log instance to all the package operations.
--  The instance is created by using the `Create` function.  The name used for the configuration
--  is free but using the full package name is helpful to control precisely the logs.
--
--    with Util.Log.Loggers;
--    package body X.Y is
--      Log : constant Util.Log.Loggers := Util.Log.Loggers.Create ("X.Y");
--    end X.Y;
--
--  === Logger Messages ===
--  A log message is associated with a log level which is used by the logger instance to
--  decide to emit or drop the log message.  To keep the logging API simple and make it easily
--  usable in the application, several operations are provided to write a message with different
--  log level.
--
--  A log message is a string that contains optional formatting markers that follow more or
--  less the Java MessageFormat class.  A parameter is represented by a number enclosed by `{}`.
--  The first parameter is represented by `{0}`, the second by `{1}` and so on.
--
--  The example below shows several calls to emit a log message with different levels:
--
--     Log.Error ("Cannot open file {0}: {1}", Path, "File does not exist");
--     Log.Warn ("The file {0} is empty", Path);
--     Log.Info ("Opening file {0}", Path);
--     Log.Debug ("Reading line {0}", Line);
--
--  === Log Configuration ===
--  The log configuration uses property files close to the Apache Log4j and to the
--  Apache Log4cxx configuration files.
--  The configuration file contains several parts to configure the logging framework:
--
--  * First, the *appender* configuration indicates the appender that exists and can receive
--    a log message.
--  * Second, a root configuration allows to control the default behavior of the logging
--    framework.  The root configuration controls the default log level as well as the
--    appenders that can be used.
--  * Last, a logger configuration is defined to control the logging level more precisely
--    for each logger.
--
--  Here is a simple log configuration that creates a file appender where log messages are
--  written.  The file appender is given the name `result` and is configured to write the
--  messages in the file `my-log-file.log`.  The file appender will use the `level-message`
--  format for the layout of messages.  Last is the configuration of the `X.Y` logger
--  that will enable only messages starting from the `WARN` level.
--
--    log4j.rootCategory=DEBUG,result
--    log4j.appender.result=File
--    log4j.appender.result.File=my-log-file.log
--    log4j.appender.result.layout=level-message
--    log4j.logger.X.Y=WARN
--
--
package Util.Log is

   pragma Preelaborate;

   subtype Level_Type is Natural;

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

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

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

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

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

end Util.Log;

Fix header style

Fix header style


-----------------------------------------------------------------------
--  mat-events-timelines - Timelines
--  Copyright (C) 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.Containers.Vectors;

with MAT.Expressions;
with MAT.Events.Tools;
with MAT.Events.Targets;
package MAT.Events.Timelines is

   --  Describe a section of the timeline.  The section has a starting and ending
   --  event that marks the boundary of the section within the collected events.
   --  The timeline section gives the duration and some statistics about memory
   --  allocation made in the section.
   type Timeline_Info is record
      First_Event    : MAT.Events.Target_Event_Type;
      Last_Event     : MAT.Events.Target_Event_Type;
      Duration       : MAT.Types.Target_Time := 0;
      Malloc_Count   : Natural := 0;
      Realloc_Count  : Natural := 0;
      Free_Count     : Natural := 0;
      Alloc_Size     : MAT.Types.Target_Size := 0;
      Free_Size      : MAT.Types.Target_Size := 0;
   end record;

   package Timeline_Info_Vectors is
     new Ada.Containers.Vectors (Positive, Timeline_Info);

   subtype Timeline_Info_Vector is Timeline_Info_Vectors.Vector;
   subtype Timeline_Info_Cursor is Timeline_Info_Vectors.Cursor;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Into   : in out Timeline_Info_Vector);

   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Target_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Tools.Target_Event_Vector);

   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Tools.Size_Event_Info_Map);

   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Natural;
                          Frames : in out MAT.Events.Tools.Frame_Event_Info_Map);

end MAT.Events.Timelines;

-----------------------------------------------------------------------
--  mat-events-timelines - Timelines
--  Copyright (C) 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.Containers.Vectors;

with MAT.Expressions;
with MAT.Events.Tools;
with MAT.Events.Targets;
package MAT.Events.Timelines is

   --  Describe a section of the timeline.  The section has a starting and ending
   --  event that marks the boundary of the section within the collected events.
   --  The timeline section gives the duration and some statistics about memory
   --  allocation made in the section.
   type Timeline_Info is record
      First_Event    : MAT.Events.Target_Event_Type;
      Last_Event     : MAT.Events.Target_Event_Type;
      Duration       : MAT.Types.Target_Time := 0;
      Malloc_Count   : Natural := 0;
      Realloc_Count  : Natural := 0;
      Free_Count     : Natural := 0;
      Alloc_Size     : MAT.Types.Target_Size := 0;
      Free_Size      : MAT.Types.Target_Size := 0;
   end record;

   package Timeline_Info_Vectors is
     new Ada.Containers.Vectors (Positive, Timeline_Info);

   subtype Timeline_Info_Vector is Timeline_Info_Vectors.Vector;
   subtype Timeline_Info_Cursor is Timeline_Info_Vectors.Cursor;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Into   : in out Timeline_Info_Vector);

   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Target_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Tools.Target_Event_Vector);

   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Tools.Size_Event_Info_Map);

   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Positive;
                          Exact  : in Boolean;
                          Frames : in out MAT.Events.Tools.Frame_Event_Info_Map);

end MAT.Events.Timelines;

Add the Exact boolean paramter to Find_Frames to take into account only the stack frames at the given depth level


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

--  The file declares the main procedure for the demonstration. The LEDs
--  will blink "in a circle" on the board. The blue user button generates
--  an interrupt that changes the direction.

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

with System;
with Interfaces;            use Interfaces;

with STM32.Button;          use STM32.Button;
with STM32.LCD;             use STM32.LCD;
with STM32.DMA2D.Interrupt; use STM32.DMA2D;
with STM32.RNG.Interrupts;  use STM32.RNG.Interrupts;

with Bitmapped_Drawing;     use Bitmapped_Drawing;
with Double_Buffer;         use Double_Buffer;

procedure Demo is
   use STM32;

   pragma Priority (System.Priority'First);

   type HSV_Color is record
      Hue : Byte;
      Sat : Byte;
      Val : Byte;
   end record;

   function To_RGB (Col : HSV_Color) return DMA2D_Color;
   --  Translates a Hue/Saturation/Value color into RGB

   type Coordinate is (X, Y);

   type Vector is array (Coordinate) of Float;

   function "+" (V1, V2 : Vector) return Vector
   is
   begin
      return (X => V1 (X) + V2 (X),
              Y => V1 (Y) + V2 (Y));
   end "+";

   function "-" (V1, V2 : Vector) return Vector
   is
   begin
      return (X => V1 (X) - V2 (X),
              Y => V1 (Y) - V2 (Y));
   end "-";

   function "*" (V1, V2 : Vector) return Float
   is
   begin
      return V1 (X) * V2 (X) + V1 (Y) * V2 (Y);
   end "*";

   function "*" (V : Vector; Val : Float) return Vector
   is
   begin
      return (V (X) * Val, V (Y) * Val);
   end "*";

   function "/" (V : Vector; Val : Float) return Vector
   is
   begin
      return (V (X) / Val, V (Y) / Val);
   end "/";

   type Moving_Object is record
      Center : Vector;
      Speed  : Vector;
      R      : Natural;
      Col    : HSV_Color;
      N_Hue  : Byte;
   end record;

   function I (F : Float) return Integer
     is (Integer (F));

   function Collides (M1, M2 : Moving_Object) return Boolean;
   procedure Handle_Collision (M1, M2 : in out Moving_Object);

   Objects      : array (1 .. 15) of Moving_Object;

   FG_Buffer    : DMA2D_Buffer;
   White_Background : Boolean := False;

   ------------
   -- To_RGB --
   ------------

   function To_RGB (Col : HSV_Color) return DMA2D_Color
   is
      V, S, H : Word;
      Region, FPart, p, q, t : Word;
      Ret     : DMA2D_Color;
   begin
      Ret.Alpha := 255;

      if Col.Sat = 0 then
         Ret.Red := Col.Val;
         Ret.Green := Col.Val;
         Ret.Blue  := Col.Val;

         return Ret;
      end if;

      V := Word (Col.Val);
      S := Word (Col.Sat);
      H := Word (Col.Hue);

      -- Hue in the range 0 .. 5
      Region := H / 43;
      --  Division reminder, multiplied by 6 to make it in range 0 .. 255
      FPart  := (H - (Region * 43)) * 6;

      P := Shift_Right (V * (255 - S), 8);
      Q := Shift_Right (V * (255 - Shift_Right (S * FPart, 8)), 8);
      T := Shift_Right (V * (255 - Shift_Right (S * (255 - FPart), 8)), 8);

      case Region is
         when 0 =>
            Ret.Red   := Byte (V);
            Ret.Green := Byte (T);
            Ret.Blue  := Byte (P);
         when 1 =>
            Ret.Red   := Byte (Q);
            Ret.Green := Byte (V);
            Ret.Blue  := Byte (P);
         when 2 =>
            Ret.Red   := Byte (P);
            Ret.Green := Byte (V);
            Ret.Blue  := Byte (T);
         when 3 =>
            Ret.Red   := Byte (P);
            Ret.Green := Byte (Q);
            Ret.Blue  := Byte (V);
         when 4 =>
            Ret.Red   := Byte (T);
            Ret.Green := Byte (P);
            Ret.Blue  := Byte (V);
         when others =>
            Ret.Red   := Byte (V);
            Ret.Green := Byte (P);
            Ret.Blue  := Byte (Q);
      end case;

      return Ret;
   end To_RGB;

   -------------
   -- Colides --
   -------------

   function Collides (M1, M2 : Moving_Object) return Boolean
   is
      Dist_Min_Square : constant Integer :=
                          (M1.R + M2.R) ** 2;
      M1_M2           : constant Vector := M2.Center - M1.Center;
      Dist_Square     : constant Integer :=
                          (I (M1_M2 (X)) ** 2 + I (M1_M2 (Y)) ** 2);
   begin
      return Dist_Square < Dist_Min_Square;
   end Collides;

   ----------------------
   -- Handle_Colisiton --
   ----------------------

   procedure Handle_Collision (M1, M2 : in out Moving_Object)
   is
      --  Dist: distance vector between the two objects
      Dist  : Vector;

      --  Projx: Projection of the speed of Mx on Dist
      Tmp   : Float;
      Proj1 : Vector;
      Proj2 : Vector;

      Tan_Sp1 : Vector;
      Tan_Sp2 : Vector;

      Sp1     : Vector;
      Sp2     : Vector;

      --  Simplified mass: equal to R^2
      Mass1   : constant Float := Float (M1.R ** 2);
      Mass2   : constant Float := Float (M2.R ** 2);
      dT      : Float := 0.0;
      Old1, Old2 : Vector;

   begin
      --  Move back before collision
      --  If we don't, then the balls might still be touching themselves
      --  after we execute this procedure, so collision is called a second
      --  time afterwards.
      Old1 := M1.Center;
      Old2 := M2.Center;
      loop
         dT := dT + 0.2;
         M1.Center := Old1 - M1.Speed * dT;
         M2.Center := Old2 - M2.Speed * dT;
         exit when not Collides (M1, M2);
      end loop;

      Dist := (M2.Center - M1.Center);

      --  Calculate the projection vector of the speeds on Dist
      Tmp := (M1.Speed * Dist) / (Dist * Dist);
      Proj1 := Dist * Tmp;
      Tmp := (M2.Speed * Dist) / (Dist * Dist);
      Proj2 := Dist * Tmp;

      --  Now retrieve the speed that is tangantial to dist
      Tan_Sp1 := M1.Speed - Proj1;
      Tan_Sp2 := M2.Speed - Proj2;

      --  Transfer the projected speed from one object to the other
      Sp1 := (Proj1 * (Mass1 - Mass2) + Proj2 * 2.0 * Mass2) / (Mass1 + Mass2);
      Sp2 := (Proj2 * (Mass2 - Mass1) + Proj1 * 2.0 * Mass1) / (Mass1 + Mass2);

      --  Calculate the final speed of the objects:
      --  initial tangantial speed + calculated projected speed
      M1.Speed := Sp1 + Tan_Sp1;
      M2.Speed := Sp2 + Tan_Sp2;

      --  Now replay from the time of the impact with the new speed
      M1.Center := M1.Center + M1.Speed * dT;
      M2.Center := M2.Center + M2.Speed * dT;
      M1.N_Hue  := M1.N_Hue + 32;
      M2.N_Hue  := M2.N_Hue + 32;
   end Handle_Collision;

   ----------------
   -- Init_Balls --
   ----------------

   procedure Init_Balls
   is
      Size   : constant Integer :=
                 Natural'Min (Pixel_Width, Pixel_Height);
      R_Min  : constant Natural :=
                 Size / 24;
      R_Var  : constant Word :=
                 Word (R_Min) * 4 / 5;
      SP_Max : constant Integer :=
                 Size / 7;
   begin
      for J in Objects'Range loop
         loop
            declare
               O     : Moving_Object renames Objects (J);
               R     : constant Integer :=
                         Integer (RNG.Interrupts.Random mod R_Var) + R_Min;
               Col   : constant Byte :=
                         Byte (RNG.Interrupts.Random mod 255);
               X_Raw : constant Word :=
                         (RNG.Interrupts.Random mod Word (Pixel_Width - 2 * R)) + Word (R);
               Y_Raw : constant Word :=
                         (RNG.Interrupts.Random mod Word (Pixel_Height - 2 * R)) + Word (R);
               Sp_X  : constant Integer :=
                         Integer (RNG.Interrupts.Random mod Word (SP_Max * 2 + 1)) - SP_Max;
               Sp_Y  : constant Integer :=
                         Integer (RNG.Interrupts.Random mod Word (SP_Max * 2 + 1)) - SP_Max;
               Redo  : Boolean := False;

            begin
               O :=
                 (Center => (Float (Natural (X_Raw) + R),
                             Float (Natural (Y_Raw) + R)),
                  Speed  => (Float (Sp_X) / 10.0,
                             Float (Sp_Y) / 10.0),
                  R      => R,
                  Col    => (Hue => Col,
                             Sat => 255,
                             Val => 255),
                  N_Hue  => Col);

               for K in Objects'First .. J - 1 loop
                  if Collides (O, Objects (K)) then
                     Redo := True;
                     exit;
                  end if;
               end loop;

               exit when not Redo;
            end;
         end loop;
      end loop;
   end Init_Balls;

begin
   STM32.LCD.Initialize (Pixel_Fmt_ARGB1555);
   STM32.DMA2D.Interrupt.Initialize;
   Double_Buffer.Initialize (Layer_Background => Layer_Double_Buffer,
                             Layer_Foreground => Layer_Inactive);
   STM32.RNG.Interrupts.Initialize_RNG;
   STM32.Button.Initialize;

   Init_Balls;

   loop
      if STM32.Button.Has_Been_Pressed then
         White_Background := not White_Background;
      end if;

      FG_Buffer := Double_Buffer.Get_Hidden_Buffer (Background);

      STM32.DMA2D.DMA2D_Fill
        (FG_Buffer,
         (if White_Background then White else Black));

      for M of Objects loop
         if M.N_Hue /= M.Col.Hue then
            M.Col.Hue := M.Col.Hue + 1;
         end if;
      end loop;

      for O of Objects loop
         O.Center := O.Center + O.Speed;

         if (O.Speed (X) < 0.0 and then I (O.Center (X)) <= O.R)
           or else (O.Speed (X) > 0.0
                    and then I (O.Center (X)) + O.R >= Pixel_Width - 1)
         then
            O.Speed (X) := -O.Speed (X);
            O.Center (X) := O.Center (X) + O.Speed (X);
         end if;

         if (O.Speed (Y) < 0.0 and then I (O.Center (Y)) <= O.R)
           or else (O.Speed (Y) > 0.0
                    and then I (O.Center (Y)) + O.R >= Pixel_Height - 1)
         then
            O.Speed (Y) := -O.Speed (Y);
            O.Center (Y) := O.Center (Y) + O.Speed (Y);
         end if;
      end loop;

      for J in Objects'First .. Objects'Last - 1 loop
         for K in J + 1 .. Objects'Last loop
            if Collides (Objects (J), Objects (K)) then
               Handle_Collision (Objects (J), Objects (K));
            end if;
         end loop;
      end loop;

      for O of Objects loop
         Fill_Circle
           (FG_Buffer,
            (X => I (O.Center (X)),
             Y => I (O.Center (Y))),
            O.R,
            To_RGB (O.Col));
      end loop;

      Swap_Buffers (Vsync => True);
   end loop;
end Demo;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

--  The file declares the main procedure for the demonstration. The LEDs
--  will blink "in a circle" on the board. The blue user button generates
--  an interrupt that changes the direction.

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

with System;
with Interfaces;            use Interfaces;

with STM32.Button;          use STM32.Button;
with STM32.LCD;             use STM32.LCD;
with STM32.DMA2D.Interrupt; use STM32.DMA2D;
with STM32.RNG.Interrupts;  use STM32.RNG.Interrupts;

with Bitmapped_Drawing;     use Bitmapped_Drawing;
with Double_Buffer;         use Double_Buffer;

procedure Demo is
   use STM32;

   pragma Priority (System.Priority'First);

   type HSV_Color is record
      Hue : Byte;
      Sat : Byte;
      Val : Byte;
   end record;

   function To_RGB (Col : HSV_Color) return DMA2D_Color;
   --  Translates a Hue/Saturation/Value color into RGB

   type Coordinate is (X, Y);

   type Vector is array (Coordinate) of Float;

   function "+" (V1, V2 : Vector) return Vector
   is
   begin
      return (X => V1 (X) + V2 (X),
              Y => V1 (Y) + V2 (Y));
   end "+";

   function "-" (V1, V2 : Vector) return Vector
   is
   begin
      return (X => V1 (X) - V2 (X),
              Y => V1 (Y) - V2 (Y));
   end "-";

   function "*" (V1, V2 : Vector) return Float
   is
   begin
      return V1 (X) * V2 (X) + V1 (Y) * V2 (Y);
   end "*";

   function "*" (V : Vector; Val : Float) return Vector
   is
   begin
      return (V (X) * Val, V (Y) * Val);
   end "*";

   function "/" (V : Vector; Val : Float) return Vector
   is
   begin
      return (V (X) / Val, V (Y) / Val);
   end "/";

   type Moving_Object is record
      Center : Vector;
      Speed  : Vector;
      R      : Natural;
      Col    : HSV_Color;
      N_Hue  : Byte;
   end record;

   function I (F : Float) return Integer
     is (Integer (F));

   function Collides (M1, M2 : Moving_Object) return Boolean;
   procedure Handle_Collision (M1, M2 : in out Moving_Object);

   Objects      : array (1 .. 15) of Moving_Object;

   FG_Buffer    : DMA2D_Buffer;
   White_Background : Boolean := False;

   ------------
   -- To_RGB --
   ------------

   function To_RGB (Col : HSV_Color) return DMA2D_Color
   is
      V, S, H : Word;
      Region, FPart, p, q, t : Word;
      Ret     : DMA2D_Color;
   begin
      Ret.Alpha := 255;

      if Col.Sat = 0 then
         Ret.Red := Col.Val;
         Ret.Green := Col.Val;
         Ret.Blue  := Col.Val;

         return Ret;
      end if;

      V := Word (Col.Val);
      S := Word (Col.Sat);
      H := Word (Col.Hue);

      -- Hue in the range 0 .. 5
      Region := H / 43;
      --  Division reminder, multiplied by 6 to make it in range 0 .. 255
      FPart  := (H - (Region * 43)) * 6;

      P := Shift_Right (V * (255 - S), 8);
      Q := Shift_Right (V * (255 - Shift_Right (S * FPart, 8)), 8);
      T := Shift_Right (V * (255 - Shift_Right (S * (255 - FPart), 8)), 8);

      case Region is
         when 0 =>
            Ret.Red   := Byte (V);
            Ret.Green := Byte (T);
            Ret.Blue  := Byte (P);
         when 1 =>
            Ret.Red   := Byte (Q);
            Ret.Green := Byte (V);
            Ret.Blue  := Byte (P);
         when 2 =>
            Ret.Red   := Byte (P);
            Ret.Green := Byte (V);
            Ret.Blue  := Byte (T);
         when 3 =>
            Ret.Red   := Byte (P);
            Ret.Green := Byte (Q);
            Ret.Blue  := Byte (V);
         when 4 =>
            Ret.Red   := Byte (T);
            Ret.Green := Byte (P);
            Ret.Blue  := Byte (V);
         when others =>
            Ret.Red   := Byte (V);
            Ret.Green := Byte (P);
            Ret.Blue  := Byte (Q);
      end case;

      return Ret;
   end To_RGB;

   -------------
   -- Colides --
   -------------

   function Collides (M1, M2 : Moving_Object) return Boolean
   is
      Dist_Min_Square : constant Integer :=
                          (M1.R + M2.R) ** 2;
      M1_M2           : constant Vector := M2.Center - M1.Center;
      Dist_Square     : constant Integer :=
                          (I (M1_M2 (X)) ** 2 + I (M1_M2 (Y)) ** 2);
   begin
      return Dist_Square < Dist_Min_Square;
   end Collides;

   ----------------------
   -- Handle_Colisiton --
   ----------------------

   procedure Handle_Collision (M1, M2 : in out Moving_Object)
   is
      --  Dist: distance vector between the two objects
      Dist  : Vector;

      --  Projx: Projection of the speed of Mx on Dist
      Tmp   : Float;
      Proj1 : Vector;
      Proj2 : Vector;

      Tan_Sp1 : Vector;
      Tan_Sp2 : Vector;

      Sp1     : Vector;
      Sp2     : Vector;

      --  Simplified mass: equal to R^2
      Mass1   : constant Float := Float (M1.R ** 2);
      Mass2   : constant Float := Float (M2.R ** 2);
      dT      : Float := 0.0;
      Old1, Old2 : Vector;

   begin
      --  Move back before collision
      --  If we don't, then the balls might still be touching themselves
      --  after we execute this procedure, so collision is called a second
      --  time afterwards.
      Old1 := M1.Center;
      Old2 := M2.Center;
      loop
         dT := dT + 0.2;
         M1.Center := Old1 - M1.Speed * dT;
         M2.Center := Old2 - M2.Speed * dT;
         exit when not Collides (M1, M2);
      end loop;

      Dist := (M2.Center - M1.Center);

      --  Calculate the projection vector of the speeds on Dist
      Tmp := (M1.Speed * Dist) / (Dist * Dist);
      Proj1 := Dist * Tmp;
      Tmp := (M2.Speed * Dist) / (Dist * Dist);
      Proj2 := Dist * Tmp;

      --  Now retrieve the speed that is tangantial to dist
      Tan_Sp1 := M1.Speed - Proj1;
      Tan_Sp2 := M2.Speed - Proj2;

      --  Transfer the projected speed from one object to the other
      Sp1 := (Proj1 * (Mass1 - Mass2) + Proj2 * 2.0 * Mass2) / (Mass1 + Mass2);
      Sp2 := (Proj2 * (Mass2 - Mass1) + Proj1 * 2.0 * Mass1) / (Mass1 + Mass2);

      --  Calculate the final speed of the objects:
      --  initial tangantial speed + calculated projected speed
      M1.Speed := Sp1 + Tan_Sp1;
      M2.Speed := Sp2 + Tan_Sp2;

      --  Now replay from the time of the impact with the new speed
      M1.Center := M1.Center + M1.Speed * dT;
      M2.Center := M2.Center + M2.Speed * dT;
      M1.N_Hue  := M1.N_Hue + 32;
      M2.N_Hue  := M2.N_Hue + 32;
   end Handle_Collision;

   ----------------
   -- Init_Balls --
   ----------------

   procedure Init_Balls
   is
      Size   : constant Integer :=
                 Natural'Min (Pixel_Width, Pixel_Height);
      R_Min  : constant Natural :=
                 Size / 24;
      R_Var  : constant Word :=
                 Word (R_Min) * 4 / 5;
      SP_Max : constant Integer :=
                 Size / 7;
   begin
      for J in Objects'Range loop
         loop
            declare
               O     : Moving_Object renames Objects (J);
               R     : constant Integer :=
                         Integer (RNG.Interrupts.Random mod R_Var) + R_Min;
               Col   : constant Byte :=
                         Byte (RNG.Interrupts.Random mod 255);
               X_Raw : constant Word :=
                         (RNG.Interrupts.Random mod Word (Pixel_Width - 2 * R)) + Word (R);
               Y_Raw : constant Word :=
                         (RNG.Interrupts.Random mod Word (Pixel_Height - 2 * R)) + Word (R);
               Sp_X  : constant Integer :=
                         Integer (RNG.Interrupts.Random mod Word (SP_Max * 2 + 1)) - SP_Max;
               Sp_Y  : constant Integer :=
                         Integer (RNG.Interrupts.Random mod Word (SP_Max * 2 + 1)) - SP_Max;
               Redo  : Boolean := False;

            begin
               O :=
                 (Center => (Float (Natural (X_Raw) + R),
                             Float (Natural (Y_Raw) + R)),
                  Speed  => (Float (Sp_X) / 10.0,
                             Float (Sp_Y) / 10.0),
                  R      => R,
                  Col    => (Hue => Col,
                             Sat => 255,
                             Val => 255),
                  N_Hue  => Col);

               for K in Objects'First .. J - 1 loop
                  if Collides (O, Objects (K)) then
                     Redo := True;
                     exit;
                  end if;
               end loop;

               exit when not Redo;
            end;
         end loop;
      end loop;
   end Init_Balls;

begin
   STM32.LCD.Initialize (Pixel_Fmt_ARGB1555);
   STM32.DMA2D.Interrupt.Initialize;
   Double_Buffer.Initialize (Layer_Background => Layer_Double_Buffer,
                             Layer_Foreground => Layer_Inactive);
   STM32.RNG.Interrupts.Initialize_RNG;
   STM32.Button.Initialize;

   Init_Balls;

   loop
      if STM32.Button.Has_Been_Pressed then
         White_Background := not White_Background;
      end if;

      FG_Buffer := Double_Buffer.Get_Hidden_Buffer (Background);

      STM32.DMA2D.DMA2D_Fill
        (FG_Buffer,
         (if White_Background then DMA2D.White else DMA2D.Black));

      for M of Objects loop
         if M.N_Hue /= M.Col.Hue then
            M.Col.Hue := M.Col.Hue + 1;
         end if;
      end loop;

      for O of Objects loop
         O.Center := O.Center + O.Speed;

         if (O.Speed (X) < 0.0 and then I (O.Center (X)) <= O.R)
           or else (O.Speed (X) > 0.0
                    and then I (O.Center (X)) + O.R >= Pixel_Width - 1)
         then
            O.Speed (X) := -O.Speed (X);
            O.Center (X) := O.Center (X) + O.Speed (X);
         end if;

         if (O.Speed (Y) < 0.0 and then I (O.Center (Y)) <= O.R)
           or else (O.Speed (Y) > 0.0
                    and then I (O.Center (Y)) + O.R >= Pixel_Height - 1)
         then
            O.Speed (Y) := -O.Speed (Y);
            O.Center (Y) := O.Center (Y) + O.Speed (Y);
         end if;
      end loop;

      for J in Objects'First .. Objects'Last - 1 loop
         for K in J + 1 .. Objects'Last loop
            if Collides (Objects (J), Objects (K)) then
               Handle_Collision (Objects (J), Objects (K));
            end if;
         end loop;
      end loop;

      for O of Objects loop
         Fill_Circle
           (FG_Buffer,
            (X => I (O.Center (X)),
             Y => I (O.Center (Y))),
            O.R,
            To_RGB (O.Col));
      end loop;

      Swap_Buffers (Vsync => True);
   end loop;
end Demo;

Fix build issues with the 'balls' example.


-----------------------------------------------------------------------
--  awa-mail-clients-aws_smtp -- Mail client implementation on top of AWS SMTP client
--  Copyright (C) 2012, 2016, 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 Ada.Unchecked_Deallocation;

with AWS.SMTP.Client;

with Util.Log.Loggers;

package body AWA.Mail.Clients.AWS_SMTP is

   use Ada.Strings.Unbounded;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Mail.Clients.AWS_SMTP");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => AWS.SMTP.Recipients,
                                      Name   => Recipients_Access);

   --  Get a printable representation of the email recipients.
   function Image (Recipients : in AWS.SMTP.Recipients) return String;

   --  ------------------------------
   --  Set the <tt>From</tt> part of the message.
   --  ------------------------------
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String) is
   begin
      Message.From := AWS.SMTP.E_Mail (Name    => Name,
                                       Address => Address);
   end Set_From;

   --  ------------------------------
   --  Add a recipient for the message.
   --  ------------------------------
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is
      pragma Unreferenced (Kind);
   begin
      if Message.To = null then
         Message.To := new AWS.SMTP.Recipients (1 .. 1);
      else
         declare
            To : constant Recipients_Access := new AWS.SMTP.Recipients (1 .. Message.To'Last + 1);
         begin
            To (Message.To'Range) := Message.To.all;
            Free (Message.To);
            Message.To := To;
         end;
      end if;
      Message.To (Message.To'Last) := AWS.SMTP.E_Mail (Name    => Name,
                                                       Address => Address);
   end Add_Recipient;

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

   --  ------------------------------
   --  Set the body of the message.
   --  ------------------------------
   overriding
   procedure Set_Body (Message : in out AWS_Mail_Message;
                       Content : in String) is
   begin
      Message.Content := To_Unbounded_String (Content);
   end Set_Body;

   --  ------------------------------
   --  Get a printable representation of the email recipients.
   --  ------------------------------
   function Image (Recipients : in AWS.SMTP.Recipients) return String is
      Result : Unbounded_String;
   begin
      for I in Recipients'Range loop
         Append (Result, AWS.SMTP.Image (Recipients (I)));
      end loop;
      return To_String (Result);
   end Image;

   --  ------------------------------
   --  Send the email message.
   --  ------------------------------
   overriding
   procedure Send (Message : in out AWS_Mail_Message) is
      Result  : AWS.SMTP.Status;
   begin
      if Message.To = null then
         return;
      end if;

      if Message.Manager.Enable then
         Log.Info ("Send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
         AWS.SMTP.Client.Send (Server  => Message.Manager.Server,
                               From    => Message.From,
                               To      => Message.To.all,
                               Subject => To_String (Message.Subject),
                               Message => To_String (Message.Content),
                               Status  => Result);
         if not AWS.SMTP.Is_Ok (Result) then
            Log.Error ("Cannot send email: {0}",
                       AWS.SMTP.Status_Message (Result));
         end if;

      else
         Log.Info ("Disable send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
      end if;
   end Send;

   --  ------------------------------
   --  Deletes the mail message.
   --  ------------------------------
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message) is
   begin
      Log.Info ("Finalize mail message");
      Free (Message.To);
   end Finalize;

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

   --  ------------------------------
   --  Create a SMTP based mail manager and configure it according to the properties.
   --  ------------------------------
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access is
      Server : constant String := Props.Get (Name => "smtp.host", Default => "localhost");
      Port   : constant String := Props.Get (Name => "smtp.port", Default => "25");
      Enable : constant String := Props.Get (Name => "smtp.enable", Default => "1");
      Result : constant AWS_Mail_Manager_Access := new AWS_Mail_Manager;
   begin
      Log.Info ("Creating SMTP mail manager to server {0}:{1}", Server, Port);

      Result.Port   := Positive'Value (Port);
      Result.Enable := Enable = "1" or Enable = "yes" or Enable = "true";
      Result.Self   := Result;
      Initialize (Result.all, Props);
      return Result.all'Access;
   end Create_Manager;

   --  ------------------------------
   --  Create a new mail message.
   --  ------------------------------
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access is
      Result : constant AWS_Mail_Message_Access := new AWS_Mail_Message;
   begin
      Result.Manager := Manager.Self;
      return Result.all'Access;
   end Create_Message;

end AWA.Mail.Clients.AWS_SMTP;

-----------------------------------------------------------------------
--  awa-mail-clients-aws_smtp -- Mail client implementation on top of AWS SMTP client
--  Copyright (C) 2012, 2016, 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 Ada.Unchecked_Deallocation;

with AWS.MIME;
with AWS.SMTP.Client;

with Util.Log.Loggers;

package body AWA.Mail.Clients.AWS_SMTP is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Mail.Clients.AWS_SMTP");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => AWS.SMTP.Recipients,
                                      Name   => Recipients_Access);

   --  Get a printable representation of the email recipients.
   function Image (Recipients : in AWS.SMTP.Recipients) return String;

   --  ------------------------------
   --  Set the <tt>From</tt> part of the message.
   --  ------------------------------
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String) is
   begin
      Message.From := AWS.SMTP.E_Mail (Name    => Name,
                                       Address => Address);
   end Set_From;

   --  ------------------------------
   --  Add a recipient for the message.
   --  ------------------------------
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is
      pragma Unreferenced (Kind);
   begin
      if Message.To = null then
         Message.To := new AWS.SMTP.Recipients (1 .. 1);
      else
         declare
            To : constant Recipients_Access := new AWS.SMTP.Recipients (1 .. Message.To'Last + 1);
         begin
            To (Message.To'Range) := Message.To.all;
            Free (Message.To);
            Message.To := To;
         end;
      end if;
      Message.To (Message.To'Last) := AWS.SMTP.E_Mail (Name    => Name,
                                                       Address => Address);
   end Add_Recipient;

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

   --  ------------------------------
   --  Set the body of the message.
   --  ------------------------------
   overriding
   procedure Set_Body (Message      : in out AWS_Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String) is
   begin
      if Length (Alternative) = 0 then
         AWS.Attachments.Add (Message.Attachments, "",
                              AWS.Attachments.Value (Content));
      else
         AWS.Attachments.Add (Message.Attachments, "",
                              AWS.Attachments.Value (Content,
                                Content_Type => Content_Type));
      end if;
   end Set_Body;

   --  ------------------------------
   --  Add an attachment with the given content.
   --  ------------------------------
   overriding
   procedure Add_Attachment (Message      : in out AWS_Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String) is
      Data : constant AWS.Attachments.Content
        := AWS.Attachments.Value (Data => Content,
                                  Content_Id => Content_Id,
                                  Content_Type => Content_Type);
   begin
      AWS.Attachments.Add (Attachments => Message.Attachments,
                           Name => Content_Id,
                           Data => Data);
   end Add_Attachment;

   --  ------------------------------
   --  Get a printable representation of the email recipients.
   --  ------------------------------
   function Image (Recipients : in AWS.SMTP.Recipients) return String is
      Result : Unbounded_String;
   begin
      for I in Recipients'Range loop
         Append (Result, AWS.SMTP.Image (Recipients (I)));
      end loop;
      return To_String (Result);
   end Image;

   --  ------------------------------
   --  Send the email message.
   --  ------------------------------
   overriding
   procedure Send (Message : in out AWS_Mail_Message) is
      Result   : AWS.SMTP.Status;
   begin
      if Message.To = null then
         return;
      end if;

      if Message.Manager.Enable then
         Log.Info ("Send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));

         AWS.SMTP.Client.Send (Server  => Message.Manager.Server,
                               From    => Message.From,
                               To      => Message.To.all,
                               Subject => To_String (Message.Subject),
                               Attachments => Message.Attachments,
                               Status  => Result);
         if not AWS.SMTP.Is_Ok (Result) then
            Log.Error ("Cannot send email: {0}",
                       AWS.SMTP.Status_Message (Result));
         end if;

      else
         Log.Info ("Disable send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
      end if;
   end Send;

   --  ------------------------------
   --  Deletes the mail message.
   --  ------------------------------
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message) is
   begin
      Log.Info ("Finalize mail message");
      Free (Message.To);
   end Finalize;

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

   --  ------------------------------
   --  Create a SMTP based mail manager and configure it according to the properties.
   --  ------------------------------
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access is
      Server : constant String := Props.Get (Name => "smtp.host", Default => "localhost");
      Port   : constant String := Props.Get (Name => "smtp.port", Default => "25");
      Enable : constant String := Props.Get (Name => "smtp.enable", Default => "1");
      Result : constant AWS_Mail_Manager_Access := new AWS_Mail_Manager;
   begin
      Log.Info ("Creating SMTP mail manager to server {0}:{1}", Server, Port);

      Result.Port   := Positive'Value (Port);
      Result.Enable := Enable = "1" or Enable = "yes" or Enable = "true";
      Result.Self   := Result;
      Initialize (Result.all, Props);
      return Result.all'Access;
   end Create_Manager;

   --  ------------------------------
   --  Create a new mail message.
   --  ------------------------------
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access is
      Result : constant AWS_Mail_Message_Access := new AWS_Mail_Message;
   begin
      Result.Manager := Manager.Self;
      return Result.all'Access;
   end Create_Message;

end AWA.Mail.Clients.AWS_SMTP;

Implement Add_Attachment, Set_Body and send a mail with attachment


with Ada.Containers;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with OpenAL.Context.Error;
with OpenAL.Context;
with OpenAL.List;
with Test;

procedure alc_001 is
  package ALC       renames OpenAL.Context;
  package ALC_Error renames OpenAL.Context.Error;
  package List      renames OpenAL.List;

  Device    : ALC.Device_t;
  No_Device : ALC.Device_t;
  Context   : ALC.Context_t;
  OK        : Boolean;
  Caught    : Boolean;
  Devices   : List.String_Vector_t;

  use type ALC.Device_t;
  use type ALC.Context_t;
  use type ALC_Error.Error_t;

  procedure Init is
  begin
    Device := ALC.Open_Default_Device;
    pragma Assert (Device /= ALC.Invalid_Device);
    Context := ALC.Create_Context (Device);
    pragma Assert (Context /= ALC.Invalid_Context);
    OK := ALC.Make_Context_Current (Context);
    pragma Assert (OK);
  end Init;

  procedure Finish is
  begin
    ALC.Destroy_Context (Context);
    OK := ALC.Close_Device (Device);
    pragma Assert (OK);
  end Finish;

begin
  Test.Initialize ("alc_001");

  Init;

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "DEFAULT_DEVICE_SPEC              : " & ALC.Get_Default_Device_Specifier);
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "DEVICE_SPEC                      : " & ALC.Get_Device_Specifier (Device));

  begin
    Caught := False;
    Ada.Text_IO.Put_Line (Test.Output_File, ALC.Get_Device_Specifier (No_Device));
  exception
    when Ada.IO_Exceptions.Device_Error => Caught := True;
  end;
  Test.Check_Test (61, "caught device error for device spec with null device", Caught);

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "EXTENSIONS                       : " & ALC.Get_Extensions (Device));

  begin
    Caught := False;
    Ada.Text_IO.Put_Line (Test.Output_File, ALC.Get_Extensions (No_Device));
  exception
    when Ada.IO_Exceptions.Device_Error => Caught := True;
  end;
  Test.Check_Test (62, "caught device error for extensions with null device", Caught);

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "DEFAULT_CAPTURE_DEVICE_SPECIFIER : " & ALC.Get_Default_Capture_Device_Specifier);

  Devices := ALC.Get_Available_Capture_Devices;

  if List.String_Vectors.Is_Empty (Devices) = False then
    Ada.Text_IO.Put_Line
      (File => Test.Output_File,
       Item => "DEVICE COUNT: " & Ada.Containers.Count_Type'Image (List.String_Vectors.Length (Devices)));

    declare
      procedure Process_Element (Device : in String) is
      begin
        Ada.Text_IO.Put_Line
          (File => Test.Output_File,
           Item => "CAPTURE_DEVICE: " & Device);
      end Process_Element;
    begin
      for Index in
        List.String_Vectors.First_Index (Devices) ..
        List.String_Vectors.Last_Index (Devices)
      loop
        List.String_Vectors.Query_Element (Devices, Index, Process_Element'Access);
      end loop;
    end;
  end if;

  Test.Check_Test (63, "handled available capture devices", True);

  Finish;

  Test.Finish;
end alc_001;

with Ada.Containers;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with OpenAL.Context.Error;
with OpenAL.Context;
with OpenAL.List;
with OpenAL.Types;
with Test;

procedure alc_001 is
  package ALC       renames OpenAL.Context;
  package ALC_Error renames OpenAL.Context.Error;
  package List      renames OpenAL.List;

  Device    : ALC.Device_t;
  No_Device : ALC.Device_t;
  Context   : ALC.Context_t;
  OK        : Boolean;
  Caught    : Boolean;
  Devices   : List.String_Vector_t;

  use type ALC.Device_t;
  use type ALC.Context_t;
  use type ALC_Error.Error_t;

  procedure Init is
  begin
    Device := ALC.Open_Default_Device;
    pragma Assert (Device /= ALC.Invalid_Device);
    Context := ALC.Create_Context (Device);
    pragma Assert (Context /= ALC.Invalid_Context);
    OK := ALC.Make_Context_Current (Context);
    pragma Assert (OK);
  end Init;

  procedure Finish is
  begin
    ALC.Destroy_Context (Context);
    OK := ALC.Close_Device (Device);
    pragma Assert (OK);
  end Finish;

begin
  Test.Initialize ("alc_001");

  Init;

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "DEFAULT_DEVICE_SPEC              : " & ALC.Get_Default_Device_Specifier);
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "DEVICE_SPEC                      : " & ALC.Get_Device_Specifier (Device));

  begin
    Caught := False;
    Ada.Text_IO.Put_Line (Test.Output_File, ALC.Get_Device_Specifier (No_Device));
  exception
    when Ada.IO_Exceptions.Device_Error => Caught := True;
  end;
  Test.Check_Test (61, "caught device error for device spec with null device", Caught);

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "EXTENSIONS                       : " & ALC.Get_Extensions (Device));

  begin
    Caught := False;
    Ada.Text_IO.Put_Line (Test.Output_File, ALC.Get_Extensions (No_Device));
  exception
    when Ada.IO_Exceptions.Device_Error => Caught := True;
  end;
  Test.Check_Test (62, "caught device error for extensions with null device", Caught);

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "DEFAULT_CAPTURE_DEVICE_SPECIFIER : " & ALC.Get_Default_Capture_Device_Specifier);

  Devices := ALC.Get_Available_Capture_Devices;

  if List.String_Vectors.Is_Empty (Devices) = False then
    Ada.Text_IO.Put_Line
      (File => Test.Output_File,
       Item => "DEVICE COUNT: " & Ada.Containers.Count_Type'Image (List.String_Vectors.Length (Devices)));

    declare
      procedure Process_Element (Device : in String) is
      begin
        Ada.Text_IO.Put_Line
          (File => Test.Output_File,
           Item => "CAPTURE_DEVICE: " & Device);
      end Process_Element;
    begin
      for Index in
        List.String_Vectors.First_Index (Devices) ..
        List.String_Vectors.Last_Index (Devices)
      loop
        List.String_Vectors.Query_Element (Devices, Index, Process_Element'Access);
      end loop;
    end;
  end if;

  Test.Check_Test (63, "handled available capture devices", True);

  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "MAJOR_VERSION                    : " & Natural'Image (ALC.Get_Major_Version (Device)));
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "MINOR_VERSION                    : " & Natural'Image (ALC.Get_Minor_Version (Device)));
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "FREQUENCY                        : " & OpenAL.Types.Frequency_t'Image (ALC.Get_Frequency (Device)));
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "REFRESH_RATE                     : " & Natural'Image (ALC.Get_Refresh (Device)));
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "MONO_SOURCES                     : " & Natural'Image (ALC.Get_Mono_Sources (Device)));
  Ada.Text_IO.Put_Line
    (File => Test.Output_File,
     Item => "STEREO_SOURCES                   : " & Natural'Image (ALC.Get_Stereo_Sources (Device)));

  Finish;

  Test.Finish;
end alc_001;

Call integer queries

Call integer queries


-----------------------------------------------------------------------
--  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.Commands.Drivers;
with Util.Commands.Consoles;
with Util.Commands.Consoles.Text;
with Druss.Gateways;
package Druss.Commands is

   --  Device selector to select all, active or inactive devices.
   type Device_Selector_Type is (DEVICE_ALL, DEVICE_ACTIVE, DEVICE_INACTIVE);

   --  The list of fields that are printed on the console.
   type Field_Type is (F_IP_ADDR,
                       F_BBOX_IP_ADDR,
                       F_WAN_IP,
                       F_ETHERNET,
                       F_INTERNET,
                       F_VOIP,
                       F_HOSTNAME,
                       F_CONNECTION,
                       F_DEVTYPE,
                       F_ACTIVE,
                       F_LINK,
                       F_WIFI,
                       F_WIFI5,
                       F_ACCESS_CONTROL,
                       F_DYNDNS,
                       F_DEVICES,
                       F_UPTIME,
                       F_COUNT,
                       F_BOOL,
                       F_CHANNEL,
                       F_PROTOCOL,
                       F_ENCRYPTION,
                       F_SSID);

   --  The type of notice that are reported.
   type Notice_Type is (N_HELP,
                        N_USAGE,
                        N_INFO);

   --  Make the generic abstract console interface.
   package Consoles is
     new Util.Commands.Consoles (Field_Type  => Field_Type,
                                 Notice_Type => Notice_Type);

   --  And the text console to write on stdout (a Gtk console could be done someday).
   package Text_Consoles is
      new Consoles.Text;

   type Context_Type is limited record
      Gateways : Druss.Gateways.Gateway_Vector;
      Console  : Consoles.Console_Access;
   end record;

   package Drivers is
     new Util.Commands.Drivers (Context_Type => Context_Type,
                                Driver_Name  => "druss-drivers");

   subtype Argument_List is Util.Commands.Argument_List;

   Driver : Drivers.Driver_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);

   procedure Initialize;

   --  Enter in the interactive main loop waiting for user commands and executing them.
   procedure Interactive (Context : in out Context_Type);

   --  Print the bbox API status.
   procedure Print_Status (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String);

   --  Print a ON/OFF status.
   procedure Print_On_Off (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String);

   --  Print a uptime.
   procedure Print_Uptime (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String);

   --  Print a performance measure in us or ms.
   procedure Print_Perf (Console : in Consoles.Console_Access;
                         Field   : in Field_Type;
                         Value   : in String);

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.Commands.Drivers;
with Util.Commands.Consoles;
with Util.Commands.Consoles.Text;
with Druss.Gateways;
package Druss.Commands is

   --  Exception raised to stop the interactive loop.
   Stop_Interactive : exception;

   --  Device selector to select all, active or inactive devices.
   type Device_Selector_Type is (DEVICE_ALL, DEVICE_ACTIVE, DEVICE_INACTIVE);

   --  The list of fields that are printed on the console.
   type Field_Type is (F_IP_ADDR,
                       F_BBOX_IP_ADDR,
                       F_WAN_IP,
                       F_ETHERNET,
                       F_INTERNET,
                       F_VOIP,
                       F_HOSTNAME,
                       F_CONNECTION,
                       F_DEVTYPE,
                       F_ACTIVE,
                       F_LINK,
                       F_WIFI,
                       F_WIFI5,
                       F_ACCESS_CONTROL,
                       F_DYNDNS,
                       F_DEVICES,
                       F_UPTIME,
                       F_COUNT,
                       F_BOOL,
                       F_CHANNEL,
                       F_PROTOCOL,
                       F_ENCRYPTION,
                       F_SSID);

   --  The type of notice that are reported.
   type Notice_Type is (N_HELP,
                        N_USAGE,
                        N_INFO);

   --  Make the generic abstract console interface.
   package Consoles is
     new Util.Commands.Consoles (Field_Type  => Field_Type,
                                 Notice_Type => Notice_Type);

   --  And the text console to write on stdout (a Gtk console could be done someday).
   package Text_Consoles is
      new Consoles.Text;

   type Context_Type is limited record
      Gateways : Druss.Gateways.Gateway_Vector;
      Console  : Consoles.Console_Access;
   end record;

   package Drivers is
     new Util.Commands.Drivers (Context_Type => Context_Type,
                                Driver_Name  => "druss-drivers");

   subtype Argument_List is Util.Commands.Argument_List;

   Driver : Drivers.Driver_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);

   procedure Initialize;

   --  Enter in the interactive main loop waiting for user commands and executing them.
   procedure Interactive (Context : in out Context_Type);

   --  Print the bbox API status.
   procedure Print_Status (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String);

   --  Print a ON/OFF status.
   procedure Print_On_Off (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String);

   --  Print a uptime.
   procedure Print_Uptime (Console : in Consoles.Console_Access;
                           Field   : in Field_Type;
                           Value   : in String);

   --  Print a performance measure in us or ms.
   procedure Print_Perf (Console : in Consoles.Console_Access;
                         Field   : in Field_Type;
                         Value   : in String);

end Druss.Commands;

Declare the Stop_Interactive exception

Declare the Stop_Interactive exception


-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014 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 Bfd.Sections;
package body MAT.Symbols.Targets is

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Bfd.Files.Open (Symbols.File, Path, "");
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   procedure Open (Symbols : in out Library_Symbols;
                   Path    : in String) is
   begin
      Bfd.Files.Open (Symbols.File, Path, "");
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   --  ------------------------------
   --  Load the symbols associated with a shared library described by the memory region.
   --  ------------------------------
   procedure Load_Symbols (Symbols : in out Target_Symbols;
                           Region  : in MAT.Memory.Region_Info) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Find (Region.Start_Addr);
      Syms : Library_Symbols_Ref;
   begin
      if not Symbols_Maps.Has_Element (Pos) then
         Syms := Library_Symbols_Refs.Create;
         Syms.Value.Start_Addr := Region.Start_Addr;
         Syms.Value.End_Addr   := Region.End_Addr;
         Symbols.Libraries.Insert (Region.Start_Addr, Syms);
      else
         Syms := Symbols_Maps.Element (Pos);
      end if;
      Open (Syms.Value.all, Ada.Strings.Unbounded.To_String (Region.Path));
   end Load_Symbols;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Name    : out Ada.Strings.Unbounded.Unbounded_String;
                                Func    : out Ada.Strings.Unbounded.Unbounded_String;
                                Line    : out Natural) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
      Text_Section : Bfd.Sections.Section;
   begin
      Line := 0;
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms   : Library_Symbols_Ref := Symbols_Maps.Element (Pos);
            Offset : constant Bfd.Vma_Type := Bfd.Vma_Type (Addr - Syms.Value.Start_Addr);
         begin
            if Syms.Value.End_Addr > Addr then
               if Bfd.Files.Is_Open (Syms.Value.File) then
                  Text_Section := Bfd.Sections.Find_Section (Syms.Value.File, ".text");
                  Bfd.Symbols.Find_Nearest_Line (File    => Syms.Value.File,
                                                 Sec     => Text_Section,
                                                 Symbols => Syms.Value.Symbols,
                                                 Addr    => Offset,
                                                 Name    => Name,
                                                 Func    => Func,
                                                 Line    => Line);
                  return;
               end if;
            end if;
         end;
      end if;
      if Bfd.Files.Is_Open (Symbols.File) then
         Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
         Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                        Sec     => Text_Section,
                                        Symbols => Symbols.Symbols,
                                        Addr    => Bfd.Vma_Type (Addr),
                                        Name    => Name,
                                        Func    => Func,
                                        Line    => Line);
      else
         Line := 0;
         Name := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Func := Ada.Strings.Unbounded.To_Unbounded_String ("");
      end if;

   exception
      when Bfd.NOT_FOUND =>
         Line := 0;
         Name := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Func := Ada.Strings.Unbounded.To_Unbounded_String ("");
   end Find_Nearest_Line;

end MAT.Symbols.Targets;

-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files 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 Bfd.Sections;
with Util.Log.Loggers;
package body MAT.Symbols.Targets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Symbols.Targets");

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Log.Info ("Loading symbols from {0}", Path);

      Bfd.Files.Open (Symbols.File, Path, "");
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   procedure Open (Symbols : in out Region_Symbols;
                   Path    : in String) is
   begin
      Log.Info ("Loading symbols from {0}", Path);

      Bfd.Files.Open (Symbols.File, Path, "");
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   --  ------------------------------
   --  Load the symbols associated with a shared library described by the memory region.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Find (Region.Start_Addr);
      Syms : Region_Symbols_Ref;
   begin
      if not Symbols_Maps.Has_Element (Pos) then
         Syms := Region_Symbols_Refs.Create;
         Syms.Value.Region := Region;
         Syms.Value.Offset := Offset_Addr;
         Symbols.Libraries.Insert (Region.Start_Addr, Syms);
      else
         Syms := Symbols_Maps.Element (Pos);
      end if;
      if Ada.Strings.Unbounded.Length (Region.Path) > 0 then
         Open (Syms.Value.all, Ada.Strings.Unbounded.To_String (Region.Path));
      end if;
   end Load_Symbols;

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Name    : out Ada.Strings.Unbounded.Unbounded_String;
                                Func    : out Ada.Strings.Unbounded.Unbounded_String;
                                Line    : out Natural) is
      use type Bfd.Vma_Type;

      Text_Section : Bfd.Sections.Section;
      Pc : Bfd.Vma_Type := Bfd.Vma_Type (Addr);
   begin
      if not Bfd.Files.Is_Open (Symbols.File) then
         Func := Symbols.Region.Path;
         return;
      end if;
      Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
--        if Text_Section.Vma > Pc or else Text_Section.Vma + Text_Section.Size < Pc then
--
--        end if;
      Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                     Sec     => Text_Section,
                                     Symbols => Symbols.Symbols,
                                     Addr    => Pc,
                                     Name    => Name,
                                     Func    => Func,
                                     Line    => Line);
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Name    : out Ada.Strings.Unbounded.Unbounded_String;
                                Func    : out Ada.Strings.Unbounded.Unbounded_String;
                                Line    : out Natural) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
      Text_Section : Bfd.Sections.Section;
   begin
      Line := 0;
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms   : Region_Symbols_Ref := Symbols_Maps.Element (Pos);
         begin
            if Syms.Value.Region.End_Addr > Addr then
               Find_Nearest_Line (Symbols => Syms.Value.all,
                                  Addr    => Addr - Syms.Value.Offset,
                                  Name    => Name,
                                  Func    => Func,
                                  Line    => Line);
               return;
            end if;
         end;
      end if;
      if Bfd.Files.Is_Open (Symbols.File) then
         Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
         Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                        Sec     => Text_Section,
                                        Symbols => Symbols.Symbols,
                                        Addr    => Bfd.Vma_Type (Addr),
                                        Name    => Name,
                                        Func    => Func,
                                        Line    => Line);
      else
         Line := 0;
         Name := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Func := Ada.Strings.Unbounded.To_Unbounded_String ("");
      end if;

   exception
      when Bfd.NOT_FOUND =>
         Line := 0;
         Name := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Func := Ada.Strings.Unbounded.To_Unbounded_String ("");
   end Find_Nearest_Line;

end MAT.Symbols.Targets;

Update the Load_Symbols and Find_Nearest_Line to search for the main symbol or a library symbol