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 Tiles.Matrices;                    use Tiles.Matrices; 
  10.  
  11. private with Ada.Containers; 
  12. private with Ada.Containers.Hashed_Maps; 
  13. private with Ada.Containers.Vectors; 
  14. private with Ada.Unchecked_Conversion; 
  15.  
  16. private package Tiles.Catalogs is 
  17.  
  18.     -- A Catalog indexes and organizes all the Tiles in a Tile_Library. It is 
  19.     -- stored inside a tile library as a catalog file, alongside all the bitmap 
  20.     -- files. In addition to indexing tiles, it indexes tile matrices for 
  21.     -- repeated tile patterns and large, multi-tile objects. 
  22.     type Catalog is new Object with private; 
  23.     type A_Catalog is access all Catalog'Class; 
  24.  
  25.     -- Creates a new empty tile catalog. 
  26.     function Create_Catalog return A_Catalog; 
  27.     pragma Postcondition( Create_Catalog'Result /= null ); 
  28.  
  29.     -- Adds a new tile matrix to the catalog. 'matrix' will be consumed. 
  30.     procedure Add_Matrix( this   : not null access Catalog'Class; 
  31.                           matrix : in out A_Tile_Matrix ); 
  32.     pragma Precondition( matrix /= null ); 
  33.     pragma Postcondition( matrix = null ); 
  34.  
  35.     -- Adds a new tile to the catalog. 'tile' is consumed. If 'tile' is passed 
  36.     -- as null, an empty tile slot is added to the tile list as a place holder. 
  37.     -- The exception DUPLICATE_TILE will be raised if a tile with the same id 
  38.     -- already exists in the catalog. 
  39.     procedure Add_Tile( this : not null access Catalog'Class; 
  40.                         tile : in out A_Tile ); 
  41.     pragma Postcondition( tile = null ); 
  42.  
  43.     -- Finds a tile with a name matching 'name' and returns a reference. The 
  44.     -- tile with the first matching name will be returned. If 'name' does not 
  45.     -- include a file extension, a matching .png file will be searched first, 
  46.     -- then a matching .bmp file. Do not modify the tile; it belongs to the 
  47.     -- catalog. Null will be returned if no tile is not found. 
  48.     function Find_Tile( this : not null access Catalog'Class; 
  49.                         name : String ) return A_Tile; 
  50.     pragma Precondition( name'Length > 0 ); 
  51.  
  52.     -- Returns a reference to a matrix in the catalog by index, base 1. The 
  53.     -- index is determined by the order in which the matrices were added. If 
  54.     -- there is no matrix at 'index' then null will be returned. 
  55.     function Get_Matrix( this  : not null access Catalog'Class; 
  56.                          index : Natural ) return A_Tile_Matrix; 
  57.  
  58.     -- Returns the number of matrices in the catalog. 
  59.     function Get_Matrix_Count( this : not null access Catalog'Class ) return Natural; 
  60.  
  61.     -- Returns a tile reference by id, base 1. Do not modify the tile; it 
  62.     -- belongs to the catalog. Null will be returned if the id is not found. 
  63.     function Get_Tile( this : not null access Catalog'Class; 
  64.                        id   : Natural ) return A_Tile; 
  65.  
  66.     -- Iterates across all the tiles in the catalog by order of ascending id. 
  67.     procedure Iterate_By_Id( this    : not null access Catalog'Class; 
  68.                              examine : not null access procedure( tile : not null A_Tile ) ); 
  69.  
  70.     -- Iterates across all the tile slots in the catalog, beginning with 1. Not 
  71.     -- every slot contains a tile, so the 'tile' argument of 'examine' may be 
  72.     -- null. 
  73.     procedure Iterate_By_Slot( this    : not null access Catalog'Class; 
  74.                                examine : not null access procedure( slot : Positive; 
  75.                                                                     tile : A_Tile ) ); 
  76.  
  77.     function Object_Input( stream : access Root_Stream_Type'Class ) return Catalog; 
  78.     for Catalog'Input use Object_Input; 
  79.  
  80.     procedure Object_Output( stream : access Root_Stream_Type'Class; obj : Catalog ); 
  81.     for Catalog'Output use Object_Output; 
  82.  
  83.     -- Deletes the Catalog and all the Tiles it currently contains. 
  84.     procedure Delete( this : in out A_Catalog ); 
  85.     pragma Postcondition( this = null ); 
  86.  
  87.     ---------------------------------------------------------------------------- 
  88.  
  89.     -- Returns the version number of the tile catalog's stream format. Different 
  90.     -- version numbers are incompatible. 
  91.     function Catalog_Format_Version return Natural; 
  92.  
  93.     -- raised on attempt to add a tile with a duplicate id 
  94.     DUPLICATE_TILE : exception; 
  95.  
  96. private 
  97.  
  98.     use Ada.Containers; 
  99.  
  100.     function Integer_Hash is new Ada.Unchecked_Conversion( Integer, Hash_Type ); 
  101.  
  102.     package Tile_Maps is new Ada.Containers.Hashed_Maps( Integer, A_Tile, Integer_Hash, "=", "=" ); 
  103.     package Tile_Vectors is new Ada.Containers.Vectors( Positive, A_Tile, "=" ); 
  104.     package Matrix_Vectors is new Ada.Containers.Vectors( Positive, A_Tile_Matrix, "=" ); 
  105.  
  106.     type Catalog is new Object with 
  107.         record 
  108.             idMap     : Tile_Maps.Map;          -- mapping of id numbers to tiles 
  109.             slotArray : Tile_Vectors.Vector;    -- array of tiles as slots (sparse collection) 
  110.             matArray  : Matrix_Vectors.Vector;  -- array of tile matrices 
  111.         end record; 
  112.  
  113.     -- Raises COPY_NOT_ALLOWED. 
  114.     procedure Adjust( this : access Catalog ); 
  115.  
  116.     procedure Delete( this : in out Catalog ); 
  117.  
  118.     -- Reads the contents of a Catalog from a stream. 
  119.     procedure Object_Read( stream : access Root_Stream_Type'Class; 
  120.                            obj    : out Catalog ); 
  121.     for Catalog'Read use Object_Read; 
  122.  
  123.     -- WRites the contents of a Catalog to a stream. 
  124.     procedure Object_Write( stream : access Root_Stream_Type'Class; 
  125.                             obj    : Catalog ); 
  126.     for Catalog'Write use Object_Write; 
  127.  
  128.     ---------------------------------------------------------------------------- 
  129.  
  130.     -- Verifies a file format header before reading the Catalog representation. 
  131.     -- If the header is invalid, READ_EXCEPTION will be raised. Raises an 
  132.     -- exception on streaming error. 
  133.     function A_Catalog_Input( stream : access Root_Stream_Type'Class ) return A_Catalog; 
  134.     for A_Catalog'Input use A_Catalog_Input; 
  135.  
  136.     -- Writes a file format header and then the Catalog representation. 
  137.     procedure A_Catalog_Output( stream : access Root_Stream_Type'Class; 
  138.                                 obj    : A_Catalog ); 
  139.     for A_Catalog'Output use A_Catalog_Output; 
  140.  
  141.     -- Reads the Catalog tag and instantiates it. A Constraint_Error will be 
  142.     -- raised if the class is unknown. Raises an exception on streaming error. 
  143.     procedure A_Catalog_Read( stream : access Root_Stream_Type'Class; 
  144.                               obj    : out A_Catalog ); 
  145.     for A_Catalog'Read use A_Catalog_Read; 
  146.  
  147.     -- Writes the Catalog tag and object contents. 
  148.     procedure A_Catalog_Write( stream : access Root_Stream_Type'Class; 
  149.                                obj    : A_Catalog ); 
  150.     for A_Catalog'Write use A_Catalog_Write; 
  151.  
  152. end Tiles.Catalogs;