1. with Locking_Objects;                   use Locking_Objects; 
  2. with Objects;                           use Objects; 
  3. with Processes;                         use Processes; 
  4.  
  5. private with Ada.Containers.Doubly_Linked_Lists; 
  6. private with Ada.Strings.Unbounded; 
  7.  
  8. package Processes.Managers is 
  9.  
  10.     type Process_Manager is new Limited_Object with private; 
  11.     type A_Process_Manager is access all Process_Manager'Class; 
  12.  
  13.     -- Reference to a procedure that is responsible for destroying a process. 
  14.     type A_Destructor is access procedure( process : in out A_Process ); 
  15.  
  16.     -- An update rate of 0 hertz means maximum update rate, without delay 
  17.     -- between frames. 'minHertz' is not the minimum actual rate of the process 
  18.     -- manager because it is unable to interrupt or skip processes; it is the 
  19.     -- minimum time delta reported to the processes on tick. If some processes 
  20.     -- can't handle large time deltas but sometimes they do happen, 'minHertz' 
  21.     -- will prevent the processes from getting a dt that's too big. 
  22.     function Create_Process_Manager( name     : String; 
  23.                                      hertz    : Natural := 0; 
  24.                                      minHertz : Natural := 0 ) return A_Process_Manager; 
  25.     pragma Postcondition( Create_Process_Manager'Result /= null ); 
  26.  
  27.     -- Attach a process to the process manager for execution. It will be 
  28.     -- executed last in the rotation of attached processes. This can be done 
  29.     -- before or after starting the process manager. 
  30.     procedure Attach( this : not null access Process_Manager'Class; 
  31.                       proc : not null A_Process ); 
  32.  
  33.     -- Detaches a process from the process manager. This can be done at any time. 
  34.     procedure Detach( this       : not null access Process_Manager'Class; 
  35.                       proc       : not null A_Process; 
  36.                       destructor : A_Destructor := null ); 
  37.  
  38.     -- Returns the name of the process manager as given at creation. 
  39.     function Get_Name( this : not null access Process_Manager'Class ) return String; 
  40.  
  41.     -- Returns the rate in Hz that the process manager is ticking its processes. 
  42.     function Get_Rate( this : not null access Process_Manager'Class ) return Natural; 
  43.  
  44.     -- Pauses/resumes the given process if it's attached to this manager. If 
  45.     -- paused, Tick will not be called until after the process has been resumed. 
  46.     procedure Pause( this   : not null access Process_Manager'Class; 
  47.                      proc   : not null A_Process; 
  48.                      paused : Boolean ); 
  49.  
  50.     -- Starts execution of the processes. 
  51.     procedure Start( this : not null access Process_Manager'Class ); 
  52.  
  53.     -- Stops execution of the processes. 
  54.     procedure Stop( this : not null access Process_Manager'Class ); 
  55.  
  56.     -- Instructs the process manager to track the rate at which it is executing 
  57.     -- its processes. This is useful for determining frame rates or finding 
  58.     -- which process manager threads are running too slowly. 
  59.     procedure Track_Rate( this    : not null access Process_Manager'Class; 
  60.                           enabled : Boolean ); 
  61.  
  62.     -- Deletes a process manager. Its attached processes, if it has any at the 
  63.     -- time of deletion, are detached and left unchanged. 
  64.     procedure Delete( this : in out A_Process_Manager ); 
  65.     pragma Postcondition( this = null ); 
  66.  
  67. private 
  68.  
  69.     use Ada.Strings.Unbounded; 
  70.  
  71.     type Execution is 
  72.         record 
  73.             process   : A_Process := null; 
  74.             firstTick : Time := Time_First; 
  75.             lastTick  : Time := Time_First; 
  76.             paused    : Boolean := False; 
  77.             pauseTime : Time := Time_First; 
  78.         end record; 
  79.     type A_Execution is access all Execution; 
  80.  
  81.     procedure Delete( exec : in out A_Execution ); 
  82.  
  83.     function Eq( l, r : A_Execution ) return Boolean; 
  84.  
  85.     package Execution_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Execution, Eq ); 
  86.     use Execution_Lists; 
  87.  
  88.     ---------------------------------------------------------------------------- 
  89.  
  90.     type Operation is abstract tagged 
  91.         record 
  92.             process : A_Process := null; 
  93.         end record; 
  94.     type A_Operation is access all Operation'Class; 
  95.  
  96.     procedure Execute( this  : access Operation; 
  97.                        plist : in out Execution_Lists.List ) is abstract; 
  98.  
  99.     procedure Delete( this : in out A_Operation ); 
  100.  
  101.     type Attach_Operation is new Operation with null record; 
  102.  
  103.     procedure Execute( this     : access Attach_Operation; 
  104.                        execList : in out Execution_Lists.List ); 
  105.  
  106.     type Detach_Operation is new Operation with 
  107.         record 
  108.             destroy : A_Destructor := null; 
  109.         end record; 
  110.  
  111.     procedure Execute( this     : access Detach_Operation; 
  112.                        execList : in out Execution_Lists.List ); 
  113.  
  114.     type Pause_Operation is new Operation with null record; 
  115.  
  116.     procedure Execute( this     : access Pause_Operation; 
  117.                        execList : in out Execution_Lists.List ); 
  118.  
  119.     type Resume_Operation is new Operation with null record; 
  120.  
  121.     procedure Execute( this     : access Resume_Operation; 
  122.                        execList : in out Execution_Lists.List ); 
  123.  
  124.     function Create_Attach_Operation( process : not null A_Process ) return A_Operation; 
  125.  
  126.     function Create_Detach_Operation( process    : not null A_Process; 
  127.                                       destructor : A_Destructor ) return A_Operation; 
  128.  
  129.     function Create_Pause_Operation( process : not null A_Process ) return A_Operation; 
  130.  
  131.     function Create_Resume_Operation( process : not null A_Process ) return A_Operation; 
  132.  
  133.     package Operation_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Operation, "=" ); 
  134.  
  135.     ---------------------------------------------------------------------------- 
  136.  
  137.     task type Ticker_Task is 
  138.         entry Init( pman : A_Process_Manager; hertz, minHertz : Natural ); 
  139.         entry Start; 
  140.         entry Stop; 
  141.     end Ticker_Task; 
  142.     type A_Ticker_Task is access all Ticker_Task; 
  143.  
  144.     procedure Delete( ticker : in out A_Ticker_Task ); 
  145.  
  146.     ---------------------------------------------------------------------------- 
  147.  
  148.     type Process_Manager is new Limited_Object with 
  149.         record 
  150.             lock       : A_Locking_Object;       -- protects all other fields 
  151.             name       : Unbounded_String; 
  152.             operations : Operation_Lists.List; 
  153.             trackRate  : Boolean := False; 
  154.             rate       : Natural := 0; 
  155.             ticker     : A_Ticker_Task := null; 
  156.             started    : Boolean := False; 
  157.             stopped    : Boolean := False; 
  158.         end record; 
  159.  
  160.     procedure Construct( this     : access Process_Manager; 
  161.                          name     : String; 
  162.                          hertz    : Natural; 
  163.                          minHertz : Natural ); 
  164.  
  165.     procedure Delete( this : in out Process_Manager ); 
  166.  
  167. end Processes.Managers;