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

--  = Authentication =
--  The `Security.Auth` package implements an authentication framework that is
--  suitable for OpenID 2.0, OAuth 2.0 and later for OpenID Connect.  It allows an application
--  to authenticate users using an external authorization server such as Google, Facebook,
--  Google +, Twitter and others.
--
--  See OpenID Authentication 2.0 - Final
--  https://openid.net/specs/openid-authentication-2_0.html
--
--  See OpenID Connect Core 1.0
--  https://openid.net/specs/openid-connect-core-1_0.html
--
--  See Facebook API: The Login Flow for Web (without JavaScript SDK)
--  https://developers.facebook.com/docs/facebook-login/login-flow-for-web-no-jssdk/
--
--  Despite their subtle differences, all these authentication frameworks share almost
--  a common flow.  The API provided by `Security.Auth` defines an abstraction suitable
--  for all these frameworks.
--
--  There are basically two steps that an application must implement:
--
--    * `Discovery`: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * `Verify`: to decode the authentication and check its result.
--
--  [[images/OpenID.png]]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The `Verify` procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  == Initialization ==
--  The initialization process must be done before each two steps (discovery and verify).
--  The Authentication manager must be declared and configured.
--
--    Mgr   : Security.Auth.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the Auth realm and set the authentication return callback URL.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify",
--                    Realm     => "openid");
--
--  After this initialization, the authentication manager can be used in the authentication
--  process.
--
--  @include security-auth-openid.ads
--  @include security-auth-oauth-googleplus.ads
--
--  == Discovery: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenID manager, discover the OpenID provider,
--  do the association and get an End_Point.  The OpenID provider is specified as an
--  URL, below is an example for Google OpenID:
--
--    Provider : constant String := "https://www.google.com/accounts/o8/id";
--    OP       : Security.Auth.End_Point;
--    Assoc    : constant Security.Auth.Association_Access := new Security.Auth.Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Verify: acknowledge the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc      : Association_Access := ...;  --  Get the association saved in the session.
--    Credential : Security.Auth.Authentication;
--    Params     : Auth_Params;
--
--  The auth manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Credential);
--    if Security.Auth.Get_Status (Credential) = Security.Auth.AUTHENTICATED then ...  -- Success.
--
--  == Principal creation ==
--  After the user is successfully authenticated, a user principal can be created and saved in
--  the session.  The user principal can then be used to assign permissions to that user and
--  enforce the application permissions using the security policy manger.
--
--    P : Security.Auth.Principal_Access := Security.Auth.Create_Principal (Credential);
--
package Security.Auth is

   --  Use an authentication server implementing OpenID 2.0.
   PROVIDER_OPENID   : constant String := "openid";

   --  Use the Facebook OAuth 2.0 - draft 12 authentication server.
   PROVIDER_FACEBOOK : constant String := "facebook";

   --  Use the Google+ OpenID Connect Basic Client
   PROVIDER_GOOGLE_PLUS : constant String := "google-plus";

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  Auth provider
   --  ------------------------------
   --  The End_Point represents the authentication provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The association contains the shared secret between the relying party
   --  and the authentication provider.  The association can be cached and reused to authenticate
   --  different users using the same authentication provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Get the provider.
   function Get_Provider (Assoc : in Association) return String;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  Authentication result
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  Default principal
   --  ------------------------------
   type Principal is new Security.Principal with private;
   type Principal_Access is access all Principal'Class;

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

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  Authentication Manager
   --  ------------------------------
   --  The Manager provides the core operations for the authentication process.
   type Manager is tagged limited private;
   type Manager_Access is access all Manager'Class;

   --  Initialize the authentication realm.
   procedure Initialize (Realm  : in out Manager;
                         Params : in Parameters'Class;
                         Name   : in String := PROVIDER_OPENID);
   procedure Initialize (Realm   : in out Manager;
                         Params  : in Parameters'Class;
                         Factory : not null
                         access function (Name : in String) return Manager_Access;
                         Name    : in String := PROVIDER_OPENID);

   --  Discover the authentication provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.  The discover step may do nothing for
   --  authentication providers based on OAuth.
   --  (See OpenID Section 7.3 Discovery)
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the authentication provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Default factory used by `Initialize`.  It supports OpenID, Google, Facebook.
   function Default_Factory (Provider : in String) return Manager_Access;

   type Factory_Access is not
     null access function (Provider : in String) return Manager_Access;

   --  Set the default factory to use.
   procedure Set_Default_Factory (Factory : in Factory_Access);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Provider     : Unbounded_String;
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Provider  : Unbounded_String;
      Delegate  : Manager_Access;
   end record;

   overriding
   procedure Finalize (Realm : in out Manager);

   type Principal is new Security.Principal with record
      Auth : Authentication;
   end record;

   procedure Set_Result (Result  : in out Authentication;
                         Status  : in Auth_Result;
                         Message : in String);

end Security.Auth;

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

--  = Authentication =
--  The `Security.Auth` package implements an authentication framework that is
--  suitable for OpenID 2.0, OAuth 2.0 and later for OpenID Connect.  It allows an application
--  to authenticate users using an external authorization server such as Google, Facebook,
--  Google +, Twitter and others.
--
--  See OpenID Authentication 2.0 - Final
--  https://openid.net/specs/openid-authentication-2_0.html
--
--  See OpenID Connect Core 1.0
--  https://openid.net/specs/openid-connect-core-1_0.html
--
--  See Facebook API: The Login Flow for Web (without JavaScript SDK)
--  https://developers.facebook.com/docs/facebook-login/login-flow-for-web-no-jssdk/
--
--  Despite their subtle differences, all these authentication frameworks share almost
--  a common flow.  The API provided by `Security.Auth` defines an abstraction suitable
--  for all these frameworks.
--
--  There are basically two steps that an application must implement:
--
--    * `Discovery`: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * `Verify`: to decode the authentication and check its result.
--
--  [[images/OpenID.png]]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The `Verify` procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  == Initialization ==
--  The initialization process must be done before each two steps (discovery and verify).
--  The Authentication manager must be declared and configured.
--
--    Mgr   : Security.Auth.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the Auth realm and set the authentication return callback URL.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify",
--                    Realm     => "openid");
--
--  After this initialization, the authentication manager can be used in the authentication
--  process.
--
--  @include security-auth-openid.ads
--  @include security-auth-oauth-googleplus.ads
--
--  == Discovery: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenID manager, discover the OpenID provider,
--  do the association and get an End_Point.  The OpenID provider is specified as an
--  URL, below is an example for Google OpenID:
--
--    Provider : constant String := "https://www.google.com/accounts/o8/id";
--    OP       : Security.Auth.End_Point;
--    Assoc    : constant Security.Auth.Association_Access := new Security.Auth.Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Verify: acknowledge the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc      : Association_Access := ...;  --  Get the association saved in the session.
--    Credential : Security.Auth.Authentication;
--    Params     : Auth_Params;
--
--  The auth manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Credential);
--    if Security.Auth.Get_Status (Credential) = Security.Auth.AUTHENTICATED then ...  -- Success.
--
--  == Principal creation ==
--  After the user is successfully authenticated, a user principal can be created and saved in
--  the session.  The user principal can then be used to assign permissions to that user and
--  enforce the application permissions using the security policy manger.
--
--    P : Security.Auth.Principal_Access := Security.Auth.Create_Principal (Credential);
--
package Security.Auth is

   --  Use an authentication server implementing OpenID 2.0.
   PROVIDER_OPENID   : constant String := "openid";

   --  Use the Facebook OAuth 2.0 - draft 12 authentication server.
   PROVIDER_FACEBOOK : constant String := "facebook";

   --  Use the Google+ OpenID Connect Basic Client
   PROVIDER_GOOGLE_PLUS : constant String := "google-plus";

   --  Use the Yahoo! OpenID Connect Basic Client
   PROVIDER_YAHOO : constant String := "yahoo";

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  Auth provider
   --  ------------------------------
   --  The End_Point represents the authentication provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The association contains the shared secret between the relying party
   --  and the authentication provider.  The association can be cached and reused to authenticate
   --  different users using the same authentication provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Get the provider.
   function Get_Provider (Assoc : in Association) return String;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  Authentication result
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  Default principal
   --  ------------------------------
   type Principal is new Security.Principal with private;
   type Principal_Access is access all Principal'Class;

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

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  Authentication Manager
   --  ------------------------------
   --  The Manager provides the core operations for the authentication process.
   type Manager is tagged limited private;
   type Manager_Access is access all Manager'Class;

   --  Initialize the authentication realm.
   procedure Initialize (Realm  : in out Manager;
                         Params : in Parameters'Class;
                         Name   : in String := PROVIDER_OPENID);
   procedure Initialize (Realm   : in out Manager;
                         Params  : in Parameters'Class;
                         Factory : not null
                         access function (Name : in String) return Manager_Access;
                         Name    : in String := PROVIDER_OPENID);

   --  Discover the authentication provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.  The discover step may do nothing for
   --  authentication providers based on OAuth.
   --  (See OpenID Section 7.3 Discovery)
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the authentication provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Default factory used by `Initialize`.  It supports OpenID, Google, Facebook.
   function Default_Factory (Provider : in String) return Manager_Access;

   type Factory_Access is not
     null access function (Provider : in String) return Manager_Access;

   --  Set the default factory to use.
   procedure Set_Default_Factory (Factory : in Factory_Access);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Provider     : Unbounded_String;
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
      Nonce        : Unbounded_String;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Provider  : Unbounded_String;
      Delegate  : Manager_Access;
   end record;

   overriding
   procedure Finalize (Realm : in out Manager);

   type Principal is new Security.Principal with record
      Auth : Authentication;
   end record;

   procedure Set_Result (Result  : in out Authentication;
                         Status  : in Auth_Result;
                         Message : in String);

end Security.Auth;

Add Nonce to the Association record and declare the PROVIDER_YAHOO


-----------------------------------------------------------------------
--  gen-commands-model -- Model creation command for dynamo
--  Copyright (C) 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.
-----------------------------------------------------------------------

package Gen.Commands.Model is

   --  ------------------------------
   --  Model Creation Command
   --  ------------------------------
   --  This command adds a model file to the web application.
   type Command is new Gen.Commands.Command with null record;

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

   --  Write the help associated with the command.
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler);

end Gen.Commands.Model;

-----------------------------------------------------------------------
--  gen-commands-model -- Model creation command for dynamo
--  Copyright (C) 2011, 2017, 2018, 2019 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 Gen.Commands.Model is

   --  ------------------------------
   --  Model Creation Command
   --  ------------------------------
   --  This command adds a model file to the web application.
   type Command is new Gen.Commands.Command with null record;

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

   --  Write the help associated with the command.
   overriding
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler);

end Gen.Commands.Model;

Add Name parameter to the Help procedure


with System;

package HAL.Bitmap is

   type Orientation_Mode is
     (Default,
      Portrait,
      Landscape);

   subtype Actual_Orientation is Orientation_Mode range Portrait .. Landscape;

   type Bitmap_Color_Mode is
     (ARGB_8888,
      RGB_888,
      RGB_565,
      ARGB_1555,
      ARGB_4444,
      L_8,
      AL_44,
      AL_88,
      L_4,
      A_8,
      A_4) with Size => 4;

   function Bits_Per_Pixel (Mode : Bitmap_Color_Mode) return Positive is
     (case Mode is
         when ARGB_8888 => 32,
         when RGB_888 => 24,
         when RGB_565 | ARGB_1555 | ARGB_4444 | AL_88 => 16,
         when L_8 | AL_44 | A_8 => 8,
         when L_4 | A_4 => 4);

   type Bitmap_Buffer is tagged record
      Addr       : System.Address;

      Width      : Natural;
      Height     : Natural;
      --  Width and Height of the buffer. Note that it's the user-visible width
      --  (see below for the meaning of the Swapped value).

      Color_Mode : Bitmap_Color_Mode;
      --  The buffer color mode. Note that not all color modes are supported by
      --  the hardware acceleration (if any), so you need to check your actual
      --  hardware to optimize buffer transfers.

      Swapped    : Boolean := False;
      --  If Swap is set, then operations on this buffer will consider:
      --  Width0 = Height
      --  Height0 = Width
      --  Y0 = Buffer.Width - X - 1
      --  X0 = Y
      --
      --  As an example, the Bitmap buffer that corresponds to a 240x320
      --  swapped display (to display images in landscape mode) with have
      --  the following values:
      --  Width => 320
      --  Height => 240
      --  Swapped => True
      --  So Put_Pixel (Buffer, 30, 10, Color) will place the pixel at
      --  Y0 = 320 - 30 - 1 = 289
      --  X0 = 10
   end record;

   type Bitmap_Color is record
      Alpha : Byte;
      Red   : Byte;
      Green : Byte;
      Blue  : Byte;
   end record with Size => 32;

   for Bitmap_Color use record
      Blue  at 0 range 0 .. 7;
      Green at 1 range 0 .. 7;
      Red   at 2 range 0 .. 7;
      Alpha at 3 range 0 .. 7;
   end record;

   Black       : constant Bitmap_Color := (255, 0, 0, 0);
   Blue        : constant Bitmap_Color := (255, 0, 0, 255);
   Light_Blue  : constant Bitmap_Color := (255, 173, 216, 230);
   Brown       : constant Bitmap_Color := (255, 165, 42, 42);
   Cyan        : constant Bitmap_Color := (255, 0, 255, 255);
   Gray        : constant Bitmap_Color := (255, 190, 190, 190);
   Light_Gray  : constant Bitmap_Color := (255, 211, 211, 211);
   Green       : constant Bitmap_Color := (255, 0, 255, 0);
   Light_Green : constant Bitmap_Color := (255, 144, 238, 144);
   Magenta     : constant Bitmap_Color := (255, 255, 0, 255);
   Red         : constant Bitmap_Color := (255, 255, 0, 0);
   Orange      : constant Bitmap_Color := (255, 255, 69, 0);
   Violet      : constant Bitmap_Color := (255, 238, 130, 238);
   Yellow      : constant Bitmap_Color := (255, 255, 255, 0);
   White       : constant Bitmap_Color := (255, 255, 255, 255);
   Transparent : constant Bitmap_Color := (0, 0, 0, 0);

   procedure Set_Pixel
     (Buffer  : Bitmap_Buffer;
      X       : Natural;
      Y       : Natural;
      Value   : Bitmap_Color);

   procedure Set_Pixel
     (Buffer  : Bitmap_Buffer;
      X       : Natural;
      Y       : Natural;
      Value   : Word);

   procedure Set_Pixel_Blend
     (Buffer : Bitmap_Buffer;
      X      : Natural;
      Y      : Natural;
      Value  : Bitmap_Color);

   function Get_Pixel
     (Buffer : Bitmap_Buffer;
      X      : Natural;
      Y      : Natural)
      return Bitmap_Color;

   function Get_Pixel
     (Buffer : Bitmap_Buffer;
      X      : Natural;
      Y      : Natural)
      return Word;

   procedure Fill
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color);
   --  Fill the specified buffer with 'Color'

   procedure Fill
     (Buffer : Bitmap_Buffer;
      Color  : Word);
   --  Same as above, using the destination buffer native color representation

   procedure Fill_Rect
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer);
   --  Fill the specified area of the buffer with 'Color'

   procedure Fill_Rect
     (Buffer : Bitmap_Buffer;
      Color  : Word;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer);
   --  Same as above, using the destination buffer native color representation

   procedure Copy_Rect
     (Src_Buffer : Bitmap_Buffer'Class;
      X_Src      : Natural;
      Y_Src      : Natural;
      Dst_Buffer : Bitmap_Buffer;
      X_Dst      : Natural;
      Y_Dst      : Natural;
      Bg_Buffer  : Bitmap_Buffer'Class;
      X_Bg       : Natural;
      Y_Bg       : Natural;
      Width      : Natural;
      Height     : Natural);

   procedure Copy_Rect
     (Src_Buffer : Bitmap_Buffer'Class;
      X_Src      : Natural;
      Y_Src      : Natural;
      Dst_Buffer : Bitmap_Buffer;
      X_Dst      : Natural;
      Y_Dst      : Natural;
      Width      : Natural;
      Height     : Natural);

   procedure Copy_Rect_Blend
     (Src_Buffer : Bitmap_Buffer;
      X_Src      : Natural;
      Y_Src      : Natural;
      Dst_Buffer : Bitmap_Buffer'Class;
      X_Dst      : Natural;
      Y_Dst      : Natural;
      Width      : Natural;
      Height     : Natural);

   procedure Draw_Vertical_Line
     (Buffer : Bitmap_Buffer;
      Color  : Word;
      X      : Integer;
      Y      : Integer;
      Height : Integer);

   procedure Draw_Vertical_Line
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Height : Integer);

   procedure Draw_Horizontal_Line
     (Buffer : Bitmap_Buffer;
      Color  : Word;
      X      : Integer;
      Y      : Integer;
      Width  : Integer);

   procedure Draw_Horizontal_Line
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Width  : Integer);

   procedure Draw_Rect
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer);
   --  Draws a rectangle

   function Buffer_Size (Buffer : Bitmap_Buffer) return Natural;

   function Bitmap_Color_To_Word
     (Mode : Bitmap_Color_Mode; Col : Bitmap_Color)
     return Word;
   --  Translates the DMA2D Color into native buffer color

   function Word_To_Bitmap_Color
     (Mode : Bitmap_Color_Mode; Col : Word)
     return Bitmap_Color;
   --  Translates the native buffer color into DMA2D Color

   procedure Wait_Transfer (Buffer : Bitmap_Buffer);
   --  Makes sure the DMA2D transfers are done

end HAL.Bitmap;

with System;

package HAL.Bitmap is

   type Orientation_Mode is
     (Default,
      Portrait,
      Landscape);

   subtype Actual_Orientation is Orientation_Mode range Portrait .. Landscape;

   type Bitmap_Color_Mode is
     (ARGB_8888,
      RGB_888,
      RGB_565,
      ARGB_1555,
      ARGB_4444,
      L_8,
      AL_44,
      AL_88,
      L_4,
      A_8,
      A_4) with Size => 4;

   function Bits_Per_Pixel (Mode : Bitmap_Color_Mode) return Positive is
     (case Mode is
         when ARGB_8888 => 32,
         when RGB_888 => 24,
         when RGB_565 | ARGB_1555 | ARGB_4444 | AL_88 => 16,
         when L_8 | AL_44 | A_8 => 8,
         when L_4 | A_4 => 4);

   type Bitmap_Buffer is tagged record
      Addr       : System.Address;

      Width      : Natural;
      Height     : Natural;
      --  Width and Height of the buffer. Note that it's the user-visible width
      --  (see below for the meaning of the Swapped value).

      Color_Mode : Bitmap_Color_Mode;
      --  The buffer color mode. Note that not all color modes are supported by
      --  the hardware acceleration (if any), so you need to check your actual
      --  hardware to optimize buffer transfers.

      Swapped    : Boolean := False;
      --  If Swap is set, then operations on this buffer will consider:
      --  Width0 = Height
      --  Height0 = Width
      --  Y0 = Buffer.Width - X - 1
      --  X0 = Y
      --
      --  As an example, the Bitmap buffer that corresponds to a 240x320
      --  swapped display (to display images in landscape mode) with have
      --  the following values:
      --  Width => 320
      --  Height => 240
      --  Swapped => True
      --  So Put_Pixel (Buffer, 30, 10, Color) will place the pixel at
      --  Y0 = 320 - 30 - 1 = 289
      --  X0 = 10
   end record;

   type Bitmap_Color is record
      Alpha : Byte;
      Red   : Byte;
      Green : Byte;
      Blue  : Byte;
   end record with Size => 32;

   for Bitmap_Color use record
      Blue  at 0 range 0 .. 7;
      Green at 1 range 0 .. 7;
      Red   at 2 range 0 .. 7;
      Alpha at 3 range 0 .. 7;
   end record;

   procedure Set_Pixel
     (Buffer  : Bitmap_Buffer;
      X       : Natural;
      Y       : Natural;
      Value   : Bitmap_Color);

   procedure Set_Pixel
     (Buffer  : Bitmap_Buffer;
      X       : Natural;
      Y       : Natural;
      Value   : Word);

   procedure Set_Pixel_Blend
     (Buffer : Bitmap_Buffer;
      X      : Natural;
      Y      : Natural;
      Value  : Bitmap_Color);

   function Get_Pixel
     (Buffer : Bitmap_Buffer;
      X      : Natural;
      Y      : Natural)
      return Bitmap_Color;

   function Get_Pixel
     (Buffer : Bitmap_Buffer;
      X      : Natural;
      Y      : Natural)
      return Word;

   procedure Fill
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color);
   --  Fill the specified buffer with 'Color'

   procedure Fill
     (Buffer : Bitmap_Buffer;
      Color  : Word);
   --  Same as above, using the destination buffer native color representation

   procedure Fill_Rect
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer);
   --  Fill the specified area of the buffer with 'Color'

   procedure Fill_Rect
     (Buffer : Bitmap_Buffer;
      Color  : Word;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer);
   --  Same as above, using the destination buffer native color representation

   procedure Copy_Rect
     (Src_Buffer : Bitmap_Buffer'Class;
      X_Src      : Natural;
      Y_Src      : Natural;
      Dst_Buffer : Bitmap_Buffer;
      X_Dst      : Natural;
      Y_Dst      : Natural;
      Bg_Buffer  : Bitmap_Buffer'Class;
      X_Bg       : Natural;
      Y_Bg       : Natural;
      Width      : Natural;
      Height     : Natural);

   procedure Copy_Rect
     (Src_Buffer : Bitmap_Buffer'Class;
      X_Src      : Natural;
      Y_Src      : Natural;
      Dst_Buffer : Bitmap_Buffer;
      X_Dst      : Natural;
      Y_Dst      : Natural;
      Width      : Natural;
      Height     : Natural);

   procedure Copy_Rect_Blend
     (Src_Buffer : Bitmap_Buffer;
      X_Src      : Natural;
      Y_Src      : Natural;
      Dst_Buffer : Bitmap_Buffer'Class;
      X_Dst      : Natural;
      Y_Dst      : Natural;
      Width      : Natural;
      Height     : Natural);

   procedure Draw_Vertical_Line
     (Buffer : Bitmap_Buffer;
      Color  : Word;
      X      : Integer;
      Y      : Integer;
      Height : Integer);

   procedure Draw_Vertical_Line
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Height : Integer);

   procedure Draw_Horizontal_Line
     (Buffer : Bitmap_Buffer;
      Color  : Word;
      X      : Integer;
      Y      : Integer;
      Width  : Integer);

   procedure Draw_Horizontal_Line
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Width  : Integer);

   procedure Draw_Rect
     (Buffer : Bitmap_Buffer;
      Color  : Bitmap_Color;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer);
   --  Draws a rectangle

   function Buffer_Size (Buffer : Bitmap_Buffer) return Natural;

   function Bitmap_Color_To_Word
     (Mode : Bitmap_Color_Mode; Col : Bitmap_Color)
     return Word;
   --  Translates the DMA2D Color into native buffer color

   function Word_To_Bitmap_Color
     (Mode : Bitmap_Color_Mode; Col : Word)
     return Bitmap_Color;
   --  Translates the native buffer color into DMA2D Color

   procedure Wait_Transfer (Buffer : Bitmap_Buffer);
   --  Makes sure the DMA2D transfers are done

   Transparent         : constant Bitmap_Color := (000, 000, 000, 000);
   Dark_Red            : constant Bitmap_Color := (255, 139, 000, 000);
   Brown               : constant Bitmap_Color := (255, 165, 042, 042);
   Firebrick           : constant Bitmap_Color := (255, 178, 034, 034);
   Crimson             : constant Bitmap_Color := (255, 220, 020, 060);
   Red                 : constant Bitmap_Color := (255, 255, 000, 000);
   Tomato              : constant Bitmap_Color := (255, 255, 099, 071);
   Coral               : constant Bitmap_Color := (255, 255, 127, 080);
   Indian_Red          : constant Bitmap_Color := (255, 205, 092, 092);
   Light_Coral         : constant Bitmap_Color := (255, 240, 128, 128);
   Dark_Salmon         : constant Bitmap_Color := (255, 233, 150, 122);
   Salmon              : constant Bitmap_Color := (255, 250, 128, 114);
   Light_Salmon        : constant Bitmap_Color := (255, 255, 160, 122);
   Dark_Orange         : constant Bitmap_Color := (255, 255, 140, 000);
   Orange              : constant Bitmap_Color := (255, 255, 165, 000);
   Light_Orange        : constant Bitmap_Color := (255, 255, 069, 000);
   Gold                : constant Bitmap_Color := (255, 255, 215, 000);
   Dark_Golden_Rod     : constant Bitmap_Color := (255, 184, 134, 011);
   Golden_Rod          : constant Bitmap_Color := (255, 218, 165, 032);
   Pale_Golden_Rod     : constant Bitmap_Color := (255, 238, 232, 170);
   Dark_Khaki          : constant Bitmap_Color := (255, 189, 183, 107);
   Khaki               : constant Bitmap_Color := (255, 240, 230, 140);
   Olive               : constant Bitmap_Color := (255, 128, 128, 000);
   Yellow              : constant Bitmap_Color := (255, 255, 255, 000);
   Yellow_Green        : constant Bitmap_Color := (255, 154, 205, 050);
   Dark_Olive_Green    : constant Bitmap_Color := (255, 085, 107, 047);
   Olive_Drab          : constant Bitmap_Color := (255, 107, 142, 035);
   Lawn_Green          : constant Bitmap_Color := (255, 124, 252, 000);
   Chart_Reuse         : constant Bitmap_Color := (255, 127, 255, 000);
   Green_Yellow        : constant Bitmap_Color := (255, 173, 255, 047);
   Dark_Green          : constant Bitmap_Color := (255, 000, 100, 000);
   Green               : constant Bitmap_Color := (255, 000, 255, 000);
   Maroon              : constant Bitmap_Color := (255, 128, 000, 000);
   Forest_Green        : constant Bitmap_Color := (255, 034, 139, 034);
   Lime                : constant Bitmap_Color := (255, 000, 255, 000);
   Lime_Green          : constant Bitmap_Color := (255, 050, 205, 050);
   Light_Green         : constant Bitmap_Color := (255, 144, 238, 144);
   Pale_Green          : constant Bitmap_Color := (255, 152, 251, 152);
   Dark_Sea_Green      : constant Bitmap_Color := (255, 143, 188, 143);
   Medium_Spring_Green : constant Bitmap_Color := (255, 000, 250, 154);
   Spring_Green        : constant Bitmap_Color := (255, 000, 255, 127);
   Sea_Green           : constant Bitmap_Color := (255, 046, 139, 087);
   Medium_Aqua_Marine  : constant Bitmap_Color := (255, 102, 205, 170);
   Medium_Sea_Green    : constant Bitmap_Color := (255, 060, 179, 113);
   Light_Sea_Green     : constant Bitmap_Color := (255, 032, 178, 170);
   Dark_Slate_Gray     : constant Bitmap_Color := (255, 047, 079, 079);
   Teal                : constant Bitmap_Color := (255, 000, 128, 128);
   Dark_Cyan           : constant Bitmap_Color := (255, 000, 139, 139);
   Aqua                : constant Bitmap_Color := (255, 000, 255, 255);
   Cyan                : constant Bitmap_Color := (255, 000, 255, 255);
   Light_Cyan          : constant Bitmap_Color := (255, 224, 255, 255);
   Dark_Turquoise      : constant Bitmap_Color := (255, 000, 206, 209);
   Turquoise           : constant Bitmap_Color := (255, 064, 224, 208);
   Medium_Turquoise    : constant Bitmap_Color := (255, 072, 209, 204);
   Pale_Turquoise      : constant Bitmap_Color := (255, 175, 238, 238);
   Aqua_Marine         : constant Bitmap_Color := (255, 127, 255, 212);
   Powder_Blue         : constant Bitmap_Color := (255, 176, 224, 230);
   Cadet_Blue          : constant Bitmap_Color := (255, 095, 158, 160);
   Steel_Blue          : constant Bitmap_Color := (255, 070, 130, 180);
   Corn_Flower_Blue    : constant Bitmap_Color := (255, 100, 149, 237);
   Deep_Sky_Blue       : constant Bitmap_Color := (255, 000, 191, 255);
   Dodger_Blue         : constant Bitmap_Color := (255, 030, 144, 255);
   Light_Blue          : constant Bitmap_Color := (255, 173, 216, 230);
   Sky_Blue            : constant Bitmap_Color := (255, 135, 206, 235);
   Light_Sky_Blue      : constant Bitmap_Color := (255, 135, 206, 250);
   Midnight_Blue       : constant Bitmap_Color := (255, 025, 025, 112);
   Navy                : constant Bitmap_Color := (255, 000, 000, 128);
   Dark_Blue           : constant Bitmap_Color := (255, 000, 000, 139);
   Medium_Blue         : constant Bitmap_Color := (255, 000, 000, 205);
   Blue                : constant Bitmap_Color := (255, 000, 000, 255);
   Royal_Blue          : constant Bitmap_Color := (255, 065, 105, 225);
   Blue_Violet         : constant Bitmap_Color := (255, 138, 043, 226);
   Indigo              : constant Bitmap_Color := (255, 075, 000, 130);
   Dark_Slate_Blue     : constant Bitmap_Color := (255, 072, 061, 139);
   Slate_Blue          : constant Bitmap_Color := (255, 106, 090, 205);
   Medium_Slate_Blue   : constant Bitmap_Color := (255, 123, 104, 238);
   Medium_Purple       : constant Bitmap_Color := (255, 147, 112, 219);
   Dark_Magenta        : constant Bitmap_Color := (255, 139, 000, 139);
   Dark_Violet         : constant Bitmap_Color := (255, 148, 000, 211);
   Dark_Orchid         : constant Bitmap_Color := (255, 153, 050, 204);
   Medium_Orchid       : constant Bitmap_Color := (255, 186, 085, 211);
   Purple              : constant Bitmap_Color := (255, 128, 000, 128);
   Thistle             : constant Bitmap_Color := (255, 216, 191, 216);
   Plum                : constant Bitmap_Color := (255, 221, 160, 221);
   Violet              : constant Bitmap_Color := (255, 238, 130, 238);
   Magenta             : constant Bitmap_Color := (255, 255, 000, 255);
   Orchid              : constant Bitmap_Color := (255, 218, 112, 214);
   Medium_Violet_Red   : constant Bitmap_Color := (255, 199, 021, 133);
   Pale_Violet_Red     : constant Bitmap_Color := (255, 219, 112, 147);
   Deep_Pink           : constant Bitmap_Color := (255, 255, 020, 147);
   Hot_Pink            : constant Bitmap_Color := (255, 255, 105, 180);
   Light_Pink          : constant Bitmap_Color := (255, 255, 182, 193);
   Pink                : constant Bitmap_Color := (255, 255, 192, 203);
   Antique_White       : constant Bitmap_Color := (255, 250, 235, 215);
   Beige               : constant Bitmap_Color := (255, 245, 245, 220);
   Bisque              : constant Bitmap_Color := (255, 255, 228, 196);
   Blanched_Almond     : constant Bitmap_Color := (255, 255, 235, 205);
   Wheat               : constant Bitmap_Color := (255, 245, 222, 179);
   Corn_Silk           : constant Bitmap_Color := (255, 255, 248, 220);
   Lemon_Chiffon       : constant Bitmap_Color := (255, 255, 250, 205);
   Light_Yellow        : constant Bitmap_Color := (255, 255, 255, 224);
   Saddle_Brown        : constant Bitmap_Color := (255, 139, 069, 019);
   Sienna              : constant Bitmap_Color := (255, 160, 082, 045);
   Chocolate           : constant Bitmap_Color := (255, 210, 105, 030);
   Peru                : constant Bitmap_Color := (255, 205, 133, 063);
   Sandy_Brown         : constant Bitmap_Color := (255, 244, 164, 096);
   Burly_Wood          : constant Bitmap_Color := (255, 222, 184, 135);
   Tan                 : constant Bitmap_Color := (255, 210, 180, 140);
   Rosy_Brown          : constant Bitmap_Color := (255, 188, 143, 143);
   Moccasin            : constant Bitmap_Color := (255, 255, 228, 181);
   Navajo_White        : constant Bitmap_Color := (255, 255, 222, 173);
   Peach_Puff          : constant Bitmap_Color := (255, 255, 218, 185);
   Misty_Rose          : constant Bitmap_Color := (255, 255, 228, 225);
   Lavender_Blush      : constant Bitmap_Color := (255, 255, 240, 245);
   Linen               : constant Bitmap_Color := (255, 250, 240, 230);
   Old_Lace            : constant Bitmap_Color := (255, 253, 245, 230);
   Papaya_Whip         : constant Bitmap_Color := (255, 255, 239, 213);
   Sea_Shell           : constant Bitmap_Color := (255, 255, 245, 238);
   Mint_Cream          : constant Bitmap_Color := (255, 245, 255, 250);
   Slate_Gray          : constant Bitmap_Color := (255, 112, 128, 144);
   Light_Slate_Gray    : constant Bitmap_Color := (255, 119, 136, 153);
   Light_Steel_Blue    : constant Bitmap_Color := (255, 176, 196, 222);
   Lavender            : constant Bitmap_Color := (255, 230, 230, 250);
   Floral_White        : constant Bitmap_Color := (255, 255, 250, 240);
   Alice_Blue          : constant Bitmap_Color := (255, 240, 248, 255);
   Ghost_White         : constant Bitmap_Color := (255, 248, 248, 255);
   Honeydew            : constant Bitmap_Color := (255, 240, 255, 240);
   Ivory               : constant Bitmap_Color := (255, 255, 255, 240);
   Azure               : constant Bitmap_Color := (255, 240, 255, 255);
   Snow                : constant Bitmap_Color := (255, 255, 250, 250);
   Black               : constant Bitmap_Color := (255, 000, 000, 000);
   Dim_Grey            : constant Bitmap_Color := (255, 105, 105, 105);
   Grey                : constant Bitmap_Color := (255, 128, 128, 128);
   Gray                : constant Bitmap_Color := (255, 190, 190, 190);
   Dark_Grey           : constant Bitmap_Color := (255, 169, 169, 169);
   Silver              : constant Bitmap_Color := (255, 192, 192, 192);
   Light_Grey          : constant Bitmap_Color := (255, 211, 211, 211);
   Gainsboro           : constant Bitmap_Color := (255, 220, 220, 220);
   White_Smoke         : constant Bitmap_Color := (255, 245, 245, 245);
   White               : constant Bitmap_Color := (255, 255, 255, 255);

end HAL.Bitmap;

Add more color definitions

HAL.Bitmap: Add more color definitions


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

------------------------------------------------------------------------------
-- Natools is a collection of miscellaneous small utilities gathered in one --
-- shared library.                                                          --
------------------------------------------------------------------------------

package Natools is
   pragma Pure (Natools);

end Natools;

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

------------------------------------------------------------------------------
-- Natools is a collection of miscellaneous small utilities gathered in one --
-- shared library.                                                          --
------------------------------------------------------------------------------

package Natools is
   pragma Pure (Natools);

   type Meaningless_Type is (Meaningless_Value);

end Natools;

natools: add Meaningless_Type to help instantiation of interpreters without meaningful context or state


-------------------------------------------------------------------------------
--  Copyright (c) 2016 Daniel King
--
--  Permission is hereby granted, free of charge, to any person obtaining a
--  copy of this software and associated documentation files (the "Software"),
--  to deal in the Software without restriction, including without limitation
--  the rights to use, copy, modify, merge, publish, distribute, sublicense,
--  and/or sell copies of the Software, and to permit persons to whom the
--  Software is furnished to do so, subject to the following conditions:
--
--  The above copyright notice and this permission notice shall be included in
--  all copies or substantial portions of the Software.
--
--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
--  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
--  DEALINGS IN THE SOFTWARE.
-------------------------------------------------------------------------------

with Interfaces;

package DW1000.Types
  with SPARK_Mode => On
is
   type Bits_1 is mod 2**1 with Size => 1;
   type Bits_2 is mod 2**2 with Size => 2;
   type Bits_3 is mod 2**3 with Size => 3;
   type Bits_4 is mod 2**4 with Size => 4;
   type Bits_5 is mod 2**5 with Size => 5;
   type Bits_6 is mod 2**6 with Size => 6;
   type Bits_7 is mod 2**7 with Size => 7;

   subtype Bits_8 is Interfaces.Unsigned_8;

   type Bits_9  is mod 2**9  with Size => 9;
   type Bits_10 is mod 2**10 with Size => 10;
   type Bits_11 is mod 2**11 with Size => 11;
   type Bits_12 is mod 2**12 with Size => 12;
   type Bits_13 is mod 2**13 with Size => 13;
   type Bits_14 is mod 2**14 with Size => 14;
   type Bits_15 is mod 2**15 with Size => 15;

   subtype Bits_16 is Interfaces.Unsigned_16;

   type Bits_17 is mod 2**17 with Size => 17;
   type Bits_18 is mod 2**18 with Size => 18;
   type Bits_19 is mod 2**19 with Size => 19;
   type Bits_20 is mod 2**20 with Size => 20;
   type Bits_21 is mod 2**21 with Size => 21;
   type Bits_22 is mod 2**22 with Size => 22;
   type Bits_23 is mod 2**23 with Size => 23;
   type Bits_24 is mod 2**24 with Size => 24;
   type Bits_25 is mod 2**25 with Size => 25;
   type Bits_26 is mod 2**26 with Size => 26;
   type Bits_27 is mod 2**27 with Size => 27;
   type Bits_28 is mod 2**28 with Size => 28;
   type Bits_29 is mod 2**29 with Size => 29;
   type Bits_30 is mod 2**30 with Size => 30;
   type Bits_31 is mod 2**31 with Size => 31;

   subtype Bits_32 is Interfaces.Unsigned_32;

   type Bits_33 is mod 2**33 with Size => 33;
   type Bits_34 is mod 2**34 with Size => 34;
   type Bits_35 is mod 2**35 with Size => 35;
   type Bits_36 is mod 2**36 with Size => 36;
   type Bits_37 is mod 2**37 with Size => 37;
   type Bits_38 is mod 2**38 with Size => 38;
   type Bits_39 is mod 2**39 with Size => 39;
   type Bits_40 is mod 2**40 with Size => 40;
   type Bits_41 is mod 2**41 with Size => 41;
   type Bits_42 is mod 2**42 with Size => 42;
   type Bits_43 is mod 2**43 with Size => 43;
   type Bits_44 is mod 2**44 with Size => 44;
   type Bits_45 is mod 2**45 with Size => 45;
   type Bits_46 is mod 2**46 with Size => 46;
   type Bits_47 is mod 2**47 with Size => 47;
   type Bits_48 is mod 2**48 with Size => 48;
   type Bits_49 is mod 2**49 with Size => 49;
   type Bits_50 is mod 2**50 with Size => 50;
   type Bits_51 is mod 2**51 with Size => 51;
   type Bits_52 is mod 2**52 with Size => 52;
   type Bits_53 is mod 2**53 with Size => 53;
   type Bits_54 is mod 2**54 with Size => 54;
   type Bits_55 is mod 2**55 with Size => 55;
   type Bits_56 is mod 2**56 with Size => 56;
   type Bits_57 is mod 2**57 with Size => 57;
   type Bits_58 is mod 2**58 with Size => 58;
   type Bits_59 is mod 2**59 with Size => 59;
   type Bits_60 is mod 2**60 with Size => 60;
   type Bits_61 is mod 2**61 with Size => 61;
   type Bits_62 is mod 2**62 with Size => 62;
   type Bits_63 is mod 2**63 with Size => 63;

   subtype Bits_64 is Interfaces.Unsigned_64;

   type Byte_Array is array (Natural range <>) of Bits_8;
end DW1000.Types;

-------------------------------------------------------------------------------
--  Copyright (c) 2016 Daniel King
--
--  Permission is hereby granted, free of charge, to any person obtaining a
--  copy of this software and associated documentation files (the "Software"),
--  to deal in the Software without restriction, including without limitation
--  the rights to use, copy, modify, merge, publish, distribute, sublicense,
--  and/or sell copies of the Software, and to permit persons to whom the
--  Software is furnished to do so, subject to the following conditions:
--
--  The above copyright notice and this permission notice shall be included in
--  all copies or substantial portions of the Software.
--
--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
--  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
--  DEALINGS IN THE SOFTWARE.
-------------------------------------------------------------------------------

with Interfaces;

package DW1000.Types
  with SPARK_Mode => On
is
   type Bits_1 is mod 2**1 with Size => 1;
   type Bits_2 is mod 2**2 with Size => 2;
   type Bits_3 is mod 2**3 with Size => 3;
   type Bits_4 is mod 2**4 with Size => 4;
   type Bits_5 is mod 2**5 with Size => 5;
   type Bits_6 is mod 2**6 with Size => 6;
   type Bits_7 is mod 2**7 with Size => 7;

   subtype Bits_8 is Interfaces.Unsigned_8;

   type Bits_9  is mod 2**9  with Size => 9;
   type Bits_10 is mod 2**10 with Size => 10;
   type Bits_11 is mod 2**11 with Size => 11;
   type Bits_12 is mod 2**12 with Size => 12;
   type Bits_13 is mod 2**13 with Size => 13;
   type Bits_14 is mod 2**14 with Size => 14;
   type Bits_15 is mod 2**15 with Size => 15;

   subtype Bits_16 is Interfaces.Unsigned_16;

   type Bits_17 is mod 2**17 with Size => 17;
   type Bits_18 is mod 2**18 with Size => 18;
   type Bits_19 is mod 2**19 with Size => 19;
   type Bits_20 is mod 2**20 with Size => 20;
   type Bits_21 is mod 2**21 with Size => 21;
   type Bits_22 is mod 2**22 with Size => 22;
   type Bits_23 is mod 2**23 with Size => 23;
   type Bits_24 is mod 2**24 with Size => 24;
   type Bits_25 is mod 2**25 with Size => 25;
   type Bits_26 is mod 2**26 with Size => 26;
   type Bits_27 is mod 2**27 with Size => 27;
   type Bits_28 is mod 2**28 with Size => 28;
   type Bits_29 is mod 2**29 with Size => 29;
   type Bits_30 is mod 2**30 with Size => 30;
   type Bits_31 is mod 2**31 with Size => 31;

   subtype Bits_32 is Interfaces.Unsigned_32;

   type Bits_33 is mod 2**33 with Size => 33;
   type Bits_34 is mod 2**34 with Size => 34;
   type Bits_35 is mod 2**35 with Size => 35;
   type Bits_36 is mod 2**36 with Size => 36;
   type Bits_37 is mod 2**37 with Size => 37;
   type Bits_38 is mod 2**38 with Size => 38;
   type Bits_39 is mod 2**39 with Size => 39;
   type Bits_40 is mod 2**40 with Size => 40;
   type Bits_41 is mod 2**41 with Size => 41;
   type Bits_42 is mod 2**42 with Size => 42;
   type Bits_43 is mod 2**43 with Size => 43;
   type Bits_44 is mod 2**44 with Size => 44;
   type Bits_45 is mod 2**45 with Size => 45;
   type Bits_46 is mod 2**46 with Size => 46;
   type Bits_47 is mod 2**47 with Size => 47;
   type Bits_48 is mod 2**48 with Size => 48;
   type Bits_49 is mod 2**49 with Size => 49;
   type Bits_50 is mod 2**50 with Size => 50;
   type Bits_51 is mod 2**51 with Size => 51;
   type Bits_52 is mod 2**52 with Size => 52;
   type Bits_53 is mod 2**53 with Size => 53;
   type Bits_54 is mod 2**54 with Size => 54;
   type Bits_55 is mod 2**55 with Size => 55;
   type Bits_56 is mod 2**56 with Size => 56;
   type Bits_57 is mod 2**57 with Size => 57;
   type Bits_58 is mod 2**58 with Size => 58;
   type Bits_59 is mod 2**59 with Size => 59;
   type Bits_60 is mod 2**60 with Size => 60;
   type Bits_61 is mod 2**61 with Size => 61;
   type Bits_62 is mod 2**62 with Size => 62;
   type Bits_63 is mod 2**63 with Size => 63;

   subtype Bits_64 is Interfaces.Unsigned_64;

   subtype Index is Natural range 0 .. Natural'Last - 1;

   type Byte_Array is array (Index range <>) of Bits_8;
end DW1000.Types;

Reduce maximum Byte_Array length to avoid overflow with 'Length attribute

When a subprogram takes an unconstrained Byte_Array as a parameter and
references its 'Length attribute it is possible that in the case of the
largest possible array ('First = 0 and 'Last = 2**31 - 1) then 'Length
is equal to 2**31 which is 1 past the maximum range supported by the
Natural type (on a 32-bit ARM microcontroller, at least) which is now
detected by SPARK Discovery 2017. This commit constrains the index range
of the Byte_Array type by 1 to allow all possible 'Length values to fit
inside the Natural type.


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

with Util.Strings;
with Util.Beans.Objects;
with Util.Http.Clients;
with Util.Http.Clients.Web;
with Util.Http.Rest;
with Util.Serialize.IO.JSON;

with Mapping;

--  This example shows how to invoke a REST service, retrieve and extract a JSON content
--  into some Ada record.  It uses the Facebook Graph API which does not need any
--  authentication (ie, the public Facebook API).
procedure Facebook is

   procedure Print (P : in Mapping.Person) is
      use Ada.Strings.Unbounded;
   begin
      Ada.Text_IO.Put_Line ("Id         : " & Long_Long_Integer'Image (P.Id));
      Ada.Text_IO.Put_Line ("Name       : " & To_String (P.Name));
      Ada.Text_IO.Put_Line ("First name : " & To_String (P.First_Name));
      Ada.Text_IO.Put_Line ("Last name  : " & To_String (P.Last_Name));
      Ada.Text_IO.Put_Line ("Username   : " & To_String (P.Username));
      Ada.Text_IO.Put_Line ("Gender     : " & To_String (P.Gender));
      Ada.Text_IO.Put_Line ("Link       : " & To_String (P.Link));
   end Print;

   procedure Get_User is new Util.Http.Rest.Rest_Get (Mapping.Person_Mapper);

   Count : constant Natural := Ada.Command_Line.Argument_Count;

   --  Mapping for the Person record.
   Person_Mapping  : aliased Mapping.Person_Mapper.Mapper;
begin
   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: facebook username ...");
      Ada.Text_IO.Put_Line ("Example: facebook btaylor");
      return;
   end if;
   Person_Mapping.Add_Mapping ("id", Mapping.FIELD_ID);
   Person_Mapping.Add_Mapping ("name", Mapping.FIELD_NAME);
   Person_Mapping.Add_Mapping ("first_name", Mapping.FIELD_FIRST_NAME);
   Person_Mapping.Add_Mapping ("last_name", Mapping.FIELD_LAST_NAME);
   Person_Mapping.Add_Mapping ("link", Mapping.FIELD_LINK);
   Person_Mapping.Add_Mapping ("username", Mapping.FIELD_USER_NAME);
   Person_Mapping.Add_Mapping ("gender", Mapping.FIELD_GENDER);
   Util.Http.Clients.Web.Register;
   for I in 1 .. Count loop
      declare
         URI      : constant String := Ada.Command_Line.Argument (I);
         P        : aliased Mapping.Person;
      begin
         Get_User ("https://graph.facebook.com/" & URI,
                   Person_Mapping'Unchecked_Access,
                   P'Unchecked_Access);
         Print (P);
      end;
   end loop;
end Facebook;

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

with Util.Http.Clients.Web;
with Util.Http.Rest;

with Mapping;

--  This example shows how to invoke a REST service, retrieve and extract a JSON content
--  into some Ada record.  It uses the Facebook Graph API which does not need any
--  authentication (ie, the public Facebook API).
procedure Facebook is

   procedure Print (P : in Mapping.Person);

   procedure Print (P : in Mapping.Person) is
      use Ada.Strings.Unbounded;
   begin
      Ada.Text_IO.Put_Line ("Id         : " & Long_Long_Integer'Image (P.Id));
      Ada.Text_IO.Put_Line ("Name       : " & To_String (P.Name));
      Ada.Text_IO.Put_Line ("First name : " & To_String (P.First_Name));
      Ada.Text_IO.Put_Line ("Last name  : " & To_String (P.Last_Name));
      Ada.Text_IO.Put_Line ("Username   : " & To_String (P.Username));
      Ada.Text_IO.Put_Line ("Gender     : " & To_String (P.Gender));
      Ada.Text_IO.Put_Line ("Link       : " & To_String (P.Link));
   end Print;

   procedure Get_User is new Util.Http.Rest.Rest_Get (Mapping.Person_Mapper);

   Count : constant Natural := Ada.Command_Line.Argument_Count;

   --  Mapping for the Person record.
   Person_Mapping  : aliased Mapping.Person_Mapper.Mapper;
begin
   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: facebook username ...");
      Ada.Text_IO.Put_Line ("Example: facebook btaylor");
      return;
   end if;
   Person_Mapping.Add_Mapping ("id", Mapping.FIELD_ID);
   Person_Mapping.Add_Mapping ("name", Mapping.FIELD_NAME);
   Person_Mapping.Add_Mapping ("first_name", Mapping.FIELD_FIRST_NAME);
   Person_Mapping.Add_Mapping ("last_name", Mapping.FIELD_LAST_NAME);
   Person_Mapping.Add_Mapping ("link", Mapping.FIELD_LINK);
   Person_Mapping.Add_Mapping ("username", Mapping.FIELD_USER_NAME);
   Person_Mapping.Add_Mapping ("gender", Mapping.FIELD_GENDER);
   Util.Http.Clients.Web.Register;
   for I in 1 .. Count loop
      declare
         URI      : constant String := Ada.Command_Line.Argument (I);
         P        : aliased Mapping.Person;
      begin
         Get_User ("https://graph.facebook.com/" & URI,
                   Person_Mapping'Unchecked_Access,
                   P'Unchecked_Access);
         Print (P);
      end;
   end loop;
end Facebook;

Fix compilation warnings

Fix compilation warnings


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

with MAT.Types;
package MAT.Consoles is

   type Field_Type is (F_ADDR,
                       F_SIZE,
                       F_TOTAL_SIZE,
                       F_MIN_SIZE,
                       F_MAX_SIZE,
                       F_MIN_ADDR,
                       F_MAX_ADDR,
                       F_THREAD,
                       F_COUNT,
                       F_FILE_NAME,
                       F_FUNCTION_NAME,
                       F_LINE_NUMBER,
                       F_ID,
                       F_OLD_ADDR,
                       F_TIME,
                       F_EVENT,
                       F_FRAME_ID,
                       F_FRAME_ADDR);

   type Notice_Type is (N_HELP,
                        N_PID_INFO,
                        N_DURATION,
                        N_PATH_INFO);

   type Justify_Type is (J_LEFT,           --  Justify left   |item    |
                         J_RIGHT,          --  Justify right  |    item|
                         J_CENTER,         --  Justify center |  item  |
                         J_RIGHT_NO_FILL   --  Justify right  |item|
                        );

   type Console_Type is abstract tagged limited private;
   type Console_Access is access all Console_Type'Class;

   --  Report an error message.
   procedure Error (Console : in out Console_Type;
                    Message : in String) is abstract;

   --  Report a notice message.
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is abstract;

   --  Print the field value for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String;
                          Justify : in Justify_Type := J_LEFT) is abstract;

   --  Print the title for the given field.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is abstract;

   --  Start a new title in a report.
   procedure Start_Title (Console : in out Console_Type) is abstract;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is abstract;

   --  Start a new row in a report.
   procedure Start_Row (Console : in out Console_Type) is abstract;

   --  Finish a new row in a report.
   procedure End_Row (Console : in out Console_Type) is abstract;

   --  Print the title for the given field and setup the associated field size.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive);

   --  Format the address and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr);

   --  Format the size and print it for the given field.
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size);

   --  Format the thread information and print it for the given field.
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref);

   --  Format the time tick as a duration and print it for the given field.
   procedure Print_Duration (Console  : in out Console_Type;
                             Field    : in Field_Type;
                             Duration : in MAT.Types.Target_Tick_Ref);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer;
                          Justify : in Justify_Type := J_LEFT);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String;
                          Justify : in Justify_Type := J_LEFT);

private

   type Field_Size_Array is array (Field_Type) of Natural;

   type Field_List_Array is array (1 .. Field_Type'Pos (Field_Type'Last)) of Field_Type;

   type Console_Type is abstract tagged limited record
      Sizes       : Field_Size_Array := (others => 1);
      Cols        : Field_Size_Array := (others => 1);
      Fields      : Field_List_Array;
      Field_Count : Natural := 0;
   end record;

end MAT.Consoles;

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

with MAT.Types;
package MAT.Consoles is

   type Field_Type is (F_ADDR,
                       F_SIZE,
                       F_TOTAL_SIZE,
                       F_MIN_SIZE,
                       F_MAX_SIZE,
                       F_MIN_ADDR,
                       F_MAX_ADDR,
                       F_THREAD,
                       F_COUNT,
                       F_FILE_NAME,
                       F_FUNCTION_NAME,
                       F_LINE_NUMBER,
                       F_ID,
                       F_OLD_ADDR,
                       F_TIME,
                       F_EVENT,
                       F_FRAME_ID,
                       F_FRAME_ADDR);

   type Notice_Type is (N_HELP,
                        N_PID_INFO,
                        N_DURATION,
                        N_PATH_INFO);

   type Justify_Type is (J_LEFT,           --  Justify left   |item    |
                         J_RIGHT,          --  Justify right  |    item|
                         J_CENTER,         --  Justify center |  item  |
                         J_RIGHT_NO_FILL   --  Justify right  |item|
                        );

   type Console_Type is abstract tagged limited private;
   type Console_Access is access all Console_Type'Class;

   --  Report an error message.
   procedure Error (Console : in out Console_Type;
                    Message : in String) is abstract;

   --  Report a notice message.
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is abstract;

   --  Print the field value for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String;
                          Justify : in Justify_Type := J_LEFT) is abstract;

   --  Print the title for the given field.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is abstract;

   --  Start a new title in a report.
   procedure Start_Title (Console : in out Console_Type) is abstract;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is abstract;

   --  Start a new row in a report.
   procedure Start_Row (Console : in out Console_Type) is abstract;

   --  Finish a new row in a report.
   procedure End_Row (Console : in out Console_Type) is abstract;

   --  Print the title for the given field and setup the associated field size.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive);

   --  Format the address and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr);

   --  Format the address range and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          From    : in MAT.Types.Target_Addr;
                          To      : in MAT.Types.Target_Addr);

   --  Format the size and print it for the given field.
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size);

   --  Format the thread information and print it for the given field.
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref);

   --  Format the time tick as a duration and print it for the given field.
   procedure Print_Duration (Console  : in out Console_Type;
                             Field    : in Field_Type;
                             Duration : in MAT.Types.Target_Tick_Ref);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer;
                          Justify : in Justify_Type := J_LEFT);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String;
                          Justify : in Justify_Type := J_LEFT);

private

   type Field_Size_Array is array (Field_Type) of Natural;

   type Field_List_Array is array (1 .. Field_Type'Pos (Field_Type'Last)) of Field_Type;

   type Console_Type is abstract tagged limited record
      Sizes       : Field_Size_Array := (others => 1);
      Cols        : Field_Size_Array := (others => 1);
      Fields      : Field_List_Array;
      Field_Count : Natural := 0;
   end record;

end MAT.Consoles;

Declare a new Print_Field procedure to print a range of address