--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
with Allegro.Displays; use Allegro.Displays;
with Events.Corrals; use Events.Corrals;
with Events.Listeners; use Events.Listeners;
with Objects; use Objects;
with Processes; use Processes;
with Values; use Values;
with Widgets; use Widgets;
with Widgets.Containers.Windows; use Widgets.Containers.Windows;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Strings.Hash_Case_Insensitive;
private with Allegro.Events;
private with Audio_Players;
private with Events;
private with Input_Handlers;
private with Processes.Managers;
private with Renderers;
package Game_Views is
-- The Game_View object is the parent object in the View system, which is
-- responsible for managing all user interaction with the game. Input
-- handling, rendering, and audio are all subsystems managed by the
-- Game_View class.
--
-- The Game_View provides a Process_Manager to service Process objects
-- within the view system, and a Corral to receive events sent to event
-- listener objects. The Game_View itself is a Process and an Event_Listener
-- object.
type Game_View is abstract new Limited_Object and
Event_Listener and
Process with private;
type A_Game_View is access all Game_View'Class;
pragma No_Strict_Aliasing( A_Game_View );
-- Creates and returns a new Game_View object using the registered allocator
-- function. The size of 'display' is the actual size of OS window on the
-- screen. An exception will be raised if no allocator is registered.
function Create_Game_View( display : not null A_Allegro_Display ) return A_Game_View;
pragma Postcondition( Create_Game_View'Result /= null );
-- Deletes the Game_View.
procedure Delete( this : in out A_Game_View );
pragma Postcondition( this = null );
-- Initializes the game view, attaching it to the framework. This will
-- attach event listeners, processes, start the view's subsystems (audio,
-- etc.) and begin running the view's Process_Manager. If the view has
-- already been started, then this will do nothing. Start_View() will be
-- called at the end of this procedure.
procedure Initialize( this : not null access Game_View'Class );
-- Finalizes the game view, detaching it from the framework. This must be
-- called after Initialize() and before deleting the object. If the view has
-- not been initialize, or has already been finalized, this will do nothing.
-- Stop_View() will be called at the beginning of this procedure.
procedure Finalize( this : not null access Game_View'Class );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Queues an event to begin a new game from the beginning. If a game session
-- is currently in progress, it will be aborted first. The new game will not
-- begin immediately; The view will be notified of the game session
-- beginning via the On_Game_State_Changed() procedure.
procedure New_Game( this : not null access Game_View'Class );
-- Notifies the game session that the view has finished loading resources
-- after a world change and is ready for game play.
--
-- When the current world changes, the game notifies the view of the next
-- world for play, via the New_World event, and goes into a waiting state.
-- It remains waiting until the view indicates it is ready for game play via
-- this procedure.
procedure Ready_For_Play( this : not null access Game_View'Class );
-- Queue an event to pause/resume game play, if a game is in session. Note
-- that the paused state of the game will not change immediately; the view
-- will be notified of the change in state by an event, which can be handled
-- with the On_Game_Paused() procedure.
procedure Pause_Game( this : not null access Game_View'Class;
pause : Boolean );
-- Returns True if a game is in session.
function Is_Game_In_Session( this : not null access Game_View'Class ) return Boolean;
-- Returns True if a game is in session and game play is paused.
function Is_Paused( this : not null access Game_View'Class ) return Boolean;
-- Queues an event to end the current game, if a game is in session. It will
-- not be ended immediately; The view will be notified of the game session
-- ending via the On_Game_State_Changed() procedure.
procedure End_Game( this : not null access Game_View'Class );
-- Exits the application. Make sure game session data is saved prior to
-- calling this, if it needs to be saved.
procedure Quit( this : not null access Game_View'Class );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Attaches a Process to the view's Process_Manager.
procedure Attach( this : not null access Game_View'Class;
process : not null A_Process );
-- Detaches a Process from the view's Process_Manager.
procedure Detach( this : not null access Game_View'Class;
process : not null A_Process );
-- Returns the view's Corral. The view creates its corral at construction.
function Get_Corral( this : not null access Game_View'Class ) return A_Corral;
pragma Postcondition( Get_Corral'Result /= null );
-- Returns the view's display.
function Get_Display( this : not null access Game_View'Class ) return A_Allegro_Display;
-- Returns a widget in the registry by id. Raises exception ID_NOT_FOUND if
-- the widget does not exist.
function Get_Widget( this : not null access Game_View'Class;
id : String ) return A_Widget;
pragma Postcondition( Get_Widget'Result /= null );
-- Returns the view's Window widget. This will return null if the window has
-- not yet been set.
function Get_Window( this : not null access Game_View'Class ) return A_Window;
-- Adds a widget to the view's widget registry. Raises exception
-- DUPLICATE_ID if a widget with the same id is already registered.
procedure Register( this : not null access Game_View'Class;
widget : not null A_Widget );
-- Removes a widget from the view's registry. If the widget is not
-- registered, nothing happens.
procedure Unregister( this : not null access Game_View'Class; id : String );
pragma Precondition( id'Length > 0 );
----------------------------------------------------------------------------
-- raised on attempt to register a widget with a duplicate id
DUPLICATE_ID : exception;
-- raised on attempt to access an registered widget by id
ID_NOT_FOUND : exception;
private
use Allegro.Events;
use Audio_Players;
use Events;
use Input_Handlers;
use Processes.Managers;
use Renderers;
-- A Widget_Registry maps widget ids to widget references. The registry will
-- contain references to all created widgets, whether they are parented or
-- not.
package Widget_Registry is new Ada.Containers.Indefinite_Hashed_Maps(
String, A_Widget, Ada.Strings.Hash_Case_Insensitive, "=", "=" );
use Widget_Registry;
-----------------------------------------------------------------------------
type Game_View is abstract new Limited_Object and
Event_Listener and
Process with
record
initialized,
finalized : Boolean := False;
display : A_Allegro_Display := null;
acquiredDisplay : Boolean := False; -- .display set active by .pman?
width, height : Natural := 0;
win : A_Window := null;
widgets : Widget_Registry.Map;
pman : A_Process_Manager := null;
renderer : A_Renderer := null;
audioPlayer : A_Audio_Player := null;
inhandler : A_Input_Handler := null;
corral : A_Corral := null;
queue : A_Allegro_Event_Queue := null;
gameInSession : Boolean := False; -- game in session?
paused : Boolean := False; -- if gameInSession, paused?
end record;
procedure Construct( this : access Game_View;
display : not null A_Allegro_Display;
width, height : Natural );
procedure Delete( this : in out Game_View );
function Get_Process_Name( this : access Game_View ) return String;
pragma Postcondition( Get_Process_Name'Result'Length > 0 );
-- Called when the window is requested to close by the OS. This will invoke
-- On_Close_Window() and exit the application by queueing an
-- Exit_Application message if it returns True. Override On_Close_Window()
-- if a confirmation dialog or some other activity must happen when the
-- window is asked to close.
procedure Handle_Close_Window( this : not null access Game_View'Class );
-- Handles all events that the Game_View is registered to receive.
procedure Handle_Event( this : access Game_View;
evt : in out A_Event;
resp : out Response_Type );
pragma Precondition( evt /= null );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Creates the initial widgets in the view. This must be overridden by a
-- subclass to create the necessary widgets and add them to 'win'. The
-- base implementation does nothing.
procedure Initialize_Widgets( this : access Game_View;
win : not null A_Window ) is null;
-- Called when a request to close the window is received by the Game_View.
-- On_Close_Window() should be overridden if some action, like showing a
-- confirmation dialog, should be performed instead. Set 'allowed' to False
-- prevent the application from exiting.
procedure On_Close_Window( this : access Game_View;
allowed : in out Boolean ) is null;
-- Called as part of Initialize(), this procedure can be overridden to add
-- the view as a listener for various events or anything else that needs to
-- be done once at initialization.
procedure On_Initialize( this : access Game_View ) is null;
-- Called as part of Finalize(), this procedure can be overridden to do
-- anything that needs to be done to clean up at finalization. For example,
-- any events the view was registered to receive in On_Initialize() must be
-- unregistered here.
procedure On_Finalize( this : access Game_View ) is null;
-- Called when the game logic is paused or resumed. Override this procedure
-- to perform actions when the game pause state changes.
procedure On_Game_Paused( this : access Game_View; paused : Boolean ) is null;
-- This is called when a game session begins or ends. 'isInterrupted',
-- indicates whether or not the game session was aborted before the player
-- won or lost.
procedure On_Game_State_Changed( this : access Game_View;
isPlaying : Boolean;
isInterrupted : Boolean ) is null;
-- Called when world loading begins. Override this procedure to display a
-- loading message, etc., during loading. The On_Loading_End handler will
-- be called when the loading has completed successfully or failed.
procedure On_Loading_Begin( this : access Game_View ) is null;
-- Called when world loading has ended. Override this procedure to hide any
-- loading messages, etc, that were shown by On_Loading_Begin. If 'success'
-- is True, loading was successfully completed. Otherwise, 'message' will
-- contain a description of the failure to load.
procedure On_Loading_End( this : access Game_View;
success : Boolean;
message : String ) is null;
-- Called when a property of the current world changes, or when a world is
-- loaded. Override this procedure to receive the new property name and
-- value.
procedure On_World_Property_Changed( this : access Game_View;
name : String;
value : Value_Ptr'Class ) is null;
-- Executes the Game_View logic. 'time' is the amount of time elapsed since
-- the previous tick. Overriding implementations must call this first.
procedure Tick( this : access Game_View; time : Tick_Time );
----------------------------------------------------------------------------
-- An allocator function for a concrete Game_View implemenation. 'display'
-- is the Allegro display window in which the view will be drawn.
type Allocator is
access function( display : not null A_Allegro_Display ) return A_Game_View;
-- Registers the allocator function used by Create_Game_View() to create an
-- instance of the appropriate concrete Game_View subclass. This should be
-- called at elaboration time.
procedure Register_Allocator( allocate : not null Allocator );
end Game_Views;