1. with Objects;                           use Objects; 
  2. with Processes;                         use Processes; 
  3. with Themes;                            use Themes; 
  4.  
  5. private with Ada.Strings.Unbounded; 
  6. private with Games; 
  7. private with Locking_Objects; 
  8. private with Processes.Managers; 
  9.  
  10. package Applications is 
  11.  
  12.     -- Several predefined values returned by Run 
  13.     NO_ERROR                   : constant := 0; 
  14.     ERROR_UNEXPECTED_EXCEPTION : constant := 1; 
  15.  
  16.     -- An Application is a global singleton class that implements an 
  17.     -- application's initialization, runtime and shutdown behavior, and provides 
  18.     -- some meta information about it. If an application's initialization fails, 
  19.     -- it will not be run or closed. 
  20.     type Application is abstract new Limited_Object with private; 
  21.     type A_Application is access all Application'Class; 
  22.  
  23.     ---------------------------------------------------------------------------- 
  24.  
  25.     -- Forces creation of the global application without returning a reference. 
  26.     -- If the application already exists, nothing will change. 
  27.     procedure Create_Application; 
  28.  
  29.     -- Returns a reference to the global application, creating it if necessary. 
  30.     function Get_Application return A_Application; 
  31.  
  32.     -- Deletes the global application if it exists. 
  33.     procedure Delete_Application; 
  34.  
  35.     -- Forces the application to shut down, displaying the given error message. 
  36.     -- If no Application object has been created, then the system level shutdown 
  37.     -- procedure will be called. This is only to be used in the case of a fatal 
  38.     -- error. Execution will return from this procedure, so plan accordingly. 
  39.     procedure Terminate_Application( error : String ); 
  40.  
  41.     ---------------------------------------------------------------------------- 
  42.  
  43.     -- Closes the application after initialization. Do not call this if the 
  44.     -- application didn't successfully initialize. 
  45.     procedure Close( this : access Application ); 
  46.  
  47.     -- Returns the name of the company or individual that produced this application. 
  48.     function Get_Company( this : not null access Application'Class ) return String; 
  49.  
  50.     -- Returns the short name of the application. This is used to determine the 
  51.     -- names of application-specific files, etc. Special characters should be 
  52.     -- avoided. 
  53.     function Get_Name( this : not null access Application'Class ) return String; 
  54.  
  55.     -- Returns the application's Theme for UI widgets. 
  56.     function Get_Theme( this : not null access Application'Class ) return A_Theme; 
  57.     pragma Postcondition( Get_Theme'Result /= null ); 
  58.  
  59.     -- Returns the title text at the top of the application's window if it's a 
  60.     -- graphical application. 
  61.     function Get_Window_Title( this : not null access Application'Class ) return String; 
  62.  
  63.     -- Initializes the application, returning True on success. If initialization 
  64.     -- fails, Close should not be called because whatever was partially 
  65.     -- initialized before the failure ws be finalized before returning. 
  66.     function Init( this : access Application ) return Boolean is abstract; 
  67.  
  68.     -- Executes the application runtime. 'returnCode' contains the numeric code 
  69.     -- that should be returned to the OS on exit. This procedure will block 
  70.     -- until Stop is called to end application execution. 
  71.     procedure Run( this : access Application; returnCode : in out Integer ); 
  72.  
  73.     -- Stops the running application. This will cause the thread that called Run 
  74.     -- to return. The value of 'errorCode' determines the value of 'returnCode' 
  75.     -- that will be returned from Run. 
  76.     procedure Stop( this      : not null access Application'Class; 
  77.                     errorCode : Integer := NO_ERROR ); 
  78.  
  79.     -- This can be raised by initialization code in other packages to indicate 
  80.     -- that application initialization has failed. This exception is not raised 
  81.     -- by the Application class. 
  82.     INIT_EXCEPTION : exception; 
  83.  
  84.     -- This can be raised by the application class to indicate that it is being 
  85.     -- misused. For example, calling Stop before calling Init will result in a 
  86.     -- USE_ERROR exception. 
  87.     USE_ERROR : exception; 
  88.  
  89. private 
  90.  
  91.     use Ada.Strings.Unbounded; 
  92.     use Games; 
  93.     use Locking_Objects; 
  94.     use Processes.Managers; 
  95.  
  96.     ---------------------------------------------------------------------------- 
  97.  
  98.     type Application is abstract new Limited_Object with 
  99.         record 
  100.             -- the following fields are unprotected because they don't change 
  101.             company,                                 -- developer's name 
  102.             name,                                    -- app short name 
  103.             winTitle    : Unbounded_String;          -- app window title 
  104.             lock        : A_Locking_Object;          -- a lock for modifying fields 
  105.  
  106.             -- the following fields are protected by .lock 
  107.             inited      : Boolean := False;          -- application was initialized 
  108.             ran         : Boolean := False;          -- application was run 
  109.             interactive : Boolean := False;          -- application accepts user input 
  110.             graphical   : Boolean := False;          -- application has a window 
  111.             use_mouse   : Boolean := False;          -- application uses the mouse 
  112.             theme       : A_Theme := null;           -- visual theme for widgets 
  113.             game        : A_Game := null;            -- game logic implementation 
  114.             pman        : A_Process_Manager := null; -- for application-level processes 
  115.             xres, yres  : Integer := 0;              -- window resolution 
  116.             scale       : Integer := 1;              -- window scaling factor 
  117.             errorCode   : Integer := NO_ERROR;       -- return code for the OS 
  118.         end record; 
  119.  
  120.     procedure Construct( this     : access Application; 
  121.                          company  : String; 
  122.                          name     : String; 
  123.                          winTitle : String ); 
  124.  
  125.     procedure Delete( this : in out Application ); 
  126.  
  127.     -- Initializes the application by setting up graphics and hardware. 
  128.     -- The values passed to this function can be overridden by the application's 
  129.     -- configuration file. Returns True on success. 
  130.     function Init( this         : access Application; 
  131.                    app_xres, 
  132.                    app_yres     : Natural; 
  133.                    app_scale    : Positive; 
  134.                    app_windowed : Boolean ) return Boolean; 
  135.  
  136.     -- Deletes an Application object. 
  137.     procedure Delete( this : in out A_Application ); 
  138.     pragma Postcondition( this = null ); 
  139.  
  140.     ---------------------------------------------------------------------------- 
  141.  
  142.     -- An Allocator creates a concrete Application instance. 
  143.     type Allocator is access function return A_Application; 
  144.  
  145.     -- Registers an allocator for creating the global Application instance. 
  146.     procedure Register_Allocator( allocate : not null Allocator ); 
  147.  
  148. end Applications;