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 Allegro.Displays;                  use Allegro.Displays; 
  10. with Events.Corrals;                    use Events.Corrals; 
  11. with Events.Listeners;                  use Events.Listeners; 
  12. with Objects;                           use Objects; 
  13. with Processes;                         use Processes; 
  14. with Values;                            use Values; 
  15. with Widgets;                           use Widgets; 
  16. with Widgets.Containers.Windows;        use Widgets.Containers.Windows; 
  17.  
  18. private with Ada.Containers.Indefinite_Hashed_Maps; 
  19. private with Ada.Strings.Hash_Case_Insensitive; 
  20. private with Allegro.Events; 
  21. private with Audio_Players; 
  22. private with Events; 
  23. private with Input_Handlers; 
  24. private with Processes.Managers; 
  25. private with Renderers; 
  26.  
  27. package Game_Views is 
  28.  
  29.     -- The Game_View object is the parent object in the View system, which is 
  30.     -- responsible for managing all user interaction with the game. Input 
  31.     -- handling, rendering, and audio are all subsystems managed by the 
  32.     -- Game_View class. 
  33.     -- 
  34.     -- The Game_View provides a Process_Manager to service Process objects 
  35.     -- within the view system, and a Corral to receive events sent to event 
  36.     -- listener objects. The Game_View itself is a Process and an Event_Listener 
  37.     -- object. 
  38.     type Game_View is abstract new Limited_Object and 
  39.                                    Event_Listener and 
  40.                                    Process with private; 
  41.     type A_Game_View is access all Game_View'Class; 
  42.     pragma No_Strict_Aliasing( A_Game_View ); 
  43.  
  44.     -- Creates and returns a new Game_View object using the registered allocator 
  45.     -- function. The size of 'display' is the actual size of OS window on the 
  46.     -- screen. An exception will be raised if no allocator is registered. 
  47.     function Create_Game_View( display : not null A_Allegro_Display ) return A_Game_View; 
  48.     pragma Postcondition( Create_Game_View'Result /= null ); 
  49.  
  50.     -- Deletes the Game_View. 
  51.     procedure Delete( this : in out A_Game_View ); 
  52.     pragma Postcondition( this = null ); 
  53.  
  54.     -- Initializes the game view, attaching it to the framework. This will 
  55.     -- attach event listeners, processes, start the view's subsystems (audio, 
  56.     -- etc.) and begin running the view's Process_Manager. If the view has 
  57.     -- already been started, then this will do nothing. Start_View() will be 
  58.     -- called at the end of this procedure. 
  59.     procedure Initialize( this : not null access Game_View'Class ); 
  60.  
  61.     -- Finalizes the game view, detaching it from the framework. This must be 
  62.     -- called after Initialize() and before deleting the object. If the view has 
  63.     -- not been initialize, or has already been finalized, this will do nothing. 
  64.     -- Stop_View() will be called at the beginning of this procedure. 
  65.     procedure Finalize( this : not null access Game_View'Class ); 
  66.  
  67.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  68.  
  69.     -- Queues an event to begin a new game from the beginning. If a game session 
  70.     -- is currently in progress, it will be aborted first. The new game will not 
  71.     -- begin immediately; The view will be notified of the game session 
  72.     -- beginning via the On_Game_State_Changed() procedure. 
  73.     procedure New_Game( this : not null access Game_View'Class ); 
  74.  
  75.     -- Notifies the game session that the view has finished loading resources 
  76.     -- after a world change and is ready for game play. 
  77.     -- 
  78.     -- When the current world changes, the game notifies the view of the next 
  79.     -- world for play, via the New_World event, and goes into a waiting state. 
  80.     -- It remains waiting until the view indicates it is ready for game play via 
  81.     -- this procedure. 
  82.     procedure Ready_For_Play( this : not null access Game_View'Class ); 
  83.  
  84.     -- Queue an event to pause/resume game play, if a game is in session. Note 
  85.     -- that the paused state of the game will not change immediately; the view 
  86.     -- will be notified of the change in state by an event, which can be handled 
  87.     -- with the On_Game_Paused() procedure. 
  88.     procedure Pause_Game( this  : not null access Game_View'Class; 
  89.                           pause : Boolean ); 
  90.  
  91.     -- Returns True if a game is in session. 
  92.     function Is_Game_In_Session( this : not null access Game_View'Class ) return Boolean; 
  93.  
  94.     -- Returns True if a game is in session and game play is paused. 
  95.     function Is_Paused( this : not null access Game_View'Class ) return Boolean; 
  96.  
  97.     -- Queues an event to end the current game, if a game is in session. It will 
  98.     -- not be ended immediately; The view will be notified of the game session 
  99.     -- ending via the On_Game_State_Changed() procedure. 
  100.     procedure End_Game( this : not null access Game_View'Class ); 
  101.  
  102.     -- Exits the application. Make sure game session data is saved prior to 
  103.     -- calling this, if it needs to be saved. 
  104.     procedure Quit( this : not null access Game_View'Class ); 
  105.  
  106.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  107.  
  108.     -- Attaches a Process to the view's Process_Manager. 
  109.     procedure Attach( this    : not null access Game_View'Class; 
  110.                       process : not null A_Process ); 
  111.  
  112.     -- Detaches a Process from the view's Process_Manager. 
  113.     procedure Detach( this    : not null access Game_View'Class; 
  114.                       process : not null A_Process ); 
  115.  
  116.     -- Returns the view's Corral. The view creates its corral at construction. 
  117.     function Get_Corral( this : not null access Game_View'Class ) return A_Corral; 
  118.     pragma Postcondition( Get_Corral'Result /= null ); 
  119.  
  120.     -- Returns the view's display. 
  121.     function Get_Display( this : not null access Game_View'Class ) return A_Allegro_Display; 
  122.  
  123.     -- Returns a widget in the registry by id. Raises exception ID_NOT_FOUND if 
  124.     -- the widget does not exist. 
  125.     function Get_Widget( this : not null access Game_View'Class; 
  126.                          id   : String ) return A_Widget; 
  127.     pragma Postcondition( Get_Widget'Result /= null ); 
  128.  
  129.     -- Returns the view's Window widget. This will return null if the window has 
  130.     -- not yet been set. 
  131.     function Get_Window( this : not null access Game_View'Class ) return A_Window; 
  132.  
  133.     -- Adds a widget to the view's widget registry. Raises exception 
  134.     -- DUPLICATE_ID if a widget with the same id is already registered. 
  135.     procedure Register( this   : not null access Game_View'Class; 
  136.                         widget : not null A_Widget ); 
  137.  
  138.     -- Removes a widget from the view's registry. If the widget is not 
  139.     -- registered, nothing happens. 
  140.     procedure Unregister( this : not null access Game_View'Class; id : String ); 
  141.     pragma Precondition( id'Length > 0 ); 
  142.  
  143.     ---------------------------------------------------------------------------- 
  144.  
  145.     -- raised on attempt to register a widget with a duplicate id 
  146.     DUPLICATE_ID : exception; 
  147.  
  148.     -- raised on attempt to access an registered widget by id 
  149.     ID_NOT_FOUND : exception; 
  150.  
  151. private 
  152.  
  153.     use Allegro.Events; 
  154.     use Audio_Players; 
  155.     use Events; 
  156.     use Input_Handlers; 
  157.     use Processes.Managers; 
  158.     use Renderers; 
  159.  
  160.     -- A Widget_Registry maps widget ids to widget references. The registry will 
  161.     -- contain references to all created widgets, whether they are parented or 
  162.     -- not. 
  163.     package Widget_Registry is new Ada.Containers.Indefinite_Hashed_Maps( 
  164.         String, A_Widget, Ada.Strings.Hash_Case_Insensitive, "=", "=" ); 
  165.     use Widget_Registry; 
  166.  
  167.     ----------------------------------------------------------------------------- 
  168.  
  169.     type Game_View is abstract new Limited_Object and 
  170.                                    Event_Listener and 
  171.                                    Process with 
  172.         record 
  173.             initialized, 
  174.             finalized       : Boolean := False; 
  175.  
  176.             display         : A_Allegro_Display := null; 
  177.             acquiredDisplay : Boolean := False;    -- .display set active by .pman? 
  178.             width, height   : Natural := 0; 
  179.  
  180.             win             : A_Window := null; 
  181.             widgets         : Widget_Registry.Map; 
  182.  
  183.             pman            : A_Process_Manager := null; 
  184.             renderer        : A_Renderer := null; 
  185.             audioPlayer     : A_Audio_Player := null; 
  186.             inhandler       : A_Input_Handler := null; 
  187.             corral          : A_Corral := null; 
  188.             queue           : A_Allegro_Event_Queue := null; 
  189.  
  190.             gameInSession   : Boolean := False;    -- game in session? 
  191.             paused          : Boolean := False;    -- if gameInSession, paused? 
  192.         end record; 
  193.  
  194.     procedure Construct( this          : access Game_View; 
  195.                          display       : not null A_Allegro_Display; 
  196.                          width, height : Natural ); 
  197.  
  198.     procedure Delete( this : in out Game_View ); 
  199.  
  200.     function Get_Process_Name( this : access Game_View ) return String; 
  201.     pragma Postcondition( Get_Process_Name'Result'Length > 0 ); 
  202.  
  203.     -- Called when the window is requested to close by the OS. This will invoke 
  204.     -- On_Close_Window() and exit the application by queueing an 
  205.     -- Exit_Application message if it returns True. Override On_Close_Window() 
  206.     -- if a confirmation dialog or some other activity must happen when the 
  207.     -- window is asked to close. 
  208.     procedure Handle_Close_Window( this : not null access Game_View'Class ); 
  209.  
  210.     -- Handles all events that the Game_View is registered to receive. 
  211.     procedure Handle_Event( this : access Game_View; 
  212.                             evt  : in out A_Event; 
  213.                             resp : out Response_Type ); 
  214.     pragma Precondition( evt /= null ); 
  215.  
  216.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  217.  
  218.     -- Creates the initial widgets in the view. This must be overridden by a 
  219.     -- subclass to create the necessary widgets and add them to 'win'. The 
  220.     -- base implementation does nothing. 
  221.     procedure Initialize_Widgets( this : access Game_View; 
  222.                                   win  : not null A_Window ) is null; 
  223.  
  224.     -- Called when a request to close the window is received by the Game_View. 
  225.     -- On_Close_Window() should be overridden if some action, like showing a 
  226.     -- confirmation dialog, should be performed instead. Set 'allowed' to False 
  227.     -- prevent the application from exiting. 
  228.     procedure On_Close_Window( this    : access Game_View; 
  229.                                allowed : in out Boolean ) is null; 
  230.  
  231.     -- Called as part of Initialize(), this procedure can be overridden to add 
  232.     -- the view as a listener for various events or anything else that needs to 
  233.     -- be done once at initialization. 
  234.     procedure On_Initialize( this : access Game_View ) is null; 
  235.  
  236.     -- Called as part of Finalize(), this procedure can be overridden to do 
  237.     -- anything that needs to be done to clean up at finalization. For example, 
  238.     -- any events the view was registered to receive in On_Initialize() must be 
  239.     -- unregistered here. 
  240.     procedure On_Finalize( this : access Game_View ) is null; 
  241.  
  242.     -- Called when the game logic is paused or resumed. Override this procedure 
  243.     -- to perform actions when the game pause state changes. 
  244.     procedure On_Game_Paused( this : access Game_View; paused : Boolean ) is null; 
  245.  
  246.     -- This is called when a game session begins or ends. 'isInterrupted', 
  247.     -- indicates whether or not the game session was aborted before the player 
  248.     -- won or lost. 
  249.     procedure On_Game_State_Changed( this          : access Game_View; 
  250.                                      isPlaying     : Boolean; 
  251.                                      isInterrupted : Boolean ) is null; 
  252.  
  253.     -- Called when world loading begins. Override this procedure to display a 
  254.     -- loading message, etc., during loading. The On_Loading_End handler will 
  255.     -- be called when the loading has completed successfully or failed. 
  256.     procedure On_Loading_Begin( this : access Game_View ) is null; 
  257.  
  258.     -- Called when world loading has ended. Override this procedure to hide any 
  259.     -- loading messages, etc, that were shown by On_Loading_Begin. If 'success' 
  260.     -- is True, loading was successfully completed. Otherwise, 'message' will 
  261.     -- contain a description of the failure to load. 
  262.     procedure On_Loading_End( this    : access Game_View; 
  263.                               success : Boolean; 
  264.                               message : String ) is null; 
  265.  
  266.     -- Called when a property of the current world changes, or when a world is 
  267.     -- loaded. Override this procedure to receive the new property name and 
  268.     -- value. 
  269.     procedure On_World_Property_Changed( this  : access Game_View; 
  270.                                          name  : String; 
  271.                                          value : Value_Ptr'Class ) is null; 
  272.  
  273.     -- Executes the Game_View logic. 'time' is the amount of time elapsed since 
  274.     -- the previous tick. Overriding implementations must call this first. 
  275.     procedure Tick( this : access Game_View; time : Tick_Time ); 
  276.  
  277.     ---------------------------------------------------------------------------- 
  278.  
  279.     -- An allocator function for a concrete Game_View implemenation. 'display' 
  280.     -- is the Allegro display window in which the view will be drawn. 
  281.     type Allocator is 
  282.         access function( display : not null A_Allegro_Display ) return A_Game_View; 
  283.  
  284.     -- Registers the allocator function used by Create_Game_View() to create an 
  285.     -- instance of the appropriate concrete Game_View subclass. This should be 
  286.     -- called at elaboration time. 
  287.     procedure Register_Allocator( allocate : not null Allocator ); 
  288.  
  289. end Game_Views;