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