1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Events; 
  10. with Themes;                            use Themes; 
  11.  
  12. private with Ada.Containers.Indefinite_Vectors; 
  13.  
  14. pragma Elaborate_All( Events ); 
  15.  
  16. package Events.Keen is 
  17.  
  18.     type Dialog_Desc is new Object with private; 
  19.     type A_Dialog_Desc is access all Dialog_Desc'Class; 
  20.  
  21.     -- Creates a dialog description for a dialog event. There isn't an exposed 
  22.     -- delete procedure because these are meant to be passed to Queue_Dialog. 
  23.     function Create_Dialog_Desc( name : String; 
  24.                                  text : String ) return A_Dialog_Desc; 
  25.     pragma Postcondition( Create_Dialog_Desc'Result /= null ); 
  26.  
  27.     -- Adds a new choice to the description, at the end of the list. 
  28.     procedure Add_Choice( this : not null access Dialog_Desc'Class; text : String ); 
  29.  
  30.     -- Returns the number of choices added to the description. 
  31.     function Get_Choices( this : not null access Dialog_Desc'Class ) return Natural; 
  32.  
  33.     -- Returns an empty string if 'choice' doesn't exist. 
  34.     function Get_Choice( this   : not null access Dialog_Desc'Class; 
  35.                          choice : Positive ) return String; 
  36.  
  37.     -- Returns the dialog's name. 
  38.     function Get_Name( this : not null access Dialog_Desc'Class ) return String; 
  39.  
  40.     -- Returns the dialog's text. 
  41.     function Get_Text( this : not null access Dialog_Desc'Class ) return String; 
  42.  
  43.     ---------------------------------------------------------------------------- 
  44.  
  45.     type Dialog_Event is new Event with private; 
  46.     type A_Dialog_Event is access all Dialog_Event'Class; 
  47.  
  48.     DIALOG_ID : constant Event_Id := To_Event_Id( "Dialog" ); 
  49.  
  50.     -- Returns a reference to the event's Dialog_Desc object. It belongs to the 
  51.     -- event; do not modify it. 
  52.     function Get_Desc( this : not null access Dialog_Event'Class ) return A_Dialog_Desc; 
  53.     pragma Postcondition( Get_Desc'Result /= null ); 
  54.  
  55.     -- Returns the id the dialog was given when it was queued. Any response to 
  56.     -- the dialog should have this id. 
  57.     function Get_Dialog_Id( this : not null access Dialog_Event'Class ) return Integer; 
  58.  
  59.     ---------------------------------------------------------------------------- 
  60.  
  61.     type Dialog_Response_Event is new Event with private; 
  62.     type A_Dialog_Response_Event is access all Dialog_Response_Event'Class; 
  63.  
  64.     DIALOG_RESPONSE_ID : constant Event_Id := To_Event_Id( "Dialog_Response" ); 
  65.  
  66.     -- Returns the ordinal choice of the dialog's response. 
  67.     function Get_Choice( this : not null access Dialog_Response_Event'Class ) return Positive; 
  68.  
  69.     -- Returns the id of the dialog to which response belongs. 
  70.     function Get_Dialog_Id( this : not null access Dialog_Response_Event'Class ) return Integer; 
  71.  
  72.     ---------------------------------------------------------------------------- 
  73.  
  74.     type Give_Ammo_Event is new Event with private; 
  75.     type A_Give_Ammo_Event is access all Give_Ammo_Event'Class; 
  76.  
  77.     GIVE_AMMO_ID : constant Event_Id := To_Event_Id( "Give_Ammo" ); 
  78.  
  79.     function Get_Amount( this : not null access Give_Ammo_Event'Class ) return Integer; 
  80.  
  81.     ---------------------------------------------------------------------------- 
  82.  
  83.     type Give_Drops_Event is new Event with private; 
  84.     type A_Give_Drops_Event is access all Give_Drops_Event'Class; 
  85.  
  86.     GIVE_DROPS_ID : constant Event_Id := To_Event_Id( "Give_Drops" ); 
  87.  
  88.     function Get_Amount( this : not null access Give_Drops_Event'Class ) return Integer; 
  89.  
  90.     ---------------------------------------------------------------------------- 
  91.  
  92.     type Give_Points_Event is new Event with private; 
  93.     type A_Give_Points_Event is access all Give_Points_Event'Class; 
  94.  
  95.     GIVE_POINTS_ID : constant Event_Id := To_Event_Id( "Give_Points" ); 
  96.  
  97.     function Get_Amount( this : not null access Give_Points_Event'Class ) return Integer; 
  98.  
  99.     ---------------------------------------------------------------------------- 
  100.  
  101.     type Message_Event is new Event with private; 
  102.     type A_Message_Event is access all Message_Event'Class; 
  103.  
  104.     MESSAGE_ID : constant Event_Id := To_Event_Id( "Message" ); 
  105.  
  106.     function Get_Icon( this : not null access Message_Event'Class ) return String; 
  107.  
  108.     function Get_Text( this : not null access Message_Event'Class ) return String; 
  109.  
  110.     function Get_Text_Align( this : not null access Message_Event'Class ) return Align_Type; 
  111.  
  112.     ---------------------------------------------------------------------------- 
  113.  
  114.     -- 'dialogId' should be a unique number to identify the 
  115.     -- Dialog_Response_Event that will be sent in response. 'description' will 
  116.     -- be consumed. 
  117.     procedure Queue_Dialog( dialogId    : Integer; 
  118.                             description : in out A_Dialog_Desc ); 
  119.     pragma Precondition( description /= null ); 
  120.     pragma Postcondition( description = null ); 
  121.  
  122.     procedure Queue_Dialog_Response( dialogId : Integer; choice : Positive ); 
  123.  
  124.     procedure Queue_Give_Ammo( amount : Integer ); 
  125.  
  126.     procedure Queue_Give_Drops( amount : Integer ); 
  127.  
  128.     procedure Queue_Give_Points( amount : Integer ); 
  129.  
  130.     procedure Queue_Message( text      : String; 
  131.                              icon      : String := ""; 
  132.                              textAlign : Align_Type := Align_Right ); 
  133.  
  134. private 
  135.  
  136.     package String_Vectors is new Ada.Containers.Indefinite_Vectors( Positive, String, "=" ); 
  137.  
  138.     type Dialog_Desc is new Object with 
  139.         record 
  140.             name, 
  141.             text    : Unbounded_String; 
  142.             choices : String_Vectors.Vector; 
  143.         end record; 
  144.  
  145.     procedure Adjust( this : access Dialog_Desc ); 
  146.  
  147.     procedure Construct( this : access Dialog_Desc; 
  148.                          name : String; 
  149.                          text : String ); 
  150.  
  151.     -- Returns a deep copy of the dialog description. 
  152.     function Copy( src : A_Dialog_Desc ) return A_Dialog_Desc; 
  153.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  154.  
  155.     ---------------------------------------------------------------------------- 
  156.  
  157.     type Dialog_Event is new Event with 
  158.         record 
  159.             dialogId : Integer := 0; 
  160.             desc     : A_Dialog_Desc := null; 
  161.         end record; 
  162.  
  163.     procedure Adjust( this : access Dialog_Event ); 
  164.  
  165.     procedure Construct( this     : access Dialog_Event; 
  166.                          dialogId : Integer; 
  167.                          desc     : in out A_Dialog_Desc ); 
  168.     pragma Precondition( desc /= null ); 
  169.     pragma Postcondition( desc = null ); 
  170.  
  171.     procedure Delete( this : in out Dialog_Event ); 
  172.  
  173.     ---------------------------------------------------------------------------- 
  174.  
  175.     type Dialog_Response_Event is new Event with 
  176.         record 
  177.             dialogId : Integer := 0; 
  178.             choice   : Positive; 
  179.         end record; 
  180.  
  181.     procedure Construct( this     : access Dialog_Response_Event; 
  182.                          dialogId : Integer; 
  183.                          choice   : Positive ); 
  184.  
  185.     ---------------------------------------------------------------------------- 
  186.  
  187.     type Give_Ammo_Event is new Event with 
  188.         record 
  189.             amount : Integer := 0; 
  190.         end record; 
  191.  
  192.     procedure Construct( this : access Give_Ammo_Event; amount : Integer ); 
  193.  
  194.     ---------------------------------------------------------------------------- 
  195.  
  196.     type Give_Drops_Event is new Event with 
  197.         record 
  198.             amount : Integer := 0; 
  199.         end record; 
  200.  
  201.     procedure Construct( this : access Give_Drops_Event; amount : Integer ); 
  202.  
  203.     ---------------------------------------------------------------------------- 
  204.  
  205.     type Give_Points_Event is new Event with 
  206.         record 
  207.             amount : Integer := 0; 
  208.         end record; 
  209.  
  210.     procedure Construct( this : access Give_Points_Event; amount : Integer ); 
  211.  
  212.     ---------------------------------------------------------------------------- 
  213.  
  214.     type Message_Event is new Event with 
  215.         record 
  216.             text      : Unbounded_String; 
  217.             icon      : Unbounded_String; 
  218.             textAlign : Align_Type; 
  219.         end record; 
  220.  
  221.     procedure Construct( this      : access Message_Event; 
  222.                          text      : String; 
  223.                          icon      : String; 
  224.                          textAlign : Align_Type ); 
  225.  
  226. end Events.Keen;