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