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