--
-- 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.Catalogs is
-- A Catalog indexes and organizes all the Tiles in a Tile_Library. It is
-- stored inside a tile library as a catalog file, alongside all the bitmap
-- files. In addition to indexing tiles, it indexes tile matrices for
-- repeated tile patterns and large, multi-tile objects.
type Catalog is new Object with private;
type A_Catalog is access all Catalog'Class;
-- Creates a new empty tile catalog.
function Create_Catalog return A_Catalog;
pragma Postcondition( Create_Catalog'Result /= null );
-- Adds a new tile matrix to the catalog. 'matrix' will be consumed.
procedure Add_Matrix( this : not null access Catalog'Class;
matrix : in out A_Tile_Matrix );
pragma Precondition( matrix /= null );
pragma Postcondition( matrix = null );
-- Adds a new tile to the catalog. 'tile' is consumed. If 'tile' is passed
-- as null, an empty tile slot 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 catalog.
procedure Add_Tile( this : not null access Catalog'Class;
tile : in out A_Tile );
pragma Postcondition( tile = null );
-- Finds a tile with a name matching 'name' and returns a reference. The
-- tile with the first matching name will be returned. If 'name' does not
-- include a file extension, a matching .png file will be searched first,
-- then a matching .bmp file. Do not modify the tile; it belongs to the
-- catalog. Null will be returned if no tile is not found.
function Find_Tile( this : not null access Catalog'Class;
name : String ) return A_Tile;
pragma Precondition( name'Length > 0 );
-- Returns a reference to a matrix in the catalog by index, base 1. The
-- index is determined by the order in which the matrices were added. If
-- there is no matrix at 'index' then null will be returned.
function Get_Matrix( this : not null access Catalog'Class;
index : Natural ) return A_Tile_Matrix;
-- Returns the number of matrices in the catalog.
function Get_Matrix_Count( this : not null access Catalog'Class ) return Natural;
-- Returns a tile reference by id, base 1. Do not modify the tile; it
-- belongs to the catalog. Null will be returned if the id is not found.
function Get_Tile( this : not null access Catalog'Class;
id : Natural ) return A_Tile;
-- Iterates across all the tiles in the catalog by order of ascending id.
procedure Iterate_By_Id( this : not null access Catalog'Class;
examine : not null access procedure( tile : not null A_Tile ) );
-- Iterates across all the tile slots in the catalog, beginning with 1. Not
-- every slot contains a tile, so the 'tile' argument of 'examine' may be
-- null.
procedure Iterate_By_Slot( this : not null access Catalog'Class;
examine : not null access procedure( slot : Positive;
tile : A_Tile ) );
function Object_Input( stream : access Root_Stream_Type'Class ) return Catalog;
for Catalog'Input use Object_Input;
procedure Object_Output( stream : access Root_Stream_Type'Class; obj : Catalog );
for Catalog'Output use Object_Output;
-- Deletes the Catalog and all the Tiles it currently contains.
procedure Delete( this : in out A_Catalog );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- Returns the version number of the tile catalog's stream format. Different
-- version numbers are incompatible.
function Catalog_Format_Version return Natural;
-- raised on attempt to add a tile with a duplicate id
DUPLICATE_TILE : exception;
private
use Ada.Containers;
function Integer_Hash is new Ada.Unchecked_Conversion( Integer, Hash_Type );
package Tile_Maps is new Ada.Containers.Hashed_Maps( Integer, A_Tile, Integer_Hash, "=", "=" );
package Tile_Vectors is new Ada.Containers.Vectors( Positive, A_Tile, "=" );
package Matrix_Vectors is new Ada.Containers.Vectors( Positive, A_Tile_Matrix, "=" );
type Catalog is new Object with
record
idMap : Tile_Maps.Map; -- mapping of id numbers to tiles
slotArray : Tile_Vectors.Vector; -- array of tiles as slots (sparse collection)
matArray : Matrix_Vectors.Vector; -- array of tile matrices
end record;
-- Raises COPY_NOT_ALLOWED.
procedure Adjust( this : access Catalog );
procedure Delete( this : in out Catalog );
-- Reads the contents of a Catalog from a stream.
procedure Object_Read( stream : access Root_Stream_Type'Class;
obj : out Catalog );
for Catalog'Read use Object_Read;
-- WRites the contents of a Catalog to a stream.
procedure Object_Write( stream : access Root_Stream_Type'Class;
obj : Catalog );
for Catalog'Write use Object_Write;
----------------------------------------------------------------------------
-- Verifies a file format header before reading the Catalog representation.
-- If the header is invalid, READ_EXCEPTION will be raised. Raises an
-- exception on streaming error.
function A_Catalog_Input( stream : access Root_Stream_Type'Class ) return A_Catalog;
for A_Catalog'Input use A_Catalog_Input;
-- Writes a file format header and then the Catalog representation.
procedure A_Catalog_Output( stream : access Root_Stream_Type'Class;
obj : A_Catalog );
for A_Catalog'Output use A_Catalog_Output;
-- Reads the Catalog tag and instantiates it. A Constraint_Error will be
-- raised if the class is unknown. Raises an exception on streaming error.
procedure A_Catalog_Read( stream : access Root_Stream_Type'Class;
obj : out A_Catalog );
for A_Catalog'Read use A_Catalog_Read;
-- Writes the Catalog tag and object contents.
procedure A_Catalog_Write( stream : access Root_Stream_Type'Class;
obj : A_Catalog );
for A_Catalog'Write use A_Catalog_Write;
end Tiles.Catalogs;