--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
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 Maps; use Maps;
with Objects; use Objects;
with Processes; use Processes;
with Scripting; use Scripting;
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 Tiles;
private with Values.Associations;
private with Values.Lists;
package Worlds is
-- A World is an object which contains a map and entities. It can be
-- created, loaded, saved, and handles its own state and execution during
-- gameplay.
--
-- A World acts as a Process and as an Event_Listener that can be attached
-- to the game framework. Only one World at a time can be attached as the
-- game session's currently active world. This is enforced by the Game logic
-- that owns the active world. Attaching a World to the game framework means
-- giving it a Corral so it can register to receive events, evaluate all
-- its entities' OnAttach actions, and queue events to notify the view of
-- the world. An attached World object has behavior; it listens for events,
-- queues events, and executes as a Process.
--
-- When a world is attached, its On_Attach procedure is called, which queues
-- load-time events and register the object as an event listener. When a
-- world is detached from the game framework, its On_Detach procedure is
-- called to unregister the object as an event listener, etc.
--
-- An unattached World has no behavior until it is attached.
type World_Object is new Object and
Event_Listener and
Process and
Evaluation_Node 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;
physicalLayers : Maps.Boolean_Array;
library,
domain : String ) return A_World;
pragma Precondition( library'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.
procedure Attach_To_Framework( this : not null access World_Object'Class;
gameState : not null A_Game_State;
corral : not null A_Corral );
-- Detaches the world from the game framework, removing itself as an event
-- listener and ceasing execution as a process.
procedure Detach_From_Framework( this : not null access World_Object'Class );
-- Evaluates the script function 'name', given 'arguments'. The value of the
-- evaluated function will be returned, or Null if the function name is not
-- recognized.
-- todo: make this private (public due to 6.2.0w bug)
function Evaluate_Function( this : access World_Object;
name : String;
arguments : Value_Array ) return Value_Ptr;
-- Evaluates the symbol named 'symbol', resolving it as a game session
-- variable. null will be returned if the symbol can't be resolved.
-- todo: make this private (public due to 6.2.0w bug)
function Evaluate_Symbol( this : access World_Object; symbol : String ) return Value_Ptr;
-- 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 : not null access World_Object'Class;
id : Entity_Id ) return A_Entity;
-- 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 number of layers in the world's map.
function Get_Layers( 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 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 property of the world named 'name', or Null if the property
-- has not been defined.
function Get_Property( this : not null access World_Object'Class;
name : String ) return Value_Ptr;
pragma Postcondition( Get_Property'Result /= Values.Nul );
-- Returns the id of the tile at the specified location.
function Get_Tile_Id( this : not null access World_Object'Class;
layer : Positive;
x, y : Integer ) return Natural;
-- 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 );
-- Sets the value of a property named 'name' to 'value'.
-- A World_Property_Changed event and a World_Modified event will be fired.
procedure Set_Property( this : not null access World_Object'Class;
name : String;
value : Value_Ptr'Class );
pragma Precondition( name'Length > 0 );
pragma Precondition( Value_Ptr(value) /= Values.Nul );
-- If 'notify' is True, Tile_Changed and World_Modified events will be sent.
procedure Set_Tile( this : not null access World_Object'Class;
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 : not null access World_Object'Class;
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. If the world is attached to the game framework, Entity_Created and
-- World_Modified events will be generated. The id of the new entity will be
-- returned, or INVALID_ID if the
function Spawn_Entity( this : not null access World_Object'Class;
id : String;
x, y : Float;
width,
height : Natural := 0;
xv, yv : Float := 0.0 ) return Entity_Id;
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;
function Object_Input( stream : access Root_Stream_Type'Class ) return World_Object;
for World_Object'Input use Object_Input;
-- 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 Tiles;
use Values.Lists;
use Values.Associations;
-- 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 : Natural; -- 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 : List_Ptr; -- (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 the tile id of the frame at 'index' in the animation's frame
-- loop, or 0 if the animation isn't loop or doesn't have index 'index'.
-- Indexes start at 1.
function Get_Frame( ai : Animated_Info; index : Integer ) return Natural;
-- Returns a hash value of the Animated_Info record.
function Hash( ai : 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 new Object and
Event_Listener and
Process and
Evaluation_Node with
record
-- the following fields are Not streamed
attached : Boolean := False;
gameState : A_Game_State := null;
corral : A_Corral:= null;
lib : A_Tile_Library := null;
-- the following fields are streamed
properties : Assoc_Ptr;
map : A_Map := null;
animated : Animated_Set.Set;
entities : Entity_Map.Map;
end record;
--
-- Standard World_Object Properties:
--
-- filename : The filename the world was loaded from or saved to (not persisted)
-- library : The name of the world's tile library
-- playerId : The id of the entity that is controlled by the view
--
-- raises COPY_NOT_ALLOWED
procedure Adjust( this : access World_Object );
-- Constructs an empty world without a map as part of reading it in from a
-- stream, where the World's parameters are not yet known.
procedure Construct( this : access World_Object );
procedure Construct( this : access World_Object;
width,
height : Positive;
physicalLayers : Maps.Boolean_Array;
library,
domain : String );
pragma Precondition( physicalLayers'Length > 0 );
pragma Precondition( library'Length > 0 );
pragma Precondition( domain'Length > 0 );
procedure Delete( this : in out 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_Delete_Entity( this : access World_Object;
evt : not null A_Entity_Event );
-- Handles an Entity_Grounded event.
procedure Handle_Entity_Grounded( this : access World_Object;
evt : not null A_Entity_Grounded_Event );
-- Handles an Entity_Hit_Wall event.
procedure Handle_Entity_Hit_Wall( this : access World_Object;
evt : not null A_Entity_Hit_Wall_Event );
-- Handles an Entity_Moved event.
procedure Handle_Entity_Moved( this : access World_Object;
evt : not null A_Entity_Moved_Event );
-- Handles an Entity_Resized event.
procedure Handle_Entity_Resized( this : access World_Object;
evt : not null A_Entity_Resized_Event );
-- Handles a Set_Entity_Attribute event.
procedure Handle_Set_Entity_Attribute( this : access World_Object;
evt : not null A_Entity_Attribute_Event );
-- Handles a Spawn_Entity event.
procedure Handle_Spawn_Entity( 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 );
-- 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 );
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.
procedure Queue_Load_Events( this : not null access World_Object'Class );
-- 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;
----------------------------------------------------------------------------
-- Registers 'domain' as a valid domain for Worlds. Case sensitive.
procedure Register_Domain( domain : String );
pragma Precondition( domain'Length > 0 );
end Worlds;