with Objects; use Objects;
with Processes; use Processes;
with Themes; use Themes;
private with Ada.Strings.Unbounded;
private with Games;
private with Locking_Objects;
private with Processes.Managers;
package Applications is
-- Several predefined values returned by Run
NO_ERROR : constant := 0;
ERROR_UNEXPECTED_EXCEPTION : constant := 1;
-- An Application is a global singleton class that implements an
-- application's initialization, runtime and shutdown behavior, and provides
-- some meta information about it. If an application's initialization fails,
-- it will not be run or closed.
type Application is abstract new Limited_Object with private;
type A_Application is access all Application'Class;
----------------------------------------------------------------------------
-- Forces creation of the global application without returning a reference.
-- If the application already exists, nothing will change.
procedure Create_Application;
-- Returns a reference to the global application, creating it if necessary.
function Get_Application return A_Application;
-- Deletes the global application if it exists.
procedure Delete_Application;
-- Forces the application to shut down, displaying the given error message.
-- If no Application object has been created, then the system level shutdown
-- procedure will be called. This is only to be used in the case of a fatal
-- error. Execution will return from this procedure, so plan accordingly.
procedure Terminate_Application( error : String );
----------------------------------------------------------------------------
-- Closes the application after initialization. Do not call this if the
-- application didn't successfully initialize.
procedure Close( this : access Application );
-- Returns the name of the company or individual that produced this application.
function Get_Company( this : not null access Application'Class ) return String;
-- Returns the short name of the application. This is used to determine the
-- names of application-specific files, etc. Special characters should be
-- avoided.
function Get_Name( this : not null access Application'Class ) return String;
-- Returns the application's Theme for UI widgets.
function Get_Theme( this : not null access Application'Class ) return A_Theme;
pragma Postcondition( Get_Theme'Result /= null );
-- Returns the title text at the top of the application's window if it's a
-- graphical application.
function Get_Window_Title( this : not null access Application'Class ) return String;
-- Initializes the application, returning True on success. If initialization
-- fails, Close should not be called because whatever was partially
-- initialized before the failure ws be finalized before returning.
function Init( this : access Application ) return Boolean is abstract;
-- Executes the application runtime. 'returnCode' contains the numeric code
-- that should be returned to the OS on exit. This procedure will block
-- until Stop is called to end application execution.
procedure Run( this : access Application; returnCode : in out Integer );
-- Stops the running application. This will cause the thread that called Run
-- to return. The value of 'errorCode' determines the value of 'returnCode'
-- that will be returned from Run.
procedure Stop( this : not null access Application'Class;
errorCode : Integer := NO_ERROR );
-- This can be raised by initialization code in other packages to indicate
-- that application initialization has failed. This exception is not raised
-- by the Application class.
INIT_EXCEPTION : exception;
-- This can be raised by the application class to indicate that it is being
-- misused. For example, calling Stop before calling Init will result in a
-- USE_ERROR exception.
USE_ERROR : exception;
private
use Ada.Strings.Unbounded;
use Games;
use Locking_Objects;
use Processes.Managers;
----------------------------------------------------------------------------
type Application is abstract new Limited_Object with
record
-- the following fields are unprotected because they don't change
company, -- developer's name
name, -- app short name
winTitle : Unbounded_String; -- app window title
lock : A_Locking_Object; -- a lock for modifying fields
-- the following fields are protected by .lock
inited : Boolean := False; -- application was initialized
ran : Boolean := False; -- application was run
interactive : Boolean := False; -- application accepts user input
graphical : Boolean := False; -- application has a window
use_mouse : Boolean := False; -- application uses the mouse
theme : A_Theme := null; -- visual theme for widgets
game : A_Game := null; -- game logic implementation
pman : A_Process_Manager := null; -- for application-level processes
xres, yres : Integer := 0; -- window resolution
scale : Integer := 1; -- window scaling factor
errorCode : Integer := NO_ERROR; -- return code for the OS
end record;
procedure Construct( this : access Application;
company : String;
name : String;
winTitle : String );
procedure Delete( this : in out Application );
-- Initializes the application by setting up graphics and hardware.
-- The values passed to this function can be overridden by the application's
-- configuration file. Returns True on success.
function Init( this : access Application;
app_xres,
app_yres : Natural;
app_scale : Positive;
app_windowed : Boolean ) return Boolean;
-- Deletes an Application object.
procedure Delete( this : in out A_Application );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- An Allocator creates a concrete Application instance.
type Allocator is access function return A_Application;
-- Registers an allocator for creating the global Application instance.
procedure Register_Allocator( allocate : not null Allocator );
end Applications;