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