--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
with Tiles.Matrices; use Tiles.Matrices;
private with Ada.Containers;
private with Ada.Containers.Hashed_Maps;
private with Ada.Containers.Vectors;
private with Ada.Unchecked_Conversion;
private package Tiles.Indices is
-- A Tile_Index indexes and organizes all the Tiles in a Tile_Library. It is
-- stored in a tile library as a separate index file, alongside all the
-- included bitmaps. In addition to indexing tiles by id, it contains
-- tile matrices for repeated tile patterns and large multi-tile objects.
type Tile_Index is private;
type A_Tile_Index is access all Tile_Index;
pragma No_Strict_Aliasing( A_Tile_Index );
-- Creates a new empty tile index.
function Create_Tile_Index return A_Tile_Index;
pragma Postcondition( Create_Tile_Index'Result /= null );
-- Loads a tile index from an archive. Null will be returned if an error
-- occurs.
function Load_Index( archive : not null A_Archive;
filename : String ) return A_Tile_Index;
pragma Postcondition( filename'Length > 0 );
-- Adds a new tile matrix to the index. 'matrix' will be consumed.
procedure Add_Matrix( index : not null A_Tile_Index; matrix : in out A_Tile_Matrix );
pragma Precondition( matrix /= null );
pragma Postcondition( matrix = null );
-- Adds a new tile to the index. 'tile' is consumed. If 'tile' is passed as
-- null, a null tile is added to the tile list as a place holder. The
-- exception DUPLICATE_TILE will be raised if a tile with the same id
-- already exists in the index.
procedure Add_Tile( index : not null A_Tile_Index; tile : in out A_Tile );
pragma Postcondition( tile = null );
-- Deletes a tile index.
procedure Delete( index : in out A_Tile_Index );
pragma Postcondition( index = null );
-- Returns a reference to a matrix in the index by ordinal number, base 1.
-- If there is no matrix for 'num' then null will be returned.
function Get_Matrix( index : not null A_Tile_Index; num : Natural ) return A_Tile_Matrix;
-- Returns the number of matrices in the index.
function Get_Matrix_Count( index : not null A_Tile_Index ) return Natural;
-- Returns the load completion for the index in the range of 0..100
function Get_Progress( index : not null A_Tile_Index ) return Natural;
pragma Postcondition( Get_Progress'Result <= 100 );
-- Returns the slot number of a tile by id. The slot is determined by the
-- order of the tiles in the index. The first tile is at slot 1. Zero will
-- be returned if 'id' is not found in the index.
function Get_Slot( index : not null A_Tile_Index; id : Natural ) return Natural;
-- Returns a tile reference by tile id, base 1. Do not modify the tile; it
-- belongs to the index. Null will be returned if the tile is not found.
function Get_Tile( index : not null A_Tile_Index; id : Natural ) return A_Tile;
-- Returns a tile reference by name. Do not modify the tile, it belongs to
-- the index. Null will be returned if the tile is not found.
function Get_Tile( index : not null A_Tile_Index; name : String ) return A_Tile;
pragma Precondition( name'Length > 0 );
-- Returns a tile reference by slot number, base 1. Do not modify the tile;
-- it belongs to the index. Null will be returned if the tile is not found.
function Get_Tile_At_Slot( index : not null A_Tile_Index;
slot : Natural ) return A_Tile;
-- Returns the number of tiles in the index.
function Get_Tile_Count( index : not null A_Tile_Index ) return Natural;
-- Iterates across the tiles in the index by order of listing, from first
-- to last.
procedure Iterate_Tiles( index : not null A_Tile_Index;
examine : not null access procedure( tile : A_Tile ) );
-- Indicates to the index that all tiles have been loaded. This will unblock
-- any threads waiting for the index to be fully loaded.
procedure Load_Complete( index : not null A_Tile_Index );
-- Loads all the bitmaps for all the tiles in the index.
procedure Load_Images( index : not null A_Tile_Index;
archive : not null A_Archive );
-- Prioritizes a tile to be loaded before non-priority tiles.
procedure Prioritize_Tile( index : not null A_Tile_Index; tile : not null A_Tile );
-- Writes the index to a file on disk, returning True on success.
function Write_Index( index : not null A_Tile_Index;
filename : String ) return Boolean;
pragma Precondition( filename'Length > 0 );
----------------------------------------------------------------------------
-- Returns the file extension for tile index tiles, without a leading dot.
function Index_Extension return String;
pragma Postcondition( Index_Extension'Result'Length > 0 );
-- Returns a string that identifies the tile index file format. It is the
-- first data found in the file.
function Index_Identifier return String;
pragma Postcondition( Index_Identifier'Result'Length > 0 );
-- raised on attempt to add a tile with a duplicate id
DUPLICATE_TILE : exception;
private
use Ada.Containers;
-- Queue of tiles remaining to be loaded. Loading can be prioritized.
protected type Tile_Queue is
-- Adds to the end of the list. when the library index is read, all
-- tiles are added to the back of the queue. This is used to keep track
-- of the total number of tiles that must be loaded.
procedure Add_Back( tile : not null A_Tile );
-- Returns a loaded percentage in the range of 0..100
function Get_Progress return Natural;
pragma Postcondition( Get_Progress'Result <= 100 );
-- Prioritizes the loading of the tile by adding it to the front of the
-- queue. It should already have been added to the back of the queue.
procedure Prioritize( tile : not null A_Tile );
-- Removes and returns first in the list.
procedure Remove( tile : out A_Tile );
-- Clears queue and stops accepting tiles.
procedure Stop;
private
queue : Tile_Lists.List;
total : Natural := 0; -- total number of unique tiles to load
loaded : Natural := 0; -- number of tiles loaded so far
stopped : Boolean := False;
end Tile_Queue;
type A_Tile_Queue is access all Tile_Queue;
-- Deletes the Tile_Queue.
procedure Delete( queue : in out A_Tile_Queue );
pragma Postcondition( queue = null );
----------------------------------------------------------------------------
function Hash is new Ada.Unchecked_Conversion( Integer, Hash_Type );
package Integer_Vectors is new Ada.Containers.Vectors( Positive, Natural, "=" );
package Matrix_Vectors is new Ada.Containers.Vectors( Positive, A_Tile_Matrix, "=" );
package Tile_Maps is new Ada.Containers.Hashed_Maps( Integer, A_Tile, Hash, "=", "=" );
type Tile_Index is
record
idmap : Tile_Maps.Map; -- mapping of id numbers to tiles
list : Integer_Vectors.Vector; -- ordered list of tile ids
matlist : Matrix_Vectors.Vector; -- ordered list of tile matrices
loadlist : A_Tile_Queue; -- list of remaining tiles to load
end record;
function A_Tile_Index_Input( stream : access Root_Stream_Type'Class ) return A_Tile_Index;
for A_Tile_Index'Input use A_Tile_Index_Input;
procedure A_Tile_Index_Output( stream : access Root_Stream_Type'Class; index : A_Tile_Index );
for A_Tile_Index'Write use A_Tile_Index_Output;
for A_Tile_Index'Output use A_Tile_Index_Output;
end Tiles.Indices;