1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. generic 
  10.     type Object_Class (<>) is abstract tagged limited private; 
  11.     type Object_Access is access Object_Class'Class; 
  12.  
  13.     with procedure Delete( e : in out Object_Access ); 
  14.  
  15. -- This generic package is used to register an association of object class 
  16. -- names and allocators. This allows us to instantiate an object simply by class 
  17. -- name, without ever referencing its implementation in the code. 
  18. package Object_Factory is 
  19.  
  20.     type Allocator is access function return Object_Access; 
  21.  
  22.     -- Initializes the factory by name. The name should be the root type of 
  23.     -- objects that it manufactures. (ex: "entity", "actor", etc). Classes 
  24.     -- should be registered before the factory is initialized, preferably at 
  25.     -- elaboration time. Template instances of each registered class are created 
  26.     -- at initialization. An exception will be raised on error, from the first 
  27.     -- failure to instantiate a template instance. 
  28.     procedure Initialize( factoryName : String ); 
  29.     pragma Precondition( factoryName'Length > 0 ); 
  30.  
  31.     -- Finalizes the factory, deleting template instances. 
  32.     procedure Finalize; 
  33.  
  34.     -- Returns null if no allocator is registered for the given class id. If 
  35.     -- the allocator registered for 'id' raises an exception, it will be passed 
  36.     -- on to the caller. 
  37.     function Allocate( id : String ) return Object_Access; 
  38.     pragma Precondition( id'Length > 0 ); 
  39.  
  40.     -- Iterate over all registered class id strings that match globbing regular 
  41.     -- expression 'pattern'. Use an empty string for 'pattern' to iterate 
  42.     -- through all registered class ids. 
  43.     procedure Iterate_Classes( pattern : String; 
  44.                                examine   : access procedure( id : String ) ); 
  45.  
  46.     -- Registers a class allocation function with a class id. 'id' is not case 
  47.     -- sensitive. 
  48.     procedure Register_Class( id : String; allocate : not null Allocator ); 
  49.     pragma Precondition( id'Length > 0 ); 
  50.  
  51.     -- Returns a reference to a template instantiation of the class registered 
  52.     -- with 'id'. Template entities are instantiated when the factory package is 
  53.     -- initialized. If no class is registered for the id, null will be returned. 
  54.     -- Do not modify the object that is returned! 
  55.     function Template( id : String ) return Object_Access; 
  56.     pragma Precondition( id'Length > 0 ); 
  57.  
  58. end Object_Factory;