with Associations; use Associations;
with Directions; use Directions;
with Events;
with Entities; use Entities;
with Hashed_Strings; use Hashed_Strings;
with Values; use Values;
pragma Elaborate_All( Events );
package Events.Entities is
type Entity_Event is abstract new Event with private;
function Get_Id( this : not null access Entity_Event'Class ) return Entity_Id;
type Entities_Event is abstract new Event with private;
function Get_A( this : not null access Entities_Event'Class ) return Entity_Id;
function Get_B( this : not null access Entities_Event'Class ) return Entity_Id;
type Accelerate_Event is new Entity_Event with private;
type A_Accelerate_Event is access all Accelerate_Event'Class;
ACCELERATE_ID : constant Event_Id := To_Event_Id( "Accelerate" );
function Get_Acceleration( this : not null access Accelerate_Event'Class ) return Float;
pragma Postcondition( Get_Acceleration'Result >= 0.0 );
function Get_Direction( this : not null access Accelerate_Event'Class ) return Cardinal_Direction;
function Get_Velocity( this : not null access Accelerate_Event'Class ) return Float;
pragma Postcondition( Get_Velocity'Result >= 0.0 );
type Delete_Entity_Event is new Entity_Event with private;
type A_Delete_Entity_Event is access all Delete_Entity_Event'Class;
DELETE_ENTITY_ID : constant Event_Id := To_Event_Id( "Delete_Entity" );
type Entities_Collided_Event is new Entities_Event with private;
type A_Entities_Collided_Event is access all Entities_Collided_Event'Class;
ENTITIES_COLLIDED_ID: constant Event_Id := To_Event_Id( "Entities_Collided" );
type Entities_Separated_Event is new Entities_Event with private;
type A_Entities_Separated_Event is access all Entities_Separated_Event'Class;
ENTITIES_SEPARATED_ID: constant Event_Id := To_Event_Id( "Entities_Separated" );
type Entity_Attribute_Event is new Entity_Event with private;
procedure Copy_Value( this : access Entity_Attribute_Event;
val : in out A_Value );
pragma Precondition( val = null );
function Get_Attribute( this : access Entity_Attribute_Event ) return String;
pragma Postcondition( Get_Attribute'Result'Length > 0 );
type Entity_Attribute_Changed_Event is new Entity_Attribute_Event with private;
type A_Entity_Attribute_Changed_Event is access all Entity_Attribute_Changed_Event;
ENTITY_ATTRIBUTE_CHANGED_ID : constant Event_Id := To_Event_Id( "Entity_Attribute_Changed" );
type Entity_Created_Event is new Entity_Event with private;
type A_Entity_Created_Event is access all Entity_Created_Event'Class;
ENTITY_CREATED_ID : constant Event_Id := To_Event_Id( "Entity_Created" );
procedure Copy_Attributes( this : not null access Entity_Created_Event'Class;
attributes : in out A_Association );
pragma Precondition( attributes = null );
pragma Postcondition( attributes /= null );
function Get_Class( this : not null access Entity_Created_Event'Class ) return String;
pragma Postcondition( Get_Class'Result'Length > 0 );
function Get_Frame( this : not null access Entity_Created_Event'Class ) return Natural;
function Get_Height( this : not null access Entity_Created_Event'Class ) return Natural;
function Get_Lib_Name( this : not null access Entity_Created_Event'Class ) return String;
function Get_Width( this : not null access Entity_Created_Event'Class ) return Natural;
function Get_X( this : not null access Entity_Created_Event'Class ) return Float;
function Get_XV( this : not null access Entity_Created_Event'Class ) return Float;
function Get_Y( this : not null access Entity_Created_Event'Class ) return Float;
function Get_YV( this : not null access Entity_Created_Event'Class ) return Float;
function Is_Clipped( this : not null access Entity_Created_Event'Class ) return Boolean;
function Is_Metaphysical( this : not null access Entity_Created_Event'Class ) return Boolean;
function Is_Physical( this : not null access Entity_Created_Event'Class ) return Boolean;
type Entity_Deleted_Event is new Entity_Event with private;
type A_Entity_Deleted_Event is access all Entity_Deleted_Event'Class;
ENTITY_DELETED_ID : constant Event_Id := To_Event_Id( "Entity_Deleted" );
type Entity_Face_Event is new Entity_Event with private;
type A_Entity_Face_Event is access all Entity_Face_Event'Class;
ENTITY_FACE_ID : constant Event_Id := To_Event_Id( "Entity_Face" );
function Get_Direction( this : not null access Entity_Face_Event'Class ) return Direction_Type;
type Entity_Grounded_Event is new Entity_Event with private;
type A_Entity_Grounded_Event is access all Entity_Grounded_Event'Class;
ENTITY_GROUNDED_ID : constant Event_Id := To_Event_Id( "Entity_Grounded" );
function Is_Grounded( this : not null access Entity_Grounded_Event'Class ) return Boolean;
type Entity_Hit_Wall_Event is new Entity_Event with private;
type A_Entity_Hit_Wall_Event is access all Entity_Hit_Wall_Event'Class;
ENTITY_HIT_WALL_ID : constant Event_Id := To_Event_Id( "Entity_Hit_Wall" );
function Get_Direction( this : not null access Entity_Hit_Wall_Event'Class ) return Cardinal_Direction;
type Entity_Moved_Event is new Entity_Event with private;
type A_Entity_Moved_Event is access all Entity_Moved_Event'Class;
ENTITY_MOVED_ID : constant Event_Id := To_Event_Id( "Entity_Moved" );
function Get_X( this : not null access Entity_Moved_Event'Class ) return Float;
function Get_XV( this : not null access Entity_Moved_Event'Class ) return Float;
function Get_Y( this : not null access Entity_Moved_Event'Class ) return Float;
function Get_YV( this : not null access Entity_Moved_Event'Class ) return Float;
type Entity_Resized_Event is new Entity_Event with private;
type A_Entity_Resized_Event is access all Entity_Resized_Event'Class;
ENTITY_RESIZED_ID : constant Event_Id := To_Event_Id( "Entity_Resized" );
function Get_Height( this : not null access Entity_Resized_Event'Class ) return Natural;
function Get_Width( this : not null access Entity_Resized_Event'Class ) return Natural;
type Follow_Entity_Event is new Entity_Event with private;
type A_Follow_Entity_Event is access all Follow_Entity_Event'Class;
FOLLOW_ENTITY_ID : constant Event_Id := To_Event_Id( "Follow_Entity" );
type Frame_Changed_Event is new Entity_Event with private;
type A_Frame_Changed_Event is access all Frame_Changed_Event'Class;
FRAME_CHANGED_ID : constant Event_Id := To_Event_Id( "Frame_Changed" );
function Get_Frame( this : not null access Frame_Changed_Event'Class ) return Natural;
type Impulse_Event is new Entity_Event with private;
type A_Impulse_Event is access all Impulse_Event'Class;
IMPULSE_ID : constant Event_Id := To_Event_Id( "Impulse" );
function Get_Impulse_Name( this : not null access Impulse_Event'Class ) return Hashed_String;
type Move_Entity_Event is new Entity_Event with private;
type A_Move_Entity_Event is access all Move_Entity_Event'Class;
MOVE_ENTITY_ID : constant Event_Id := To_Event_Id( "Move_Entity" );
function Get_X( this : not null access Move_Entity_Event'Class ) return Float;
function Get_Y( this : not null access Move_Entity_Event'Class ) return Float;
type Resize_Entity_Event is new Entity_Event with private;
type A_Resize_Entity_Event is access all Resize_Entity_Event'Class;
RESIZE_ENTITY_ID : constant Event_Id := To_Event_Id( "Resize_Entity" );
function Get_Height( this : not null access Resize_Entity_Event'Class ) return Natural;
function Get_Width( this : not null access Resize_Entity_Event'Class ) return Natural;
type Set_Entity_Attribute_Event is new Entity_Attribute_Event with private;
type A_Set_Entity_Attribute_Event is access all Set_Entity_Attribute_Event;
SET_ENTITY_ATTRIBUTE_ID : constant Event_Id := To_Event_Id( "Set_Entity_Attribute" );
type Spawn_Entity_Event is new Event with private;
type A_Spawn_Entity_Event is access all Spawn_Entity_Event;
SPAWN_ENTITY_ID : constant Event_Id := To_Event_Id( "Spawn_Entity" );
function Get_Height( this : access Spawn_Entity_Event ) return Integer;
function Get_Id( this : access Spawn_Entity_Event ) return String;
function Get_Width( this : access Spawn_Entity_Event ) return Integer;
function Get_X( this : access Spawn_Entity_Event ) return Float;
function Get_XV( this : access Spawn_Entity_Event ) return Float;
function Get_Y( this : access Spawn_Entity_Event ) return Float;
function Get_YV( this : access Spawn_Entity_Event ) return Float;
procedure Queue_Accelerate( id : Entity_Id;
dir : Cardinal_Direction;
vel : Float;
acc : Float );
pragma Precondition( vel >= 0.0 );
pragma Precondition( acc >= 0.0 );
procedure Queue_Delete_Entity( id : Entity_Id );
procedure Queue_Entities_Collided( a, b : Entity_Id );
procedure Queue_Entities_Separated( a, b : Entity_Id );
procedure Queue_Entity_Attribute_Changed( id : Entity_Id;
attribute : String;
val : in out A_Value );
pragma Precondition( attribute'Length > 0 );
pragma Postcondition( val = null );
procedure Queue_Entity_Created( id : Entity_Id;
class : String;
physical,
metaphysical,
clipped : Boolean;
width,
height : Natural;
x, y : Float;
xv, yv : Float;
libName : String;
frame : Natural;
attributes : not null A_Association );
pragma Precondition( class'Length > 0 );
procedure Queue_Entity_Deleted( id : Entity_Id );
procedure Queue_Entity_Face( id : Entity_Id; dir : Direction_Type );
procedure Queue_Entity_Grounded( id : Entity_Id; grounded : Boolean );
procedure Queue_Entity_Hit_Wall( id : Entity_Id; dir : Cardinal_Direction );
procedure Queue_Entity_Moved( id : Entity_Id; x, y, xv, yv : Float );
procedure Queue_Entity_Resized( id : Entity_Id; width, height : Natural );
procedure Queue_Impulse( id : Entity_Id; name : Hashed_String );
procedure Queue_Follow_Entity( id : Entity_Id );
procedure Queue_Frame_Changed( id : Entity_Id; frame : Natural );
procedure Queue_Move_Entity( id : Entity_Id; x, y : Float );
procedure Queue_Resize_Entity( id : Entity_Id; width, height : Natural );
procedure Queue_Set_Entity_Attribute( id : Entity_Id;
attribute : String;
val : in out A_Value );
pragma Precondition( attribute'Length > 0 );
pragma Postcondition( val = null );
procedure Queue_Spawn_Entity( id : String;
x, y : Float;
width,
height : Natural := 0;
xv, yv : Float := 0.0 );
pragma Precondition( id'Length > 0 );
private
type Entity_Event is abstract new Event with
record
id : Entity_Id := INVALID_ID;
end record;
procedure Construct( this : access Entity_Event; name : String; id : Entity_Id );
pragma Precondition( name'Length > 0 );
type Entities_Event is abstract new Event with
record
a, b : Entity_Id := INVALID_ID;
end record;
procedure Construct( this : access Entities_Event; name : String; a, b : Entity_Id );
pragma Precondition( name'Length > 0 );
type Accelerate_Event is new Entity_Event with
record
dir : Cardinal_Direction := Left;
vel : Float := 0.0;
acc : Float := 0.0;
end record;
procedure Construct( this : access Accelerate_Event;
id : Entity_Id;
dir : Cardinal_Direction;
vel : Float;
acc : Float );
type Delete_Entity_Event is new Entity_Event with null record;
procedure Construct( this : access Delete_Entity_Event; id : Entity_Id );
type Entities_Collided_Event is new Entities_Event with null record;
procedure Construct( this : access Entities_Collided_Event; a, b : Entity_Id );
type Entities_Separated_Event is new Entities_Event with null record;
procedure Construct( this : access Entities_Separated_Event; a, b : Entity_Id );
type Entity_Attribute_Event is new Entity_Event with
record
attribute : Unbounded_String;
val : A_Value := null;
end record;
procedure Adjust( this : access Entity_Attribute_Event );
procedure Construct( this : access Entity_Attribute_Event;
name : String;
id : Entity_Id;
attribute : String;
val : in out A_Value );
pragma Precondition( name'Length > 0 );
pragma Precondition( attribute'Length > 0 );
pragma Postcondition( val = null );
procedure Delete( this : in out Entity_Attribute_Event );
type Entity_Attribute_Changed_Event is new Entity_Attribute_Event with null record;
procedure Construct( this : access Entity_Attribute_Changed_Event;
id : Entity_Id;
attribute : String;
val : in out A_Value );
pragma Precondition( attribute'Length > 0 );
pragma Postcondition( val = null );
type Entity_Created_Event is new Entity_Event with
record
class : Unbounded_String;
physical : Boolean := True;
metaphysical : Boolean := False;
clipped : Boolean := True;
width,
height : Natural := 0;
x, y : Float := 0.0;
xv, yv : Float := 0.0;
libName : Unbounded_String;
frame : Natural := 0;
attributes : A_Association := null;
end record;
procedure Adjust( this : access Entity_Created_Event );
procedure Construct( this : access Entity_Created_Event;
id : Entity_Id;
class : String;
physical,
metaphysical,
clipped : Boolean;
width,
height : Natural;
x, y : Float;
xv, yv : Float;
libName : String;
frame : Natural;
attributes : not null A_Association );
procedure Delete( this : in out Entity_Created_Event );
type Entity_Deleted_Event is new Entity_Event with null record;
procedure Construct( this : access Entity_Deleted_Event; id : Entity_Id );
type Entity_Face_Event is new Entity_Event with
record
dir : Direction_Type := Dir_Left;
end record;
procedure Construct( this : access Entity_Face_Event;
id : Entity_Id;
dir : Direction_Type );
type Entity_Grounded_Event is new Entity_Event with
record
grounded : Boolean := False;
end record;
procedure Construct( this : access Entity_Grounded_Event;
id : Entity_Id;
grounded : Boolean );
type Entity_Hit_Wall_Event is new Entity_Event with
record
dir : Cardinal_Direction;
end record;
procedure Construct( this : access Entity_Hit_Wall_Event;
id : Entity_Id;
dir : Cardinal_Direction );
type Entity_Moved_Event is new Entity_Event with
record
x, y : Float := 0.0;
xv, yv : Float := 0.0;
end record;
procedure Construct( this : access Entity_Moved_Event;
id : Entity_Id;
x, y : Float;
xv, yv : Float );
type Entity_Resized_Event is new Entity_Event with
record
width, height : Natural := 0;
end record;
procedure Construct( this : access Entity_Resized_Event;
id : Entity_Id;
width,
height : Natural );
type Follow_Entity_Event is new Entity_Event with null record;
procedure Construct( this : access Follow_Entity_Event; id : Entity_Id );
type Frame_Changed_Event is new Entity_Event with
record
frame : Natural;
end record;
procedure Construct( this : access Frame_Changed_Event;
id : Entity_Id;
frame : Natural );
type Impulse_Event is new Entity_Event with
record
name : Hashed_String;
end record;
procedure Construct( this : access Impulse_Event;
id : Entity_Id;
name : Hashed_String );
type Move_Entity_Event is new Entity_Event with
record
x, y : Float := 0.0;
end record;
procedure Construct( this : access Move_Entity_Event;
id : Entity_Id;
x, y : Float );
type Resize_Entity_Event is new Entity_Event with
record
width, height : Natural := 0;
end record;
procedure Construct( this : access Resize_Entity_Event;
id : Entity_Id;
width,
height : Natural );
type Set_Entity_Attribute_Event is new Entity_Attribute_Event with null record;
procedure Construct( this : access Set_Entity_Attribute_Event;
id : Entity_Id;
attribute : String;
val : in out A_Value );
pragma Precondition( attribute'Length > 0 );
pragma Postcondition( val = null );
type Spawn_Entity_Event is new Event with
record
id : Unbounded_String;
x, y : Float;
width,
height : Natural;
xv, yv : Float;
end record;
procedure Construct( this : access Spawn_Entity_Event;
id : String;
x, y : Float;
width,
height : Natural;
xv, yv : Float );
pragma Precondition( id'Length > 0 );
end Events.Entities;