with Ada.Real_Time; use Ada.Real_Time;
with Ada.Streams; use Ada.Streams;
with Associations; use Associations;
with Directions; use Directions;
with Interfaces; use Interfaces;
with Objects; use Objects;
with Values; use Values;
limited with Worlds;
private with Ada.Containers.Doubly_Linked_Lists;
private with Object_Factory;
private with Tiles.Libraries;
pragma Elaborate_All( Object_Factory );
package Entities is
type Entity_Id is new Unsigned_32;
INVALID_ID : constant Entity_Id;
type Entity is abstract new Object with private;
type A_Entity is access all Entity'Class;
procedure Activate( this : not null access Entity'Class;
activator : not null A_Entity );
procedure Collided( this : not null access Entity'Class; e : not null A_Entity );
procedure Face( this : access Entity; dir : Direction_Type );
function Get_Attributes( this : not null access Entity'Class ) return A_Association;
pragma Postcondition( Get_Attributes'Result /= null );
function Get_Direction( this : not null access Entity'Class ) return Direction_Type;
function Get_Frame( this : not null access Entity'Class ) return Integer;
function Get_Height( this : not null access Entity'Class ) return Integer;
function Get_Id( this : not null access Entity'Class ) return Entity_Id;
function Get_Lib_Name( this : not null access Entity'Class ) return String;
function Get_Width( this : not null access Entity'Class ) return Integer;
function Get_X( this : not null access Entity'Class ) return Float;
function Get_XV( this : not null access Entity'Class ) return Float;
function Get_Y( this : not null access Entity'Class ) return Float;
function Get_YV( this : not null access Entity'Class ) return Float;
procedure Hit_Wall( this : not null access Entity'Class; dir : Cardinal_Direction );
function Is_Clipped( this : not null access Entity'Class ) return Boolean;
function Is_Permanent( this : access Entity ) return Boolean;
function Is_Metaphysical( this : not null access Entity'Class ) return Boolean;
function Is_Physical( this : not null access Entity'Class ) return Boolean;
function Object_Input( stream : access Root_Stream_Type'Class ) return Entity is abstract;
procedure Separated( this : not null access Entity'Class; e : not null A_Entity );
procedure Set_Attribute( this : access Entity;
name : String;
val : in out A_Value );
pragma Precondition( name'Length > 0 );
pragma Postcondition( val = null );
procedure Set_Grounded( this : not null access Entity'Class; grounded : Boolean );
procedure Set_Location( this : not null access Entity'Class; x, y : Float );
procedure Set_Size( this : not null access Entity'Class;
width,
height : Natural );
procedure Set_World( this : not null access Entity'Class;
world : not null access Worlds.World_Object'Class );
procedure Set_Velocity_X( this : not null access Entity'Class; xv : Float );
procedure Set_Velocity_Y( this : not null access Entity'Class; yv : Float );
procedure Tick( this : access Entity; upTime, dt : Time_Span );
function Allocate( id : String ) return A_Entity;
pragma Precondition( id'Length > 0 );
function Copy( src : A_Entity ) return A_Entity;
pragma Postcondition( Copy'Result /= src or else src = null );
procedure Delete( this : in out A_Entity );
pragma Postcondition( this = null );
procedure Iterate_Classes( pattern : String := "";
examine : access procedure( id : String ) );
function Template( id : String ) return A_Entity;
pragma Precondition( id'Length > 0 );
procedure Initialize;
procedure Finalize;
private
use Tiles.Libraries;
INVALID_ID : constant Entity_Id := Entity_Id'First;
DUPLICATE_ID : exception;
function A_Entity_Input( stream : access Root_Stream_Type'Class ) return A_Entity;
for A_Entity'Input use A_Entity_Input;
procedure A_Entity_Output( stream : access Root_Stream_Type'Class; obj : A_Entity );
for A_Entity'Output use A_Entity_Output;
procedure A_Entity_Read( stream : access Root_Stream_Type'Class; obj : out A_Entity );
for A_Entity'Read use A_Entity_Read;
procedure A_Entity_Write( stream : access Root_Stream_Type'Class; obj : A_Entity );
for A_Entity'Write use A_Entity_Write;
package Entity_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Entity, "=" );
use Entity_Lists;
type Entity is abstract new Object with
record
id : Entity_Id := INVALID_ID;
physical : Boolean := True;
metaphysical : Boolean := False;
clipped : Boolean := True;
lib : A_Tile_Library := null;
age : Time_Span := Time_Span_Zero;
width,
height : Natural := 0;
x,
y : Float := 0.0;
xv,
yv : Float := 0.0;
dir : Direction_Type := Dir_Left;
frame : Natural := 0;
attrs : A_Association := null;
world : access Worlds.World_Object'Class := null;
grounded : Boolean := False;
touching : Entity_Lists.List;
editingMode : Boolean := False;
end record;
procedure Construct( this : access Entity;
width,
height : Natural;
libName : String );
procedure Adjust( this : access Entity );
procedure Delete( this : in out Entity );
procedure Iterate_Touching( this : not null access Entity'Class;
examine : not null access procedure( e : A_Entity ) );
procedure On_Activate( this : access Entity; activator : not null A_Entity ) is null;
procedure On_Collide( this : access Entity; e : not null A_Entity ) is null;
procedure On_Hit_Wall( this : access Entity; dir : Cardinal_Direction ) is null;
procedure On_Separate( this : access Entity; e : not null A_Entity ) is null;
procedure Set_Frame( this : not null access Entity'Class;
frame : Natural;
notify : Boolean := True );
function To_String( this : access Entity ) return String;
procedure Update_Frame( this : access Entity; notify : Boolean := True );
procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Entity );
for Entity'Read use Object_Read;
procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Entity );
for Entity'Write use Object_Write;
package Factory is new Object_Factory( Entity, A_Entity, Delete );
end Entities;