1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Ada.Unchecked_Deallocation; 
  10. with Allegro.Bitmaps;                   use Allegro.Bitmaps; 
  11. with Ada.Real_Time;                     use Ada.Real_Time; 
  12. with Ada.Streams;                       use Ada.Streams; 
  13. with Objects;                           use Objects; 
  14. with Physics;                           use Physics; 
  15.  
  16. private with Ada.Containers.Doubly_Linked_Lists; 
  17. private with Ada.Strings.Unbounded; 
  18. private with Archives; 
  19. private with Locking_Objects; 
  20. private with Resources; 
  21.  
  22. package Tiles is 
  23.  
  24.     -- Initializes the Tiles system, allowing tile libraries to be loaded. 
  25.     procedure Initialize; 
  26.  
  27.     -- Finalizes the Tiles system before application exit. Calling this without 
  28.     -- calling Initialize first will have no effect. 
  29.     procedure Finalize; 
  30.  
  31.     ---------------------------------------------------------------------------- 
  32.  
  33.     -- An array of tile ids 
  34.     type Tile_Id_Array is array (Integer range <>) of Natural; 
  35.     type A_Tile_Id_Array is access all Tile_Id_Array; 
  36.  
  37.     function A_Tile_Id_Array_Input( stream : access Root_Stream_Type'Class ) return A_Tile_Id_Array; 
  38.     for A_Tile_Id_Array'Input use A_Tile_Id_Array_Input; 
  39.  
  40.     procedure A_Tile_Id_Array_Output( stream : access Root_Stream_Type'Class; tia : A_Tile_Id_Array ); 
  41.     for A_Tile_Id_Array'Output use A_Tile_Id_Array_Output; 
  42.  
  43.     -- Returns a copy of 'src'. 
  44.     function Copy( src : A_Tile_Id_Array ) return A_Tile_Id_Array; 
  45.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  46.  
  47.     -- Deletes the Tile_Id_Array. 
  48.     procedure Delete is new Ada.Unchecked_Deallocation( Tile_Id_Array, A_Tile_Id_Array ); 
  49.  
  50.     ---------------------------------------------------------------------------- 
  51.  
  52.     -- A Tile_Object represents a tile, the most basic element of a world map. 
  53.     -- It is uniquely identified within its library by an integer Id. Each tile 
  54.     -- is represented by a bitmap, can be animated using bitmaps from other 
  55.     -- tiles, and contains a set of attributes the define how entities interact 
  56.     -- with it in the world. 
  57.     type Tile_Object is abstract new Object with private; 
  58.     type A_Tile is access all Tile_Object'Class; 
  59.  
  60.     -- Creates a new tile using register allocator. Returns null if no allocator 
  61.     -- has been registered. 
  62.     function Create_Tile return A_Tile; 
  63.  
  64.     -- Returns the animation frame delay for the tile. 
  65.     function Get_Anm_Delay( this : not null access Tile_Object'Class ) return Time_Span; 
  66.  
  67.     -- Returns a reference to the tile's looped animation frame list, or null if 
  68.     -- the tile does not have a looping animation. Do not delete the array, it 
  69.     -- belongs to the tile. 
  70.     function Get_Frame_List( this : not null access Tile_Object'Class ) return A_Tile_Id_Array; 
  71.  
  72.     -- Returns the id of the tile within its library. 
  73.     function Get_Id( this : not null access Tile_Object'Class ) return Natural; 
  74.  
  75.     -- Returns the name (bitmap filename) of the tile. Tile names are not unique 
  76.     -- within a library. 
  77.     function Get_Name( this : not null access Tile_Object'Class ) return String; 
  78.  
  79.     -- Returns the id of the next frame in the tile's animation if it's a frame 
  80.     -- in a single shot animation. 
  81.     function Get_Next_Frame( this : not null access Tile_Object'Class ) return Natural; 
  82.  
  83.     -- Returns the X offset of the tile (for sprites). 
  84.     function Get_Offset_X( this : not null access Tile_Object'Class ) return Integer; 
  85.  
  86.     -- Returns the Y offset of the tile (for sprites). 
  87.     function Get_Offset_Y( this : not null access Tile_Object'Class ) return Integer; 
  88.  
  89.     -- Returns True if the file is animated. 
  90.     function Is_Animated( this : not null access Tile_Object'Class ) return Boolean; 
  91.  
  92.     function Object_Input( stream : access Root_Stream_Type'Class ) return Tile_Object is abstract; 
  93.  
  94.     procedure Object_Output( stream : access Root_Stream_Type'Class; obj : Tile_Object ) is abstract; 
  95.  
  96.     -- Sets an attribute on the tile by name. Only certain attribute names are 
  97.     -- supported and each has its own value constraints. False is returned in 
  98.     -- 'found' if the attribute name is not recognized. An exception is raised 
  99.     -- if the value is invalid or if there is a semantic error caused by setting 
  100.     -- the attribute. 
  101.     procedure Set_Attribute( this  : in out Tile_Object; 
  102.                              found : out Boolean; 
  103.                              name  : String; 
  104.                              val   : String := "" ); 
  105.  
  106.     -- Sets the id of the tile. Tile ids are unique within a library. Adding 
  107.     -- this tile to a library that already contains a tile with the same id will 
  108.     -- result in an error. 
  109.     procedure Set_Id( this : access Tile_Object; id : Natural ); 
  110.  
  111.     -- Sets the name (bitmap filename) of the tile. Tile names are not unique 
  112.     -- within a library. 
  113.     procedure Set_Name( this : access Tile_Object; name : String ); 
  114.     pragma Precondition( name'Length > 0 ); 
  115.  
  116.     -- Deletes the Tile. 
  117.     procedure Delete( this : in out A_Tile ); 
  118.     pragma Postcondition( this = null ); 
  119.  
  120.     ATTRIBUTE_ERROR : exception; 
  121.  
  122. private 
  123.  
  124.     use Ada.Strings.Unbounded; 
  125.     use Archives; 
  126.     use Locking_Objects; 
  127.     use Resources; 
  128.  
  129.     type Tile_Object is abstract new Object with 
  130.         record 
  131.             id        : Natural := 0; 
  132.             name      : Unbounded_String; 
  133.  
  134.             lock      : A_Locking_Object := null;    -- protects bmp, priority 
  135.             bmp       : A_Bitmap := null; 
  136.             priority  : Integer := 0; 
  137.  
  138.             loadState : A_Async_Operation := null; 
  139.             clipping  : Clip_Type := Passive; 
  140.             anmDelay  : Time_Span := Time_Span_Zero; -- animation frame delay in ms 
  141.             nextFrame : Natural := 0;                -- tile id of next frame in one-shot animation 
  142.             frames    : A_Tile_Id_Array := null;     -- tile id list in looping animation 
  143.             offsetX, 
  144.             offsetY   : Integer := 0; 
  145.         end record; 
  146.  
  147.     -- Raises COPY_NOT_ALLOWED. 
  148.     procedure Adjust( this : access Tile_Object ); 
  149.  
  150.     procedure Construct( this : access Tile_Object ); 
  151.  
  152.     procedure Delete( this : in out Tile_Object ); 
  153.  
  154.     -- Returns null if the tile's bitmap file isn't found or hasn't loaded yet. 
  155.     function Get_Bitmap( this : not null access Tile_Object'Class ) return A_Bitmap; 
  156.  
  157.     -- Returns the physics clipping type that the tile represents. 
  158.     function Get_Clipping( this : not null access Tile_Object'Class ) return Clip_Type; 
  159.  
  160.     -- Returns True if the tile's bitmap has been loaded, successfully or otherwise. 
  161.     function Is_Loaded( this : not null access Tile_Object'Class ) return Boolean; 
  162.  
  163.     -- Loads the tile's bitmap from an archive. 
  164.     procedure Load_Bitmap( this    : not null access Tile_Object'Class; 
  165.                            archive : not null A_Archive ); 
  166.  
  167.     -- Blocks the caller until the tile's bitmap has been loaded. 
  168.     procedure Wait_For_Load( this : not null access Tile_Object'Class ); 
  169.  
  170.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Tile_Object ); 
  171.     for Tile_Object'Read use Object_Read; 
  172.  
  173.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Tile_Object ); 
  174.     for Tile_Object'Write use Object_Write; 
  175.  
  176.     ---------------------------------------------------------------------------- 
  177.  
  178.     function A_Tile_Input( stream : access Root_Stream_Type'Class ) return A_Tile; 
  179.     for A_Tile'Input use A_Tile_Input; 
  180.  
  181.     procedure A_Tile_Output( stream : access Root_Stream_Type'Class; tile : A_Tile ); 
  182.     for A_Tile'Output use A_Tile_Output; 
  183.  
  184.     procedure A_Tile_Read( stream : access Root_Stream_Type'Class; tile : out A_Tile ); 
  185.     for A_Tile'Read use A_Tile_Read; 
  186.  
  187.     procedure A_Tile_Write( stream : access Root_Stream_Type'Class; tile : A_Tile ); 
  188.     for A_Tile'Write use A_Tile_Write; 
  189.  
  190.     ---------------------------------------------------------------------------- 
  191.  
  192.     -- Defines a list of Tile objects. 
  193.     package Tile_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Tile, "=" ); 
  194.     use Tile_Lists; 
  195.  
  196.     ---------------------------------------------------------------------------- 
  197.  
  198.     -- An allocator function for creating a new Tile. 
  199.     type Allocator is access function return A_Tile; 
  200.  
  201.     -- Returns a string that identifies the type of concrete Tile class. This 
  202.     -- is used in the file format identifier of tile index files, where Tile 
  203.     -- objects are written to disk. 
  204.     function Tile_Identifier return String; 
  205.     pragma Postcondition( Tile_Identifier'Result'Length > 0 ); 
  206.  
  207.     -- Returns the version number of the Tile subclass' stream representation. 
  208.     -- Returns 0 if a tile version has not been registered. 
  209.     -- See Register_Version. 
  210.     function Tile_Version return Natural; 
  211.  
  212.     -- Registers the allocator used to create new Tile instances. 
  213.     procedure Register_Allocator( allocate : not null Allocator ); 
  214.  
  215.     -- Sets the concrete Tile class identifier string returned by 
  216.     -- Tile_Identifier. 
  217.     procedure Register_Identifier( identifier : String ); 
  218.     pragma Precondition( identifier'Length > 0 ); 
  219.  
  220.     -- Sets the version number of the Tile subclass' stream representation. This 
  221.     -- should be incremented when a change is made to the streaming 
  222.     -- representation of the Tile subclass but the same class with the same 
  223.     -- tile identifier is still being used. This will prevent us from attempting 
  224.     -- to load an outdated Tile representation from a stream and crashing. 
  225.     procedure Register_Version( version : Positive ); 
  226.  
  227. end Tiles;