1. with Ada.Real_Time;                     use Ada.Real_Time; 
  2. with Ada.Streams;                       use Ada.Streams; 
  3. with Associations;                      use Associations; 
  4. with Directions;                        use Directions; 
  5. with Hashed_Strings;                    use Hashed_Strings; 
  6. with Interfaces;                        use Interfaces; 
  7. with Objects;                           use Objects; 
  8. with Values;                            use Values; 
  9.  
  10. limited with Worlds; 
  11.  
  12. private with Ada.Containers.Doubly_Linked_Lists; 
  13. private with Entity_Factory; 
  14. private with Tiles.Libraries; 
  15.  
  16. pragma Elaborate_All( Entity_Factory ); 
  17.  
  18. package Entities is 
  19.  
  20.     type Entity_Id is new Unsigned_32; 
  21.  
  22.     INVALID_ID : constant Entity_Id; 
  23.  
  24.     ---------------------------------------------------------------------------- 
  25.  
  26.     type Entity is abstract new Object with private; 
  27.     type A_Entity is access all Entity'Class; 
  28.  
  29.     -- Notifies the entity that it has collided with 'e', updating the entity's 
  30.     -- touch list and calling On_Collide to invoke collision behavior. To add 
  31.     -- entity behavior on a collision event, override On_Collide. 
  32.     procedure Collided( this : not null access Entity'Class; e : not null A_Entity ); 
  33.  
  34.     -- This procedure is called to change the direction the entity is facing. 
  35.     -- The default implementation is a null procedure so it must be overridden 
  36.     -- to provide some specific behavior. 
  37.     procedure Face( this : access Entity; dir : Direction_Type ); 
  38.  
  39.     -- Returns a reference to the entity's internal attributes association. The 
  40.     -- reference belongs to the entity, do not delete it! 
  41.     function Get_Attributes( this : not null access Entity'Class ) return A_Association; 
  42.     pragma Postcondition( Get_Attributes'Result /= null ); 
  43.  
  44.     function Get_Direction( this : not null access Entity'Class ) return Direction_Type; 
  45.  
  46.     function Get_Frame( this : not null access Entity'Class ) return Integer; 
  47.  
  48.     function Get_Height( this : not null access Entity'Class ) return Integer; 
  49.  
  50.     function Get_Id( this : not null access Entity'Class ) return Entity_Id; 
  51.  
  52.     function Get_Lib_Name( this : not null access Entity'Class ) return String; 
  53.  
  54.     function Get_Width( this : not null access Entity'Class ) return Integer; 
  55.  
  56.     function Get_X( this : not null access Entity'Class ) return Float; 
  57.  
  58.     function Get_XV( this : not null access Entity'Class ) return Float; 
  59.  
  60.     function Get_Y( this : not null access Entity'Class ) return Float; 
  61.  
  62.     function Get_YV( this : not null access Entity'Class ) return Float; 
  63.  
  64.     -- Notifies the entity that it hit a wall. To implement behavior to handle 
  65.     -- this event, override On_Hit_Wall. 
  66.     procedure Hit_Wall( this : not null access Entity'Class; dir : Cardinal_Direction ); 
  67.  
  68.     -- Handles an impulse (command) given to the entity to cause it to act in 
  69.     -- some way. The default behavior is a null procedure. 
  70.     procedure Impulse( this : access Entity; name : Hashed_String ); 
  71.  
  72.     -- Returns True if the entity is clipped to the walls in the world. 
  73.     function Is_Clipped( this : not null access Entity'Class ) return Boolean; 
  74.  
  75.     -- Returns True if this entity is a permanent part of the world and isn't 
  76.     -- allowed to be deleted. The player, for example, is permanent. 
  77.     function Is_Permanent( this : access Entity ) return Boolean; 
  78.  
  79.     -- Returns True if the entity is invisible, existing metaphysically. 
  80.     function Is_Metaphysical( this : not null access Entity'Class ) return Boolean; 
  81.  
  82.     -- Returns True if the entity is subject to the laws of physics. 
  83.     function Is_Physical( this : not null access Entity'Class ) return Boolean; 
  84.  
  85.     function Object_Input( stream : access Root_Stream_Type'Class ) return Entity is abstract; 
  86.  
  87.     -- Notifies the entity that it as separated with 'e', updating the entity's 
  88.     -- touch list and calling On_Separate to invoke separation behavior. To add 
  89.     -- entity behavior on a separation event, override On_Separate. 
  90.     procedure Separated( this : not null access Entity'Class; e : not null A_Entity ); 
  91.  
  92.     -- Sets an attribute of this entity. An Entity_Attribute_Changed event will 
  93.     -- be queued. 
  94.     procedure Set_Attribute( this : access Entity; 
  95.                              name : String; 
  96.                              val  : in out A_Value ); 
  97.     pragma Precondition( name'Length > 0 ); 
  98.     pragma Postcondition( val = null ); 
  99.  
  100.     -- Sets the grounded state of the entity. The entity's frame will be updated. 
  101.     procedure Set_Grounded( this : not null access Entity'Class; grounded : Boolean ); 
  102.  
  103.     -- Sets the entity's location without sending an event. 
  104.     procedure Set_Location( this : not null access Entity'Class; x, y : Float ); 
  105.  
  106.     -- Sets the entity's size without sending an event. 
  107.     procedure Set_Size( this   : not null access Entity'Class; 
  108.                         width, 
  109.                         height : Natural ); 
  110.  
  111.     -- Sets the entity's reference to the world in which it exists. This can 
  112.     -- never be set as null (although it will be null if Set_World is never 
  113.     -- called.) An exception will be raised if the entity already has a world 
  114.     -- reference. 
  115.     procedure Set_World( this  : not null access Entity'Class; 
  116.                          world : not null access Worlds.World_Object'Class ); 
  117.  
  118.     -- Sets the entity's X velocity without sending an event. The entity's frame 
  119.     -- will be updated. 
  120.     procedure Set_Velocity_X( this : not null access Entity'Class; xv : Float ); 
  121.  
  122.     -- Sets the entity's Y velocity without sending an event. The entity's frame 
  123.     -- will be updated. 
  124.     procedure Set_Velocity_Y( this : not null access Entity'Class; yv : Float ); 
  125.  
  126.     procedure Tick( this : access Entity; upTime, dt : Time_Span ); 
  127.  
  128.     ---------------------------------------------------------------------------- 
  129.  
  130.     function Allocate( id : String ) return A_Entity; 
  131.     pragma Precondition( id'Length > 0 ); 
  132.  
  133.     function Copy( src : A_Entity ) return A_Entity; 
  134.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  135.  
  136.     procedure Delete( this : in out A_Entity ); 
  137.     pragma Postcondition( this = null ); 
  138.  
  139.     procedure Iterate_Classes( pattern : String := ""; 
  140.                                examine : access procedure( id : String ) ); 
  141.  
  142.     function Template( id : String ) return A_Entity; 
  143.     pragma Precondition( id'Length > 0 ); 
  144.  
  145.     procedure Initialize; 
  146.  
  147.     procedure Finalize; 
  148.  
  149. private 
  150.  
  151.     use Tiles.Libraries; 
  152.  
  153.     INVALID_ID   : constant Entity_Id := Entity_Id'First; 
  154.     DUPLICATE_ID : exception; 
  155.  
  156.     function A_Entity_Input( stream : access Root_Stream_Type'Class ) return A_Entity; 
  157.     for A_Entity'Input use A_Entity_Input; 
  158.  
  159.     procedure A_Entity_Output( stream : access Root_Stream_Type'Class; obj : A_Entity ); 
  160.     for A_Entity'Output use A_Entity_Output; 
  161.  
  162.     procedure A_Entity_Read( stream : access Root_Stream_Type'Class; obj : out A_Entity ); 
  163.     for A_Entity'Read use A_Entity_Read; 
  164.  
  165.     procedure A_Entity_Write( stream : access Root_Stream_Type'Class; obj : A_Entity ); 
  166.     for A_Entity'Write use A_Entity_Write; 
  167.  
  168.     package Entity_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Entity, "=" ); 
  169.     use Entity_Lists; 
  170.  
  171.     type Entity is abstract new Object with 
  172.         record 
  173.             -- ** this field is assigned on creation ** 
  174.             id : Entity_Id := INVALID_ID; 
  175.  
  176.             -- ** these fields are identical for instances of the same class ** 
  177.             physical     : Boolean := True; 
  178.             metaphysical : Boolean := False; 
  179.             clipped      : Boolean := True; 
  180.             lib          : A_Tile_Library := null; 
  181.  
  182.             -- ** these fields are unique to the instance ** 
  183.  
  184.             -- age of the entity, incremented each Tick 
  185.             age : Time_Span := Time_Span_Zero; 
  186.  
  187.             -- size of the entity in world units (for collision detection) 
  188.             width, 
  189.             height : Natural := 0; 
  190.  
  191.             -- entity's location in world coordinates 
  192.             x, 
  193.             y : Float := 0.0; 
  194.  
  195.             -- entity's velocity in world units per second 
  196.             xv, 
  197.             yv : Float := 0.0; 
  198.  
  199.             -- the direction the entity is facing or acting 
  200.             dir : Direction_Type := Dir_Left; 
  201.  
  202.             frame : Natural := 0; 
  203.             attrs : A_Association := null;     -- entity attributes 
  204.  
  205.             -- begin fields not streamed 
  206.             world       : access Worlds.World_Object'Class := null; 
  207.             grounded    : Boolean := False; 
  208.             touching    : Entity_Lists.List; 
  209.             editingMode : Boolean := False;   -- set to True on construction if the 
  210.                                               -- entity is in an editing environment 
  211.             -- end fields not streamed 
  212.  
  213.         end record; 
  214.  
  215.     procedure Construct( this    : access Entity; 
  216.                          width, 
  217.                          height  : Natural; 
  218.                          libName : String ); 
  219.  
  220.     -- Raises COPY_NOT_ALLOWED. 
  221.     procedure Adjust( this : access Entity ); 
  222.  
  223.     procedure Delete( this : in out Entity ); 
  224.  
  225.     -- Iterates over all entities that this entity is currently touching, calling 
  226.     -- the examine procedure for each. Null will never be passed to 'examine'. 
  227.     procedure Iterate_Touching( this    : not null access Entity'Class; 
  228.                                 examine : not null access procedure( e : A_Entity ) ); 
  229.  
  230.     -- Override this procedure to implement behavior for when this entity is 
  231.     -- activated by another entity, 'activator'. 
  232.     procedure On_Activate( this : access Entity; activator : not null A_Entity ); 
  233.  
  234.     -- Override this procedure to implement behavior for when this entity 
  235.     -- collides with another entity, 'e'. 
  236.     procedure On_Collide( this : access Entity; e : not null A_Entity ); 
  237.  
  238.     -- Override this procedure to implement behavior for when this entity runs 
  239.     -- into a wall. 
  240.     procedure On_Hit_Wall( this : access Entity; dir : Cardinal_Direction ); 
  241.  
  242.     -- Override this procedure to implement behavior for when this entity 
  243.     -- separates from another entity, 'e'. 
  244.     procedure On_Separate( this : access Entity; e : not null A_Entity ); 
  245.  
  246.     -- Sets the entity's current frame. If 'notify' is True, a Frame_Changed 
  247.     -- event will be queued if the new frame is different. 
  248.     procedure Set_Frame( this   : not null access Entity'Class; 
  249.                          frame  : Natural; 
  250.                          notify : Boolean := True ); 
  251.  
  252.     function To_String( this : access Entity ) return String; 
  253.  
  254.     -- Determines the entity's current frame using its current state. If 
  255.     -- 'notify' is True, a Frame_Changed event will be queued if the frame 
  256.     -- changes. 
  257.     procedure Update_Frame( this : access Entity; notify : Boolean := True ); 
  258.  
  259.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Entity ); 
  260.     for Entity'Read use Object_Read; 
  261.  
  262.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Entity ); 
  263.     for Entity'Write use Object_Write; 
  264.  
  265.     ---------------------------------------------------------------------------- 
  266.  
  267.     package Factory is new Entity_Factory( Entity, A_Entity, Delete ); 
  268.  
  269. end Entities;