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.Streams;                       use Ada.Streams; 
  10. with Objects;                           use Objects; 
  11.  
  12. package Maps is 
  13.  
  14.     -- Maximum supported map dimensions 
  15.     MAX_WIDTH  : constant Positive; 
  16.     MAX_HEIGHT : constant Positive; 
  17.  
  18.     ---------------------------------------------------------------------------- 
  19.  
  20.     -- A one dimensional array of tiles for a map layer 
  21.     type Layer_Data is array(Positive range <>) of Natural; 
  22.  
  23.     -- A single map layer, where 'size' is the number of tiles in the layer. 
  24.     type Layer(size : Positive) is 
  25.         record 
  26.             physical : Boolean := False;     -- entities should clip to layer 
  27.             data     : Layer_Data(1..size);  -- tile ids (size = width * height) 
  28.         end record; 
  29.     type A_Layer is access all Layer; 
  30.  
  31.     -- An array of map layers. All layers are expected to be the same size. 
  32.     type Layer_Array is array (Positive range <>) of A_Layer; 
  33.     type A_Layer_Array is access all Layer_Array; 
  34.  
  35.     -- Returns a deep copy of a layer array. 
  36.     function Copy( src : A_Layer_Array ) return A_Layer_Array; 
  37.  
  38.     -- Deep deletes a layer array. 
  39.     procedure Delete( la : in out A_Layer_Array ); 
  40.  
  41.     -- Moves a layer array reference. If 'dst' is not null it will be deleted. 
  42.     procedure Move( dst, src : in out A_Layer_Array ); 
  43.     pragma Postcondition( src = null ); 
  44.     pragma Postcondition( dst = src'Old ); 
  45.  
  46.     ---------------------------------------------------------------------------- 
  47.  
  48.     -- A Map_Object is layered, two-dimensional grid of tile ids used by Worlds. 
  49.     -- It's composed of a stack of Layers of identical dimensions. To get and 
  50.     -- set tile ids in the map, locations must be addressed by coordinates 
  51.     -- (layer, x, y). All coordinates start at 1. Layer 1 is the most background 
  52.     -- layer, ie: the furthest away in the z-order. The number of layers in a 
  53.     -- map is a constant, determined at construction by the concrete Map 
  54.     -- subclass. 
  55.     type Map_Object is abstract new Object with private; 
  56.     type A_Map is access all Map_Object'Class; 
  57.  
  58.     -- Creates a new empty map with the given dimensions. The registered 
  59.     -- allocator will determine the concrete class of the map and how many 
  60.     -- layers it will have. An exception is raised if the dimensions are too large. 
  61.     function Create_Map( width, height : Positive ) return A_Map; 
  62.     pragma Postcondition( Create_Map'Result /= null ); 
  63.  
  64.     -- Returns the map's height in tiles. 
  65.     function Get_Height( this : not null access Map_Object'Class ) return Positive; 
  66.     pragma Postcondition( Get_Height'Result <= MAX_HEIGHT ); 
  67.  
  68.     -- Returns the number of layers in the map. 
  69.     function Get_Layers( this : not null access Map_Object'Class ) return Positive; 
  70.  
  71.     -- Returns a pointer to the layer data owned by the map. Do not modify the 
  72.     -- contents. 
  73.     function Get_Layers_Data( this : not null access Map_Object'Class ) return A_Layer_Array; 
  74.     pragma Postcondition( Get_Layers_Data'Result /= null ); 
  75.  
  76.     -- Returns the id of a tile in the map. If the location is not on the map 
  77.     -- then 0 will be returned. 
  78.     function Get_Tile_Id( this  : not null access Map_Object'Class; 
  79.                           layer : Positive; 
  80.                           x, y  : Integer ) return Natural; 
  81.  
  82.     -- Returns the width of the map in tiles. 
  83.     function Get_Width( this : not null access Map_Object'Class ) return Positive; 
  84.     pragma Postcondition( Get_Width'Result <= MAX_WIDTH ); 
  85.  
  86.     -- All concrete Map classes must implement this to be read from streams. 
  87.     function Object_Input( stream : access Root_Stream_Type'Class ) return Map_Object is abstract; 
  88.  
  89.     -- Resizes the map. If the new size is larger in a dimension, the new space 
  90.     -- will be filled with tile id 0. If the new size is smaller in a dimension, 
  91.     -- the right and bottom edges will be clipped down to the new size. An 
  92.     -- exception will be raised if new dimensions are too large. 
  93.     procedure Resize( this   : not null access Map_Object'Class; 
  94.                       width, 
  95.                       height : Positive ); 
  96.  
  97.     -- Sets the tile id at a location in the map. If the location doesn't exist, 
  98.     -- nothing will happen. 
  99.     procedure Set_Tile( this  : not null access Map_Object'Class; 
  100.                         layer : Positive; 
  101.                         x, y  : Integer; 
  102.                         tile  : Natural ); 
  103.  
  104.     -- Returns the width of tiles in the map in pixels. 
  105.     function Tile_Width( this : not null access Map_Object'Class ) return Positive; 
  106.  
  107.     -- Returns a deep copy of the map. 
  108.     function Copy( src : A_Map ) return A_Map; 
  109.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  110.  
  111.     -- Deletes the map. 
  112.     procedure Delete( this : in out A_Map ); 
  113.     pragma Postcondition( this = null ); 
  114.  
  115. private 
  116.  
  117.     MAX_WIDTH  : constant Positive := 1024; 
  118.     MAX_HEIGHT : constant Positive := 1024; 
  119.  
  120.     type Map_Object is abstract new Object with 
  121.         record 
  122.             width, 
  123.             height : Positive := 1; 
  124.             layers : A_Layer_Array := null; 
  125.         end record; 
  126.  
  127.     procedure Adjust( this : access Map_Object ); 
  128.  
  129.     procedure Construct( this   : access Map_Object; 
  130.                          width, 
  131.                          height, 
  132.                          layers : Positive ); 
  133.  
  134.     procedure Delete( this : in out Map_Object ); 
  135.  
  136.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Map_Object ); 
  137.     for Map_Object'Read use Object_Read; 
  138.  
  139.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Map_Object ); 
  140.     for Map_Object'Write use Object_Write; 
  141.  
  142.     ---------------------------------------------------------------------------- 
  143.  
  144.     function A_Map_Input( stream : access Root_Stream_Type'Class ) return A_Map; 
  145.     for A_Map'Input use A_Map_Input; 
  146.  
  147.     procedure A_Map_Output( stream : access Root_Stream_Type'Class; map : A_Map ); 
  148.     for A_Map'Output use A_Map_Output; 
  149.  
  150.     procedure A_Map_Read( stream : access Root_Stream_Type'Class; map : out A_Map ); 
  151.     for A_Map'Read use A_Map_Read; 
  152.  
  153.     procedure A_Map_Write( stream : access Root_Stream_Type'Class; map : A_Map ); 
  154.     for A_Map'Write use A_Map_Write; 
  155.  
  156.     ---------------------------------------------------------------------------- 
  157.  
  158.     -- Deletes the Layer. 
  159.     procedure Delete( lyr : in out A_Layer ); 
  160.  
  161.     function A_Layer_Input( stream : access Root_Stream_Type'Class ) return A_Layer; 
  162.     for A_Layer'Input use A_Layer_Input; 
  163.  
  164.     procedure A_Layer_Output( stream : access Root_Stream_Type'Class; lyr : A_Layer ); 
  165.     for A_Layer'Output use A_Layer_Output; 
  166.  
  167.     ---------------------------------------------------------------------------- 
  168.  
  169.     function A_Layer_Array_Input( stream : access Root_Stream_Type'Class ) return A_Layer_Array; 
  170.     for A_Layer_Array'Input use A_Layer_Array_Input; 
  171.  
  172.     procedure A_Layer_Array_Output( stream : access Root_Stream_Type'Class; la : A_Layer_Array ); 
  173.     for A_Layer_Array'Output use A_Layer_Array_Output; 
  174.  
  175.     ---------------------------------------------------------------------------- 
  176.  
  177.     -- An allocator function for creating a new Map. 
  178.     type Allocator is access function( width, height : Positive ) return A_Map; 
  179.  
  180.     -- Registers the allocator used to create new Map instances. 
  181.     procedure Register_Allocator( allocate : not null Allocator ); 
  182.  
  183. end Maps;