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 Game_States; use Game_States;
with Objects; use Objects;
with Processes; use Processes;
with Processes.Managers; use Processes.Managers;
with Symbol_Resolvers; use Symbol_Resolvers;
with Tiles.Libraries; use Tiles.Libraries;
with Values; use Values;
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 Expressions.Evaluators;
private with Maps;
private with Tiles;
package Worlds is
-- A World is an object which contains a map and entities. It can be
-- created, loaded and saved as a simple data object and it can be copied.
--
-- Worlds are also Processes and Event_Listeners which can be attached to
-- the game framework. Only one World at a time can be attached. This is
-- enforced by the Game logic. Attaching a World to the game framework means
-- giving it a Corral so it can register to receive events and attaching it
-- to a Process_Manager so it can execute code. An attached World object
-- then has behavior because it listens for events, queues events, and
-- executes code as a Process. When a world is attached, its dispatching
-- On_Attach procedure is called, which may queue load-time events and
-- register the object as an event listener. When a world is detached from
-- the game framework, its dispatching On_Detach procedure is called to
-- unregister the object as an event listener, etc. A World object can't be
-- copied while it is attached to the Game framework.
--
-- An unattached World should not have any independent behavior and should
-- only do as it is instructed by calling the class procedures.
type World_Object is abstract new Object and
Event_Listener and
Process and
Symbol_Resolver with private;
type A_World is access all World_Object'Class;
-- Creates a new empty world. An exception is raised on error.
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 );
-- Loads a world from disk. An exception is raised on error.
function Load_World( name : String ) return A_World;
pragma Postcondition( Load_World'Result /= null );
-- Attaches the world to the game framework to send and receive events and
-- execute as a process.
procedure Attach_To_Framework( this : not null access World_Object'Class;
game : not null A_Game_State;
corral : not null A_Corral;
pman : not null A_Process_Manager );
-- Detaches the world from the game framework, removing itself as an event
-- listener and ceasing execution as a process. If 'destroy' is True, the
-- world will delete itself after being fully detached from its process
-- manager, in which case the caller should never access this world object
-- again. If 'destroy' is False, the world will begin detaching itself from
-- its process manager, but if the process manager is running then this will
-- not complete until the next Tick. In this case, the world reference can
-- be kept and used but may Not be deleted directly after calling
-- Detach_From_Framework.
procedure Detach_From_Framework( this : not null access World_Object'Class;
destroy : Boolean );
-- Evaluates the text in 'expression' and returns a value. Identifiers in
-- the expression will be resolved as game session variables. If the
-- expression can't be properly evaluated, null will be returned.
function Evaluate( this : not null access World_Object'Class;
expression : String ) return A_Value;
-- Iterate through all of the entities in the world, examining each.
procedure Examine_Entities( this : not null access World_Object'Class;
examine : not null access procedure( e : not null A_Entity ) );
-- Returns a reference to an entity with the given id, or null if the entity
-- doesn't exist.
function Get_Entity( this : access World_Object; id : Entity_Id ) return A_Entity;
-- The name of the file that this world was loaded from (including the file
-- extension), if it was loaded. If this world was not loaded from disk or
-- has not been saved to the disk yet then an empty string will be returned.
function Get_Filename( this : access World_Object ) return String;
-- Returns the World's attached Game class, if it has been attached to the
-- framework.
function Get_Game_State( this : not null access World_Object'Class ) return A_Game_State;
-- Returns the actual map height in pixels.
function Get_Height( this : not null access World_Object'Class ) return Positive;
-- Returns the height of the map in tiles.
function Get_Height_Tiles( this : not null access World_Object'Class ) return Positive;
-- Returns the world's reference to its tile library. Do not modify it.
function Get_Library( this : not null access World_Object'Class ) return A_Tile_Library;
-- Returns the name of the background music track.
function Get_Music( this : not null access World_Object'Class ) return String;
-- Returns a reference to the world's current player entity. Do not modify
-- it.
function Get_Player( this : not null access World_Object'Class ) return A_Player;
-- Returns the id of the tile at the specified location.
function Get_Tile_Id( this : not null access World_Object'Class;
layer,
x, y : Integer ) return Natural;
-- Returns the title of the world.
function Get_Title( this : not null access World_Object'Class ) return String;
-- Returns the actual map width in pixels.
function Get_Width( this : not null access World_Object'Class) return Positive;
-- Returns the width of the map in tiles.
function Get_Width_Tiles( this : not null access World_Object'Class ) return Positive;
-- Resizes the map. An exception is raised on error.
procedure Resize( this : not null access World_Object'Class;
width,
height : Positive );
-- Writes the world in its current state to a file on disk. An exception is
-- raised on error.
procedure Save( this : not null access World_Object'Class;
name : String;
overwrite : Boolean := True );
pragma Precondition( name'Length > 0 );
-- basic properties:
-- "filename" : the filename
-- "domain" : determines player movement, physical rules
-- "title" : the readable name of the world
-- "music" : the background music track name
procedure Set_Property( this : access World_Object; name, value : String );
pragma Precondition( name'Length > 0 );
-- If 'notify' is True, Tile_Changed and World_Modified events will be sent.
procedure Set_Tile( this : access World_Object;
layer : Integer;
x, y : Integer;
id : Natural;
notify : Boolean := True );
-- x, y are in pixel coordinates, not tile coordinates. If 'notify' is True,
-- Tile_Changed and World_Modified events will be sent.
procedure Set_Tile( this : access World_Object;
layer : Integer;
x, y : Float;
id : Natural;
notify : Boolean := True );
-- Spawns an entity of the given class id into the world. If 'width' or
-- 'height' are equal to 0, the entity's natural width and height will be
-- used.
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 );
-- Returns the width of each tile in the world, in pixels.
function Tile_Width( this : not null access World_Object'Class ) return Positive;
-- Implement this function to Construct and Read instances of the concrete
-- subclass from a stream.
function Object_Input( stream : access Root_Stream_Type'Class ) return World_Object is abstract;
-- Worlds can't be copied; Raises COPY_NOT_ALLOWED.
function Copy( src : A_World ) return A_World;
pragma Postcondition( Copy'Result /= src or else src = null );
-- Deletes the World.
procedure Delete( this : in out A_World );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- Returns True if 'domain' is a registered domain name. Case sensitive.
function Valid_Domain( domain : String ) return Boolean;
-- Returns the file extension for World files, without a leading dot.
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 Expressions.Evaluators;
use Maps;
use Tiles;
-- Maps Entity_Ids to Entity objects.
package Entity_Map is new Ada.Containers.Ordered_Maps( Entity_Id, A_Entity, "<", "=" );
-- There are two kinds of tile animation: looping animations and one-shot.
--
-- In the case of a one-shot animation, each frame progresses to the next
-- after a fixed amount of time, beginning the moment the tile is set into
-- the world. Generally, the last frame of a one-shot animation will end by
-- progressing to a non-animated tile. It is possible for a frame in a
-- one-shot animation to jump back to a previous frame, creating a frame
-- cycle, but this is generally not very useful.
--
-- Looping animations have a list of frames and a single delay. The biggest
-- difference between looping and one-shot animations is that the animation
-- frame is globally updated at specific time slices, based on the animation
-- frame delay. This means that two world locations with the same tile id
-- will always update simultaneously, regardless of being set into the map
-- at different times or not.
--
-- An animation is looping if the frames field of the Animated_Info is
-- non-null, otherwise it's a one-shot.
type Animated_Info is
record
layer : Integer; -- layer of animated tile
x, y : Integer; -- coordinates of animated tile
nextUpdate : Time; -- next time to update the frame
frameDelay : Time_Span; -- (for looping) animation frame delay
frames : A_Tile_Id_Array; -- (for looping) frame list
end record;
-- Returns True if 'l' and 'r' share the same world location.
function Equivalent( l, r : Animated_Info ) return Boolean;
-- Returns a hash value of the Animated_Info record.
function Hash( a : Animated_Info ) return Hash_Type;
-- Returns True if the animation is played as a loop.
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 and
Symbol_Resolver with
record
-- the following fields are Not streamed
attached : Boolean := False;
game : A_Game_State;
corral : A_Corral;
pman : A_Process_Manager;
evaluator : A_Evaluator := Create_Evaluator;
filename : Unbounded_String;
lib : A_Tile_Library := null;
player : Entity_Id := INVALID_ID;
-- the following fields are streamed
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 );
-- Construction with an empty filename, map, libName and domain is allowed
-- if the object is being constructed as part of a streaming read operation.
-- The fields should be be immediately read in before the World is returned
-- to the application for use.
procedure Construct( this : access World_Object;
filename : String;
map : in out A_Map;
libName,
domain : String );
procedure Delete( this : in out World_Object );
-- Performs initialization immediately after load that can't be performed
-- during construction, like passing a reference to 'this' to child objects
-- (ie: entitites) that need it. An overriding implementation should call
-- this first.
procedure Initialize( this : access World_Object );
-- Returns the name of the World as a Process.
function Get_Process_Name( this : access World_Object ) return String;
pragma Postcondition( Get_Process_Name'Result'Length > 0 );
-- Handles a Delete_Entity event.
procedure Handle( this : access World_Object; evt : not null A_Delete_Entity_Event );
-- Handles an Entities_Collided event.
procedure Handle( this : access World_Object; evt : not null A_Entities_Collided_Event );
-- Handles an Entities_Separated event.
procedure Handle( this : access World_Object; evt : not null A_Entities_Separated_Event );
-- Handles an Entity_Face event.
procedure Handle( this : access World_Object; evt : not null A_Entity_Face_Event );
-- Handles an Entity_Grounded event.
procedure Handle( this : access World_Object; evt : not null A_Entity_Grounded_Event );
-- Handles an Entity_Hit_Wall event.
procedure Handle( this : access World_Object; evt : not null A_Entity_Hit_Wall_Event );
-- Handles an Entity_Moved event.
procedure Handle( this : access World_Object; evt : not null A_Entity_Moved_Event );
-- Handles an Entity_Resized event.
procedure Handle( this : access World_Object; evt : not null A_Entity_Resized_Event );
-- Handles a Set_Entity_Attribute event.
procedure Handle( this : access World_Object; evt : not null A_Set_Entity_Attribute_Event );
-- Handles a Spawn_Entity event.
procedure Handle( this : access World_Object; evt : not null A_Spawn_Entity_Event );
-- Handles all events the World receives and dispatches to the specific
-- Handle procedure. If this procedure is overridden, the implementation
-- should handle 'evt' if it's special. If the subclass doesn't do anything
-- special with it, then it should call this implementation to dispatch it.
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;
-- This is called when the World is attached to the Game framework, to
-- register for events and execute entities' On_Load handlers. Override this
-- procedure to register the world to listen for special events or to queue
-- any special events on load. An overriding implementation should call this
-- first.
procedure On_Attach( this : access World_Object );
-- This is called when the World is removed from the Game framework, to
-- unregister for the events it previously registered for with On_Attach.
-- If On_Attach is overridden, On_Detach should be overridden too. The
-- world can't remain registered as a listener for any event type on detach.
-- An overriding implementation should call this first.
procedure On_Detach( this : access World_Object );
-- Queues world loaded events in order to send the world to the game views.
-- This includes the events World_Loaded, World_Property_Changed,
-- Entity_Created, and Follow_Entity. This procedure is called as part of
-- On_Attach. An overriding implementation should call this first.
procedure Queue_Load_Events( this : access World_Object );
-- Resolves the symbol named 'symbol' as a game session variable. null will
-- be returned if the symbol can't be resolved.
function Resolve( this : access World_Object; symbol : String ) return A_Value;
-- Executes one frame of the world behavior; updates entities and animated
-- tiles. An overriding implementation should call this first.
procedure Tick( this : access World_Object; time : Tick_Time );
-- Verifies a file format header before reading the World representation.
-- If the header is invalid, READ_EXCEPTION will be raised. Raises an
-- exception on streaming error.
function A_World_Input( stream : access Root_Stream_Type'Class ) return A_World;
for A_World'Input use A_World_Input;
-- Writes a file format header and then the World representation.
procedure A_World_Output( stream : access Root_Stream_Type'Class; world : A_World );
for A_World'Output use A_World_Output;
-- Reads the concrete World tag and instantiates it. A Constraint_Error will
-- be raised if the class is unknown. Raises an exception on streaming
-- error.
procedure A_World_Read( stream : access Root_Stream_Type'Class; world : out A_World );
for A_World'Read use A_World_Read;
-- Writes the conrete World tag.
procedure A_World_Write( stream : access Root_Stream_Type'Class; world : A_World );
for A_World'Write use A_World_Write;
----------------------------------------------------------------------------
-- An allocator function for Creating a new World. 'width' and 'height' are
-- the size of the world in tiles. 'libName' is the library that contains
-- the tiles used in the world. 'domain' is the world domain, which
-- determines physics constants, the player entity, and available enemy
-- types.
type Allocator is
access function( width,
height : Positive;
libName,
domain : String ) return A_World;
-- Registers all the information pertinent to the application's concrete
-- World implementation: an allocator for creating a new World instance,
-- the world format identifier string, and the World format version number.
procedure Register( allocate : not null Allocator;
identifier : String;
read_version,
write_version : Positive );
pragma Precondition( identifier'Length > 0 );
-- Registers 'domain' as a valid domain for Worlds. Case sensitive.
procedure Register_Domain( domain : String );
pragma Precondition( domain'Length > 0 );
-- Returns a string that identifies the world index file format. It is the
-- first data found in the file.
function World_Identifier return String;
end Worlds;