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.Streams;                       use Ada.Streams; 
  12. with Objects;                           use Objects; 
  13. with Values;                            use Values; 
  14. with Values.Associations;               use Values.Associations; 
  15.  
  16. private with Ada.Containers.Doubly_Linked_Lists; 
  17. private with Ada.Strings.Unbounded; 
  18. private with Completions; 
  19. private with Locking_Objects; 
  20. private with Resources.Archives; 
  21.  
  22. package Tiles is 
  23.  
  24.     -- An array of tile ids 
  25.     type Tile_Id_Array is array (Integer range <>) of Natural; 
  26.     type A_Tile_Id_Array is access all Tile_Id_Array; 
  27.  
  28.     function A_Tile_Id_Array_Input( stream : access Root_Stream_Type'Class ) return A_Tile_Id_Array; 
  29.     for A_Tile_Id_Array'Input use A_Tile_Id_Array_Input; 
  30.  
  31.     procedure A_Tile_Id_Array_Output( stream : access Root_Stream_Type'Class; tia : A_Tile_Id_Array ); 
  32.     for A_Tile_Id_Array'Output use A_Tile_Id_Array_Output; 
  33.  
  34.     -- Returns a copy of 'src'. 
  35.     function Copy( src : A_Tile_Id_Array ) return A_Tile_Id_Array; 
  36.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  37.  
  38.     -- Deletes the Tile_Id_Array. 
  39.     procedure Delete is new Ada.Unchecked_Deallocation( Tile_Id_Array, A_Tile_Id_Array ); 
  40.  
  41.     ---------------------------------------------------------------------------- 
  42.  
  43.     -- A Tile_Object represents a tile, the most basic element of a world map. 
  44.     -- It is uniquely identified within its library by an integer Id. Each tile 
  45.     -- is represented by a bitmap, can be animated using bitmaps from other 
  46.     -- tiles, and contains a set of attributes the define how entities interact 
  47.     -- with it in the world. 
  48.     type Tile_Object is new Object with private; 
  49.     type A_Tile is access all Tile_Object'Class; 
  50.  
  51.     -- Creates a new tile using register allocator. Returns null if no allocator 
  52.     -- has been registered. 
  53.     function Create_Tile return A_Tile; 
  54.  
  55.     -- Returns the value of the 'name' attribute of the tile, or Null if the 
  56.     -- attribute has not been defined. 
  57.     function Get_Attribute( this : access Tile_Object'Class; 
  58.                             name : String ) return Value_Ptr; 
  59.  
  60.     -- Returns null if the tile's bitmap file isn't found or hasn't loaded yet. 
  61.     -- If 'this' is null, null will be returned. 
  62.     function Get_Bitmap( this : access Tile_Object'Class ) return A_Allegro_Bitmap; 
  63.  
  64.     -- Returns the id of the tile within its library. 
  65.     function Get_Id( this : not null access Tile_Object'Class ) return Natural; 
  66.  
  67.     -- Returns the name (bitmap filename) of the tile. Tile names are not unique 
  68.     -- within a library. 
  69.     function Get_Name( this : not null access Tile_Object'Class ) return String; 
  70.  
  71.     -- Returns True if the tile's bitmap has been loaded, successfully or otherwise. 
  72.     function Is_Loaded( this : not null access Tile_Object'Class ) return Boolean; 
  73.  
  74.     -- Reads a Tile_Object from a stream. 
  75.     function Object_Input( stream : access Root_Stream_Type'Class ) return Tile_Object; 
  76.     for Tile_Object'Input use Object_Input; 
  77.  
  78.     -- Writes a Tile_Object to a stream. 
  79.     procedure Object_Output( stream : access Root_Stream_Type'Class; obj : Tile_Object ); 
  80.     for Tile_Object'Output use Object_Output; 
  81.  
  82.     -- Sets an attribute on the tile by name. The value may be of any type. 
  83.     procedure Set_Attribute( this : not null access Tile_Object'Class; 
  84.                              name : String; 
  85.                              val  : Value_Ptr'Class ); 
  86.     pragma Precondition( name'Length > 0 ); 
  87.     pragma Precondition( Value_Ptr(val) /= Values.Nul ); 
  88.  
  89.     -- Sets the id of the tile. Tile ids are unique within a library. Adding 
  90.     -- this tile to a library that already contains a tile with the same id will 
  91.     -- result in an error. 
  92.     procedure Set_Id( this : access Tile_Object; id : Natural ); 
  93.  
  94.     -- Sets the name (bitmap filename) of the tile. Tile names are not unique 
  95.     -- within a library. 
  96.     procedure Set_Name( this : access Tile_Object; name : String ); 
  97.     pragma Precondition( name'Length > 0 ); 
  98.  
  99.     -- Deletes the Tile. 
  100.     procedure Delete( this : in out A_Tile ); 
  101.     pragma Postcondition( this = null ); 
  102.  
  103.     ATTRIBUTE_ERROR : exception; 
  104.  
  105. private 
  106.  
  107.     use Ada.Strings.Unbounded; 
  108.     use Completions; 
  109.     use Locking_Objects; 
  110.     use Resources.Archives; 
  111.  
  112.     type Tile_Object is new Object with 
  113.         record 
  114.             -- ** these fields are streamed ** 
  115.             id         : Natural := 0; 
  116.             name       : Unbounded_String; 
  117.             attributes : Assoc_Ptr; 
  118.             -- ** end streamed fields ** 
  119.  
  120.             lock       : A_Locking_Object := null;    -- protects bmp, priority 
  121.             bmp        : A_Allegro_Bitmap := null; 
  122.             priority   : Integer := 0; 
  123.             loadState  : A_Completion := null; 
  124.         end record; 
  125.  
  126.     -- Raises COPY_NOT_ALLOWED. 
  127.     procedure Adjust( this : access Tile_Object ); 
  128.  
  129.     procedure Construct( this : access Tile_Object ); 
  130.  
  131.     procedure Delete( this : in out Tile_Object ); 
  132.  
  133.     -- Loads the tile's bitmap from an archive. 
  134.     procedure Load_Bitmap( this    : not null access Tile_Object'Class; 
  135.                            archive : not null A_Archive ); 
  136.  
  137.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Tile_Object ); 
  138.     for Tile_Object'Read use Object_Read; 
  139.  
  140.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Tile_Object ); 
  141.     for Tile_Object'Write use Object_Write; 
  142.  
  143.     ---------------------------------------------------------------------------- 
  144.  
  145.     function A_Tile_Input( stream : access Root_Stream_Type'Class ) return A_Tile; 
  146.     for A_Tile'Input use A_Tile_Input; 
  147.  
  148.     procedure A_Tile_Output( stream : access Root_Stream_Type'Class; tile : A_Tile ); 
  149.     for A_Tile'Output use A_Tile_Output; 
  150.  
  151.     procedure A_Tile_Read( stream : access Root_Stream_Type'Class; tile : out A_Tile ); 
  152.     for A_Tile'Read use A_Tile_Read; 
  153.  
  154.     procedure A_Tile_Write( stream : access Root_Stream_Type'Class; tile : A_Tile ); 
  155.     for A_Tile'Write use A_Tile_Write; 
  156.  
  157.     -- Defines a list of Tile objects. 
  158.     package Tile_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Tile, "=" ); 
  159.     use Tile_Lists; 
  160.  
  161. end Tiles;