1. with Events; 
  2. with Values;                            use Values; 
  3.  
  4. pragma Elaborate_All( Events ); 
  5.  
  6. package Events.Game is 
  7.  
  8.     type End_Game_Event is new Event with private; 
  9.     type A_End_Game_Event is access all End_Game_Event'Class; 
  10.  
  11.     END_GAME_ID : constant Event_Id := To_Event_Id( "End_Game" ); 
  12.  
  13.     ---------------------------------------------------------------------------- 
  14.  
  15.     type Game_Paused_Event is new Event with private; 
  16.     type A_Game_Paused_Event is access all Game_Paused_Event'Class; 
  17.  
  18.     GAME_PAUSED_ID : constant Event_Id := To_Event_Id( "Game_Paused" ); 
  19.  
  20.     function Is_Paused( this : not null access Game_Paused_Event'Class ) return Boolean; 
  21.  
  22.     ---------------------------------------------------------------------------- 
  23.  
  24.     type Game_State_Event is new Event with private; 
  25.     type A_Game_State_Event is access all Game_State_Event'Class; 
  26.  
  27.     GAME_STATE_ID : constant Event_Id := To_Event_Id( "Game_State" ); 
  28.  
  29.     function Is_Playing( this : not null access Game_State_Event'Class ) return Boolean; 
  30.  
  31.     ---------------------------------------------------------------------------- 
  32.  
  33.     type Game_Var_Changed_Event is new Event with private; 
  34.     type A_Game_Var_Changed_Event is access all Game_Var_Changed_Event'Class; 
  35.  
  36.     GAME_VAR_CHANGED_ID : constant Event_Id := To_Event_Id( "Game_Var_Changed" ); 
  37.  
  38.     function Get_Var( this : not null access Game_Var_Changed_Event'Class ) return String; 
  39.  
  40.     procedure Copy_Value( this : access Game_Var_Changed_Event; 
  41.                           val  : in out A_Value ); 
  42.     pragma Precondition( val = null ); 
  43.  
  44.     ---------------------------------------------------------------------------- 
  45.  
  46.     type Loading_Event is new Event with private; 
  47.     type A_Loading_Event is access all Loading_Event'Class; 
  48.  
  49.     LOADING_ID : constant Event_Id := To_Event_Id( "Loading" ); 
  50.  
  51.     function Is_Loading( this : not null access Loading_Event'Class ) return Boolean; 
  52.  
  53.     ---------------------------------------------------------------------------- 
  54.  
  55.     type New_Game_Event is new Event with private; 
  56.     type A_New_Game_Event is access all New_Game_Event'Class; 
  57.  
  58.     NEW_GAME_ID : constant Event_Id := To_Event_Id( "New_Game" ); 
  59.  
  60.     ---------------------------------------------------------------------------- 
  61.  
  62.     type Pause_Game_Event is new Event with private; 
  63.     type A_Pause_Game_Event is access all Pause_Game_Event'Class; 
  64.  
  65.     PAUSE_GAME_ID : constant Event_Id := To_Event_Id( "Pause_Game" ); 
  66.  
  67.     function Is_Paused( this : not null access Pause_Game_Event'Class ) return Boolean; 
  68.  
  69.     ---------------------------------------------------------------------------- 
  70.  
  71.     type Player_Died_Event is new Event with private; 
  72.     type A_Player_Died_Event is access all Player_Died_Event'Class; 
  73.  
  74.     PLAYER_DIED_ID : constant Event_Id := To_Event_Id( "Player_Died" ); 
  75.  
  76.     ---------------------------------------------------------------------------- 
  77.  
  78.     type Scroll_View_Event is new Event with private; 
  79.     type A_Scroll_View_Event is access all Scroll_View_Event'Class; 
  80.  
  81.     SCROLL_VIEW_ID : constant Event_Id := To_Event_Id( "Scroll_View" ); 
  82.  
  83.     -- Amount to scroll view in the X axis in world coordinates. 
  84.     function Get_X( this : not null access Scroll_View_Event'Class ) return Float; 
  85.  
  86.     -- Amount to scroll view in the Y axis in world coordinates. 
  87.     function Get_Y( this : not null access Scroll_View_Event'Class ) return Float; 
  88.  
  89.     ---------------------------------------------------------------------------- 
  90.  
  91.     type View_Ready_Event is new Event with private; 
  92.     type A_View_Ready_Event is access all View_Ready_Event'Class; 
  93.  
  94.     VIEW_READY_ID : constant Event_Id := To_Event_Id( "View_Ready" ); 
  95.  
  96.     function Is_Ready( this : not null access View_Ready_Event'Class ) return Boolean; 
  97.  
  98.     ---------------------------------------------------------------------------- 
  99.  
  100.     procedure Queue_End_Game; 
  101.  
  102.     procedure Queue_Game_Paused( paused : Boolean ); 
  103.  
  104.     procedure Queue_Game_State( playing : Boolean ); 
  105.  
  106.     procedure Queue_Game_Var_Changed( var : String; 
  107.                                       val : in out A_Value ); 
  108.     pragma Precondition( var'Length > 0 ); 
  109.     pragma Postcondition( val = null ); 
  110.  
  111.     procedure Queue_Loading( loading : Boolean ); 
  112.  
  113.     procedure Queue_New_Game; 
  114.  
  115.     procedure Queue_Pause_Game( paused : Boolean ); 
  116.  
  117.     procedure Queue_Player_Died; 
  118.  
  119.     procedure Queue_Scroll_View( x, y : Float ); 
  120.  
  121.     procedure Queue_View_Ready( ready : Boolean ); 
  122.  
  123. private 
  124.  
  125.     type End_Game_Event is new Event with null record; 
  126.  
  127.     ---------------------------------------------------------------------------- 
  128.  
  129.     type Game_Paused_Event is new Event with 
  130.         record 
  131.             paused : Boolean := True; 
  132.         end record; 
  133.  
  134.     procedure Construct( this : access Game_Paused_Event; paused : Boolean ); 
  135.  
  136.     function To_String( this : access Game_Paused_Event ) return String; 
  137.  
  138.     ---------------------------------------------------------------------------- 
  139.  
  140.     type Game_State_Event is new Event with 
  141.         record 
  142.             playing : Boolean := True; 
  143.         end record; 
  144.  
  145.     procedure Construct( this : access Game_State_Event; playing : Boolean ); 
  146.  
  147.     function To_String( this : access Game_State_Event ) return String; 
  148.  
  149.     ---------------------------------------------------------------------------- 
  150.  
  151.     type Game_Var_Changed_Event is new Event with 
  152.         record 
  153.             var : Unbounded_String; 
  154.             val : A_Value := null; 
  155.         end record; 
  156.  
  157.     procedure Adjust( this : access Game_Var_Changed_Event ); 
  158.  
  159.     procedure Construct( this : access Game_Var_Changed_Event; 
  160.                          var  : String; 
  161.                          val  : in out A_Value ); 
  162.     pragma Precondition( var'Length > 0 ); 
  163.     pragma Postcondition( val = null ); 
  164.  
  165.     procedure Delete( this : in out Game_Var_Changed_Event ); 
  166.  
  167.     function To_String( this : access Game_Var_Changed_Event ) return String; 
  168.  
  169.     ---------------------------------------------------------------------------- 
  170.  
  171.     type Loading_Event is new Event with 
  172.         record 
  173.             loading : Boolean; 
  174.         end record; 
  175.  
  176.     procedure Construct( this : access Loading_Event; loading : Boolean ); 
  177.  
  178.     function To_String( this : access Loading_Event ) return String; 
  179.  
  180.     ---------------------------------------------------------------------------- 
  181.  
  182.     type New_Game_Event is new Event with null record; 
  183.  
  184.     ---------------------------------------------------------------------------- 
  185.  
  186.     type Pause_Game_Event is new Event with 
  187.         record 
  188.             paused : Boolean := True; 
  189.         end record; 
  190.  
  191.     procedure Construct( this : access Pause_Game_Event; paused : Boolean ); 
  192.  
  193.     ---------------------------------------------------------------------------- 
  194.  
  195.     type Player_Died_Event is new Event with null record; 
  196.  
  197.     ---------------------------------------------------------------------------- 
  198.  
  199.     type Scroll_View_Event is new Event with 
  200.         record 
  201.             x, y : Float := 0.0; 
  202.         end record; 
  203.  
  204.     procedure Construct( this : access Scroll_View_Event; x, y : Float ); 
  205.  
  206.     ---------------------------------------------------------------------------- 
  207.  
  208.     type View_Ready_Event is new Event with 
  209.         record 
  210.             ready : Boolean := True; 
  211.         end record; 
  212.  
  213.     procedure Construct( this : access View_Ready_Event; ready : Boolean ); 
  214.  
  215. end Events.Game;