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.Corrals;                    use Events.Corrals; 
  10. with Events.Listeners;                  use Events.Listeners; 
  11. with Game_States;                       use Game_States; 
  12. with Game_Views;                        use Game_Views; 
  13. with Objects;                           use Objects; 
  14. with Processes;                         use Processes; 
  15. with Values;                            use Values; 
  16.  
  17. private with Actors; 
  18. private with Ada.Containers.Indefinite_Doubly_Linked_Lists; 
  19. private with Ada.Containers.Ordered_Maps; 
  20. private with Associations; 
  21. private with Entities; 
  22. private with Events; 
  23. private with Events.World; 
  24. private with Physics.Managers; 
  25. private with Processes.Managers; 
  26. private with Worlds; 
  27.  
  28. package Games is 
  29.  
  30.     -- The Game class is parent object in the Game Logic system, which is 
  31.     -- responsible for managing the game session and all the interactions 
  32.     -- between entities during gameplay. 
  33.     -- 
  34.     -- The Game provides a Process_Manager to run the game logic, a Corral to 
  35.     -- receive events sent to listeners in the game logic, an association of 
  36.     -- modifyable game session variables, and game session persistence. The Game 
  37.     -- object itself is a Process and Event_Listener that is attached to its own 
  38.     -- Process_Manager and Corral facilities. The Game class also provides a 
  39.     -- limited interface, Game_State, which allow objects to reference it and 
  40.     -- access game state information and game session variables without a full 
  41.     -- view of the Game class, which in some cases would cause circular 
  42.     -- dependencies or allow unnecessary exposing of information. 
  43.     type Game is abstract new Limited_Object and 
  44.                               Event_Listener and 
  45.                               Game_State and 
  46.                               Process with private; 
  47.     type A_Game is access all Game'Class; 
  48.  
  49.     -- Creates a new Game object using the registered allocator. If no 
  50.     -- allocator has been registered, an exception will be raised. 
  51.     function Create_Game return A_Game; 
  52.     pragma Postcondition( Create_Game'Result /= null ); 
  53.  
  54.     -- Adds integer 'val' to game session variable 'var'. A Game_Var_Changed 
  55.     -- event is queued. An exception is raised on error. 
  56.     procedure Game_Var_Add( this : not null access Game'Class; 
  57.                             var  : String; 
  58.                             val  : Integer ); 
  59.     pragma Precondition( var'Length > 0 ); 
  60.  
  61.     -- Returns the Game's event Corral. It is created during Game construction. 
  62.     function Get_Corral( this : not null access Game'Class ) return A_Corral; 
  63.     pragma Postcondition( Get_Corral'Result /= null ); 
  64.  
  65.     -- Returns the value of game session var 'var' as an integer. An exception 
  66.     -- will be raised on error. 
  67.     function Get_Game_Var( this : access Game; var : String ) return Integer; 
  68.  
  69.     -- Returns the value of game session var 'var', or null if not found. The 
  70.     -- caller is responsible for deleting the returned value. 
  71.     function Get_Game_Var( this : access Game; var  : String ) return A_Value; 
  72.  
  73.     -- Sets the game's view. 'view' is consumed and then owned by the Game 
  74.     -- object. If the view has already been set, a Constraint_Error will be 
  75.     -- raised and 'view' will not be modified. 
  76.     procedure Set_View( this : not null access Game'Class; 
  77.                         view : in out A_Game_View ); 
  78.     pragma Precondition( view /= null ); 
  79.     pragma Postcondition( view = null ); 
  80.  
  81.     -- Starts the game logic and attaches it to the framework. If the Game's 
  82.     -- view has not been set, a Constraint_Error will be raised. 
  83.     procedure Start( this : access Game ); 
  84.  
  85.     -- Stops the game logic and detaches it from the framework. 
  86.     procedure Stop( this : not null access Game'Class ); 
  87.  
  88.     -- Deletes the Game. 
  89.     procedure Delete( this : in out A_Game ); 
  90.     pragma Postcondition( this = null ); 
  91.  
  92. private 
  93.  
  94.     use Actors; 
  95.     use Associations; 
  96.     use Entities; 
  97.     use Events; 
  98.     use Events.World; 
  99.     use Physics.Managers; 
  100.     use Processes.Managers; 
  101.     use Worlds; 
  102.  
  103.     package Actor_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists( A_Actor, "=" ); 
  104.  
  105.     package Actor_Maps is new Ada.Containers.Ordered_Maps( Entity_Id, A_Actor, "<", "=" ); 
  106.  
  107.     ---------------------------------------------------------------------------- 
  108.  
  109.     type Game is abstract new Limited_Object and 
  110.                               Event_Listener and 
  111.                               Game_State and 
  112.                               Process with 
  113.         record 
  114.             started, 
  115.             stopped     : Boolean := False; 
  116.             view        : A_Game_View := null; 
  117.             corral      : A_Corral := null; 
  118.             physics     : A_Physics := null; 
  119.             pman        : A_Process_Manager := null; 
  120.             sessionVars : A_Association := null; 
  121.             world       : A_World := null; 
  122.             actors      : Actor_Lists.List; 
  123.             actorIndex  : Actor_Maps.Map; 
  124.  
  125.             -- a game session is in progress; true between New_Game and End_Game 
  126.             inProgress  : Boolean := False; 
  127.  
  128.             -- the game logic execution is paused. true when a game session is 
  129.             -- in progress and the game receives a Pause_Game event. 
  130.             paused      : Boolean := False; 
  131.  
  132.             -- true when game logic is currently executing; false when no game 
  133.             -- is in progress and when the game is paused. 
  134.             playing     : Boolean := False; 
  135.         end record; 
  136.  
  137.     procedure Construct( this : access Game ); 
  138.  
  139.     procedure Delete( this : in out Game ); 
  140.  
  141.     -- Adds the Game object as an event listener for a set of events. Override 
  142.     -- this procedure, calling it first, to listen for additional events. 
  143.     procedure Add_Event_Listeners( this : access Game ); 
  144.  
  145.     -- Ends the current game session. Game logic is stopped and a Game_State 
  146.     -- event is sent. The 'interrupted' argument indicates whether or not the 
  147.     -- user interrupted the game session manually, or if the game session ended 
  148.     -- natually by winning or losing. 
  149.     procedure End_Game( this : access Game; interrupted : Boolean ); 
  150.  
  151.     -- Returns the Process name of the Game object. 
  152.     function Get_Process_Name( this : access Game ) return String; 
  153.     pragma Postcondition( Get_Process_Name'Result'Length > 0 ); 
  154.  
  155.     -- Handles the events that the Game is registered to receive from its Corral. 
  156.     procedure Handle_Event( this : access Game; 
  157.                             evt  : in out A_Event; 
  158.                             resp : out Response_Type ); 
  159.     pragma Precondition( evt /= null ); 
  160.  
  161.     -- Called when the Load_World event is received, to load and attach a world 
  162.     -- to the game framework during a game session. 
  163.     procedure Handle_Load_World( this : access Game; 
  164.                                  evt  : not null A_Load_World_Event; 
  165.                                  resp : out Response_Type ); 
  166.  
  167.     -- Begins a new game session from the start. Override this procedure to 
  168.     -- setup initial game state and load the first game world. An overriding 
  169.     -- implementation must call this first. 
  170.     procedure New_Game( this : access Game ); 
  171.  
  172.     -- Pauses the gameplay. An overriding implementation must call this first. 
  173.     -- It will set the paused field in the Game to 'enabled'. 
  174.     procedure Pause( this : access Game; enabled : Boolean ); 
  175.  
  176.     -- Removes the Game object as an event listener for a set of events. If 
  177.     -- Add_Event_Listener is overridden, then this should be overridden to 
  178.     -- remove the additional specific events. An overriding implementation must 
  179.     -- call this last. 
  180.     procedure Remove_Event_Listeners( this : access Game ); 
  181.  
  182.     -- Sets game session variable 'var' to integer 'val'. A Game_Var_Changed 
  183.     -- event is queued. 
  184.     procedure Set_Game_Var( this : not null access Game'Class; 
  185.                             var  : String; 
  186.                             val  : Integer ); 
  187.     pragma Precondition( var'Length > 0 ); 
  188.  
  189.     -- Sets game session variable 'var' to boolean 'val'. A Game_Var_Changed 
  190.     -- event is queued. 
  191.     procedure Set_Game_Var( this : not null access Game'Class; 
  192.                             var  : String; 
  193.                             val  : Boolean ); 
  194.     pragma Precondition( var'Length > 0 ); 
  195.  
  196.     -- Sets game session variable 'var' to string 'val'. A Game_Var_Changed 
  197.     -- event is queued. 
  198.     procedure Set_Game_Var( this : not null access Game'Class; 
  199.                             var  : String; 
  200.                             val  : String ); 
  201.     pragma Precondition( var'Length > 0 ); 
  202.  
  203.     -- Sets the playing state of the game, enabling or disabling game logic 
  204.     -- execution. This will only be effective if a game session is in progress 
  205.     -- and gameplay is not paused. 
  206.     procedure Set_Playing( this : not null access Game'Class; playing : Boolean ); 
  207.  
  208.     -- Sets the game session's world, deleting the currently active one and 
  209.     -- replacing it with 'world'. 'world' will be consumed. 
  210.     procedure Set_World( this  : not null access Game'Class; 
  211.                          world : in out A_World ); 
  212.     pragma Postcondition( world = null ); 
  213.  
  214.     -- Sets the game session's world, replacing the currently active world with 
  215.     -- 'newWorld' and returning it as 'oldWorld'. 
  216.     procedure Set_World( this     : not null access Game'Class; 
  217.                          newWorld : in out A_World; 
  218.                          oldWorld : out A_World ); 
  219.     pragma Postcondition( newWorld = null ); 
  220.  
  221.     -- Executes one frame of Game logic. Implement this procedure to perform 
  222.     -- logic at the Game scope. 
  223.     procedure Tick( this : access Game; time : Tick_Time ) is null; 
  224.  
  225.     ---------------------------------------------------------------------------- 
  226.  
  227.     -- A allocator for a concrete Game implementation. 
  228.     type Allocator is access function return A_Game; 
  229.  
  230.     -- Registers the allocator function used by Create_Game to create an 
  231.     -- instance of the appropriate concrete Game subclass. This should be called 
  232.     -- at elaboration time. 
  233.     procedure Register_Allocator( allocate : not null Allocator ); 
  234.  
  235. end Games;