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.Indices is 
  17.  
  18.     -- A Tile_Index indexes and organizes all the Tiles in a Tile_Library. It is 
  19.     -- stored in a tile library as a separate index file, alongside all the 
  20.     -- included bitmaps. In addition to indexing tiles by id, it contains 
  21.     -- tile matrices for repeated tile patterns and large multi-tile objects. 
  22.     type Tile_Index is private; 
  23.     type A_Tile_Index is access all Tile_Index; 
  24.     pragma No_Strict_Aliasing( A_Tile_Index ); 
  25.  
  26.     -- Creates a new empty tile index. 
  27.     function Create_Tile_Index return A_Tile_Index; 
  28.     pragma Postcondition( Create_Tile_Index'Result /= null ); 
  29.  
  30.     -- Loads a tile index from an archive. Null will be returned if an error 
  31.     -- occurs. 
  32.     function Load_Index( archive  : not null A_Archive; 
  33.                          filename : String ) return A_Tile_Index; 
  34.     pragma Postcondition( filename'Length > 0 ); 
  35.  
  36.     -- Adds a new tile matrix to the index. 'matrix' will be consumed. 
  37.     procedure Add_Matrix( index : not null A_Tile_Index; matrix : in out A_Tile_Matrix ); 
  38.     pragma Precondition( matrix /= null ); 
  39.     pragma Postcondition( matrix = null ); 
  40.  
  41.     -- Adds a new tile to the index. 'tile' is consumed. If 'tile' is passed as 
  42.     -- null, a null tile is added to the tile list as a place holder. The 
  43.     -- exception DUPLICATE_TILE will be raised if a tile with the same id 
  44.     -- already exists in the index. 
  45.     procedure Add_Tile( index : not null A_Tile_Index; tile : in out A_Tile ); 
  46.     pragma Postcondition( tile = null ); 
  47.  
  48.     -- Deletes a tile index. 
  49.     procedure Delete( index : in out A_Tile_Index ); 
  50.     pragma Postcondition( index = null ); 
  51.  
  52.     -- Returns a reference to a matrix in the index by ordinal number, base 1. 
  53.     -- If there is no matrix for 'num' then null will be returned. 
  54.     function Get_Matrix( index : not null A_Tile_Index; num : Natural ) return A_Tile_Matrix; 
  55.  
  56.     -- Returns the number of matrices in the index. 
  57.     function Get_Matrix_Count( index : not null A_Tile_Index ) return Natural; 
  58.  
  59.     -- Returns the load completion for the index in the range of 0..100 
  60.     function Get_Progress( index : not null A_Tile_Index ) return Natural; 
  61.     pragma Postcondition( Get_Progress'Result <= 100 ); 
  62.  
  63.     -- Returns the slot number of a tile by id. The slot is determined by the 
  64.     -- order of the tiles in the index. The first tile is at slot 1. Zero will 
  65.     -- be returned if 'id' is not found in the index. 
  66.     function Get_Slot( index : not null A_Tile_Index; id : Natural ) return Natural; 
  67.  
  68.     -- Returns a tile reference by tile id, base 1. Do not modify the tile; it 
  69.     -- belongs to the index. Null will be returned if the tile is not found. 
  70.     function Get_Tile( index : not null A_Tile_Index; id : Natural ) return A_Tile; 
  71.  
  72.     -- Returns a tile reference by name. Do not modify the tile, it belongs to 
  73.     -- the index. Null will be returned if the tile is not found. 
  74.     function Get_Tile( index : not null A_Tile_Index; name : String ) return A_Tile; 
  75.     pragma Precondition( name'Length > 0 ); 
  76.  
  77.     -- Returns a tile reference by slot number, base 1. Do not modify the tile; 
  78.     -- it belongs to the index. Null will be returned if the tile is not found. 
  79.     function Get_Tile_At_Slot( index : not null A_Tile_Index; 
  80.                                slot  : Natural ) return A_Tile; 
  81.  
  82.     -- Returns the number of tiles in the index. 
  83.     function Get_Tile_Count( index : not null A_Tile_Index ) return Natural; 
  84.  
  85.     -- Iterates across the tiles in the index by order of listing, from first 
  86.     -- to last. 
  87.     procedure Iterate_Tiles( index   : not null A_Tile_Index; 
  88.                              examine : not null access procedure( tile : A_Tile ) ); 
  89.  
  90.     -- Indicates to the index that all tiles have been loaded. This will unblock 
  91.     -- any threads waiting for the index to be fully loaded. 
  92.     procedure Load_Complete( index : not null A_Tile_Index ); 
  93.  
  94.     -- Loads all the bitmaps for all the tiles in the index. 
  95.     procedure Load_Images( index   : not null A_Tile_Index; 
  96.                            archive : not null A_Archive ); 
  97.  
  98.     -- Prioritizes a tile to be loaded before non-priority tiles. 
  99.     procedure Prioritize_Tile( index : not null A_Tile_Index; tile : not null A_Tile ); 
  100.  
  101.     -- Writes the index to a file on disk, returning True on success. 
  102.     function Write_Index( index    : not null A_Tile_Index; 
  103.                           filename : String ) return Boolean; 
  104.     pragma Precondition( filename'Length > 0 ); 
  105.  
  106.     ---------------------------------------------------------------------------- 
  107.  
  108.     -- Returns the file extension for tile index tiles, without a leading dot. 
  109.     function Index_Extension return String; 
  110.     pragma Postcondition( Index_Extension'Result'Length > 0 ); 
  111.  
  112.     -- Returns a string that identifies the tile index file format. It is the 
  113.     -- first data found in the file. 
  114.     function Index_Identifier return String; 
  115.     pragma Postcondition( Index_Identifier'Result'Length > 0 ); 
  116.  
  117.     -- raised on attempt to add a tile with a duplicate id 
  118.     DUPLICATE_TILE : exception; 
  119.  
  120. private 
  121.  
  122.     use Ada.Containers; 
  123.  
  124.     -- Queue of tiles remaining to be loaded. Loading can be prioritized. 
  125.     protected type Tile_Queue is 
  126.  
  127.         -- Adds to the end of the list. when the library index is read, all 
  128.         -- tiles are added to the back of the queue. This is used to keep track 
  129.         -- of the total number of tiles that must be loaded. 
  130.         procedure Add_Back( tile : not null A_Tile ); 
  131.  
  132.         -- Returns a loaded percentage in the range of 0..100 
  133.         function Get_Progress return Natural; 
  134.         pragma Postcondition( Get_Progress'Result <= 100 ); 
  135.  
  136.         -- Prioritizes the loading of the tile by adding it to the front of the 
  137.         -- queue. It should already have been added to the back of the queue. 
  138.         procedure Prioritize( tile : not null A_Tile ); 
  139.  
  140.         -- Removes and returns first in the list. 
  141.         procedure Remove( tile : out A_Tile ); 
  142.  
  143.         -- Clears queue and stops accepting tiles. 
  144.         procedure Stop; 
  145.  
  146.     private 
  147.         queue   : Tile_Lists.List; 
  148.         total   : Natural := 0;         -- total number of unique tiles to load 
  149.         loaded  : Natural := 0;         -- number of tiles loaded so far 
  150.         stopped : Boolean := False; 
  151.     end Tile_Queue; 
  152.     type A_Tile_Queue is access all Tile_Queue; 
  153.  
  154.     -- Deletes the Tile_Queue. 
  155.     procedure Delete( queue : in out A_Tile_Queue ); 
  156.     pragma Postcondition( queue = null ); 
  157.  
  158.     ---------------------------------------------------------------------------- 
  159.  
  160.     function Hash is new Ada.Unchecked_Conversion( Integer, Hash_Type ); 
  161.  
  162.     package Integer_Vectors is new Ada.Containers.Vectors( Positive, Natural, "=" ); 
  163.     package Matrix_Vectors is new Ada.Containers.Vectors( Positive, A_Tile_Matrix, "=" ); 
  164.     package Tile_Maps is new Ada.Containers.Hashed_Maps( Integer, A_Tile, Hash, "=", "=" ); 
  165.  
  166.     type Tile_Index is 
  167.         record 
  168.             idmap    : Tile_Maps.Map;          -- mapping of id numbers to tiles 
  169.             list     : Integer_Vectors.Vector; -- ordered list of tile ids 
  170.             matlist  : Matrix_Vectors.Vector;  -- ordered list of tile matrices 
  171.             loadlist : A_Tile_Queue;           -- list of remaining tiles to load 
  172.         end record; 
  173.  
  174.     function A_Tile_Index_Input( stream : access Root_Stream_Type'Class ) return A_Tile_Index; 
  175.     for A_Tile_Index'Input use A_Tile_Index_Input; 
  176.  
  177.     procedure A_Tile_Index_Output( stream : access Root_Stream_Type'Class; index : A_Tile_Index ); 
  178.     for A_Tile_Index'Write use A_Tile_Index_Output; 
  179.     for A_Tile_Index'Output use A_Tile_Index_Output; 
  180.  
  181. end Tiles.Indices;