with Ada.Streams; use Ada.Streams;
with Entities; use Entities;
with Entities.Players; use Entities.Players;
with Events; use Events;
with Events.Corrals; use Events.Corrals;
with Events.Entities; use Events.Entities;
with Events.Listeners; use Events.Listeners;
with Objects; use Objects;
with Processes; use Processes;
with Processes.Managers; use Processes.Managers;
with Tiles.Libraries; use Tiles.Libraries;
private with Ada.Containers;
private with Ada.Containers.Hashed_Sets;
private with Ada.Containers.Ordered_Maps;
private with Ada.Real_Time;
private with Ada.Strings.Unbounded;
private with Maps;
private with Tiles;
package Worlds is
type World_Object is abstract new Object and Event_Listener and Process with private;
type A_World is access all World_Object'Class;
function Create_World( width,
height : Positive;
libName,
domain : String ) return A_World;
pragma Precondition( libName'Length > 0 );
pragma Precondition( domain'Length > 0 );
pragma Postcondition( Create_World'Result /= null );
function Load_World( name : String ) return A_World;
pragma Postcondition( Load_World'Result /= null );
procedure Attach_To_Framework( this : not null access World_Object'Class;
corral : not null A_Corral;
pman : not null A_Process_Manager );
procedure Detach_From_Framework( this : not null access World_Object'Class );
procedure Examine_Entities( this : not null access World_Object'Class;
examine : not null access procedure( e : not null A_Entity ) );
function Get_Entity( this : access World_Object; id : Entity_Id ) return A_Entity;
function Get_Filename( this : access World_Object ) return String;
function Get_Height( this : not null access World_Object'Class ) return Positive;
function Get_Height_Tiles( this : not null access World_Object'Class ) return Positive;
function Get_Library( this : not null access World_Object'Class ) return A_Tile_Library;
function Get_Music( this : not null access World_Object'Class ) return String;
function Get_Player( this : not null access World_Object'Class ) return A_Player;
function Get_Tile_Id( this : not null access World_Object'Class;
layer,
x, y : Integer ) return Natural;
function Get_Title( this : not null access World_Object'Class ) return String;
function Get_Width( this : not null access World_Object'Class) return Positive;
function Get_Width_Tiles( this : not null access World_Object'Class ) return Positive;
procedure Resize( this : not null access World_Object'Class;
width,
height : Positive );
procedure Save( this : not null access World_Object'Class;
name : String;
overwrite : Boolean := True );
pragma Precondition( name'Length > 0 );
procedure Set_Property( this : access World_Object; name, value : String );
pragma Precondition( name'Length > 0 );
procedure Set_Tile( this : access World_Object;
layer : Integer;
x, y : Integer;
id : Natural;
notify : Boolean := True );
procedure Spawn_Entity( this : access World_Object;
id : String;
x, y : Float;
width,
height : Natural := 0;
xv, yv : Float := 0.0 );
pragma Precondition( id'Length > 0 );
function Tile_Width( this : not null access World_Object'Class ) return Positive;
function Object_Input( stream : access Root_Stream_Type'Class ) return World_Object is abstract;
function Copy( src : A_World ) return A_World;
pragma Postcondition( Copy'Result /= src or else src = null );
procedure Delete( this : in out A_World );
pragma Postcondition( this = null );
function Valid_Domain( domain : String ) return Boolean;
function World_Extension return String;
pragma Postcondition( World_Extension'Result'Length > 0 );
FILE_NOT_FOUND,
READ_EXCEPTION,
WRITE_EXCEPTION : exception;
private
use Ada.Containers;
use Ada.Real_Time;
use Ada.Strings.Unbounded;
use Maps;
use Tiles;
package Entity_Map is new Ada.Containers.Ordered_Maps( Entity_Id, A_Entity, "<", "=" );
type Animated_Info is
record
layer : Integer;
x, y : Integer;
nextUpdate : Time;
frameDelay : Time_Span;
frames : A_Tile_Id_Array;
end record;
function Equivalent( l, r : Animated_Info ) return Boolean;
function Hash( a : Animated_Info ) return Hash_Type;
function Is_Looping( ai : Animated_Info ) return Boolean;
function Animated_Info_Input( stream : access Root_Stream_Type'Class ) return Animated_Info;
for Animated_Info'Input use Animated_Info_Input;
procedure Animated_Info_Output( stream : access Root_Stream_Type'Class; info : Animated_Info );
for Animated_Info'Output use Animated_Info_Output;
package Animated_Set is new Ada.Containers.Hashed_Sets( Animated_Info,
Hash, Equivalent,
"=" );
type World_Object is abstract new Object and Event_Listener and Process with
record
attached : Boolean := False;
corral : A_Corral;
pman : A_Process_Manager;
filename : Unbounded_String;
lib : A_Tile_Library := null;
player : Entity_Id := INVALID_ID;
map : A_Map := null;
libName : Unbounded_String;
domain : Unbounded_String;
title : Unbounded_String;
music : Unbounded_String;
entities : Entity_Map.Map;
animated : Animated_Set.Set;
end record;
procedure Adjust( this : access World_Object );
procedure Construct( this : access World_Object;
filename : String;
map : in out A_Map;
libName,
domain : String );
procedure Delete( this : in out World_Object );
procedure Initialize( this : access World_Object );
function Get_Process_Name( this : access World_Object ) return String;
pragma Postcondition( Get_Process_Name'Result'Length > 0 );
procedure Handle( this : access World_Object; evt : not null A_Delete_Entity_Event );
procedure Handle( this : access World_Object; evt : not null A_Entities_Collided_Event );
procedure Handle( this : access World_Object; evt : not null A_Entities_Separated_Event );
procedure Handle( this : access World_Object; evt : not null A_Entity_Face_Event );
procedure Handle( this : access World_Object; evt : not null A_Entity_Grounded_Event );
procedure Handle( this : access World_Object; evt : not null A_Entity_Hit_Wall_Event );
procedure Handle( this : access World_Object; evt : not null A_Entity_Moved_Event );
procedure Handle( this : access World_Object; evt : not null A_Entity_Resized_Event );
procedure Handle( this : access World_Object; evt : not null A_Set_Entity_Attribute_Event );
procedure Handle( this : access World_Object; evt : not null A_Spawn_Entity_Event );
procedure Handle_Event( this : access World_Object;
evt : in out A_Event;
resp : out Response_Type );
pragma Precondition( evt /= null );
procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out World_Object );
for World_Object'Read use Object_Read;
procedure Object_Write( stream : access Root_Stream_Type'Class; obj : World_Object );
for World_Object'Write use Object_Write;
procedure On_Attach( this : access World_Object );
procedure On_Detach( this : access World_Object );
procedure Queue_Load_Events( this : access World_Object );
procedure Tick( this : access World_Object; upTime, dt : Time_Span );
function A_World_Input( stream : access Root_Stream_Type'Class ) return A_World;
for A_World'Input use A_World_Input;
procedure A_World_Output( stream : access Root_Stream_Type'Class; world : A_World );
for A_World'Output use A_World_Output;
procedure A_World_Read( stream : access Root_Stream_Type'Class; world : out A_World );
for A_World'Read use A_World_Read;
procedure A_World_Write( stream : access Root_Stream_Type'Class; world : A_World );
for A_World'Write use A_World_Write;
type Allocator is
access function( width,
height : Positive;
libName,
domain : String ) return A_World;
procedure Register( allocate : not null Allocator;
identifier : String;
read_version,
write_version : Positive );
pragma Precondition( identifier'Length > 0 );
procedure Register_Domain( domain : String );
pragma Precondition( domain'Length > 0 );
function World_Identifier return String;
end Worlds;