with Ada.Unchecked_Deallocation;
with Allegro.Bitmaps; use Allegro.Bitmaps;
with Ada.Real_Time; use Ada.Real_Time;
with Ada.Streams; use Ada.Streams;
with Objects; use Objects;
with Physics; use Physics;
private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Strings.Unbounded;
private with Archives;
private with Locking_Objects;
private with Resources;
package Tiles is
procedure Initialize;
procedure Finalize;
type Tile_Id_Array is array (Integer range <>) of Natural;
type A_Tile_Id_Array is access all Tile_Id_Array;
function A_Tile_Id_Array_Input( stream : access Root_Stream_Type'Class ) return A_Tile_Id_Array;
for A_Tile_Id_Array'Input use A_Tile_Id_Array_Input;
procedure A_Tile_Id_Array_Output( stream : access Root_Stream_Type'Class; tia : A_Tile_Id_Array );
for A_Tile_Id_Array'Output use A_Tile_Id_Array_Output;
function Copy( src : A_Tile_Id_Array ) return A_Tile_Id_Array;
pragma Postcondition( Copy'Result /= src or else src = null );
procedure Delete is new Ada.Unchecked_Deallocation( Tile_Id_Array, A_Tile_Id_Array );
type Tile_Object is abstract new Object with private;
type A_Tile is access all Tile_Object'Class;
function Create_Tile return A_Tile;
function Get_Anm_Delay( this : not null access Tile_Object'Class ) return Time_Span;
function Get_Id( this : not null access Tile_Object'Class ) return Natural;
function Get_Name( this : not null access Tile_Object'Class ) return String;
function Get_Next_Frame( this : not null access Tile_Object'Class ) return Natural;
function Get_Frame_List( this : not null access Tile_Object'Class ) return A_Tile_Id_Array;
function Is_Animated( this : not null access Tile_Object'Class ) return Boolean;
function Object_Input( stream : access Root_Stream_Type'Class ) return Tile_Object is abstract;
procedure Object_Output( stream : access Root_Stream_Type'Class; obj : Tile_Object ) is abstract;
procedure Set_Attribute( this : in out Tile_Object;
found : out Boolean;
name : String;
val : String := "" );
procedure Set_Id( this : access Tile_Object; id : Natural );
procedure Set_Name( this : access Tile_Object; name : String );
pragma Precondition( name'Length > 0 );
procedure Delete( this : in out A_Tile );
pragma Postcondition( this = null );
ATTRIBUTE_ERROR : exception;
private
use Ada.Strings.Unbounded;
use Archives;
use Locking_Objects;
use Resources;
type Tile_Object is abstract new Object with
record
id : Natural := 0;
name : Unbounded_String;
lock : A_Locking_Object := null;
bmp : A_Bitmap := null;
priority : Integer := 0;
loadState : A_Async_Operation := null;
clipping : Clip_Type := Passive;
anmDelay : Time_Span := Time_Span_Zero;
nextFrame : Natural := 0;
frames : A_Tile_Id_Array := null;
end record;
procedure Adjust( this : access Tile_Object );
procedure Construct( this : access Tile_Object );
procedure Delete( this : in out Tile_Object );
function Get_Bitmap( this : not null access Tile_Object'Class ) return A_Bitmap;
function Get_Clipping( this : not null access Tile_Object'Class ) return Clip_Type;
function Is_Loaded( this : not null access Tile_Object'Class ) return Boolean;
procedure Load_Bitmap( this : not null access Tile_Object'Class;
archive : not null A_Archive );
procedure Wait_For_Load( this : not null access Tile_Object'Class );
procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Tile_Object );
for Tile_Object'Read use Object_Read;
procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Tile_Object );
for Tile_Object'Write use Object_Write;
function A_Tile_Input( stream : access Root_Stream_Type'Class ) return A_Tile;
for A_Tile'Input use A_Tile_Input;
procedure A_Tile_Output( stream : access Root_Stream_Type'Class; tile : A_Tile );
for A_Tile'Output use A_Tile_Output;
procedure A_Tile_Read( stream : access Root_Stream_Type'Class; tile : out A_Tile );
for A_Tile'Read use A_Tile_Read;
procedure A_Tile_Write( stream : access Root_Stream_Type'Class; tile : A_Tile );
for A_Tile'Write use A_Tile_Write;
package Tile_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Tile, "=" );
use Tile_Lists;
type Allocator is access function return A_Tile;
function Tile_Identifier return String;
pragma Postcondition( Tile_Identifier'Result'Length > 0 );
function Tile_Version return Natural;
procedure Register_Allocator( allocate : not null Allocator );
procedure Register_Identifier( identifier : String );
pragma Precondition( identifier'Length > 0 );
procedure Register_Version( version : Positive );
end Tiles;