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.     type Boolean_Array is array (Positive range <>) of Boolean; 
  47.  
  48.     ---------------------------------------------------------------------------- 
  49.  
  50.     -- A Map_Object is layered, two-dimensional grid of tile ids used by Worlds. 
  51.     -- It's composed of a stack of Layers of identical dimensions. To get and 
  52.     -- set tile ids in the map, locations must be addressed by coordinates 
  53.     -- (layer, x, y). All coordinates start at 1. Layer 1 is the most background 
  54.     -- layer, ie: the furthest away in the z-order. The number of layers in a 
  55.     -- map is determined at construction. 
  56.     type Map_Object is new Object with private; 
  57.     type A_Map is access all Map_Object'Class; 
  58.  
  59.     -- Creates a new empty map with the given dimensions. The 'physical' array 
  60.     -- determines which layers are physical (interact with entities) and also 
  61.     -- the number of layers. An exception is raised if the dimensions are too 
  62.     -- large. 
  63.     function Create_Map( width, 
  64.                          height   : Positive; 
  65.                          physical : Boolean_Array ) return A_Map; 
  66.     pragma Precondition( physical'Length > 0 ); 
  67.     pragma Postcondition( Create_Map'Result /= null ); 
  68.  
  69.     -- Returns the map's height in tiles. 
  70.     function Get_Height( this : not null access Map_Object'Class ) return Positive; 
  71.     pragma Postcondition( Get_Height'Result <= MAX_HEIGHT ); 
  72.  
  73.     -- Returns the number of layers in the map. 
  74.     function Get_Layers( this : not null access Map_Object'Class ) return Positive; 
  75.  
  76.     -- Returns a pointer to the layer data owned by the map. Do not modify the 
  77.     -- contents. 
  78.     function Get_Layers_Data( this : not null access Map_Object'Class ) return A_Layer_Array; 
  79.     pragma Postcondition( Get_Layers_Data'Result /= null ); 
  80.  
  81.     -- Returns the id of a tile in the map. If the location is not on the map 
  82.     -- then 0 will be returned. 
  83.     function Get_Tile_Id( this  : not null access Map_Object'Class; 
  84.                           layer : Positive; 
  85.                           x, y  : Integer ) return Natural; 
  86.  
  87.     -- Returns the width of the map in tiles. 
  88.     function Get_Width( this : not null access Map_Object'Class ) return Positive; 
  89.     pragma Postcondition( Get_Width'Result <= MAX_WIDTH ); 
  90.  
  91.     function Object_Input( stream : access Root_Stream_Type'Class ) return Map_Object; 
  92.     for Map_Object'Input use Object_Input; 
  93.  
  94.     -- Resizes the map. If the new size is larger in a dimension, the new space 
  95.     -- will be filled with tile id 0. If the new size is smaller in a dimension, 
  96.     -- the right and bottom edges will be clipped down to the new size. An 
  97.     -- exception will be raised if new dimensions are too large. 
  98.     procedure Resize( this   : not null access Map_Object'Class; 
  99.                       width, 
  100.                       height : Positive ); 
  101.  
  102.     -- Sets the tile id at a location in the map. If the location doesn't exist, 
  103.     -- nothing will happen. 
  104.     procedure Set_Tile( this  : not null access Map_Object'Class; 
  105.                         layer : Positive; 
  106.                         x, y  : Integer; 
  107.                         tile  : Natural ); 
  108.  
  109.     -- Returns the width of tiles in the map in pixels. 
  110.     function Tile_Width( this : not null access Map_Object'Class ) return Positive; 
  111.  
  112.     -- Returns a deep copy of the map. 
  113.     function Copy( src : A_Map ) return A_Map; 
  114.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  115.  
  116.     -- Deletes the map. 
  117.     procedure Delete( this : in out A_Map ); 
  118.     pragma Postcondition( this = null ); 
  119.  
  120. private 
  121.  
  122.     MAX_WIDTH  : constant Positive := 1024; 
  123.     MAX_HEIGHT : constant Positive := 1024; 
  124.  
  125.     type Map_Object is new Object with 
  126.         record 
  127.             width, 
  128.             height : Positive := 1; 
  129.             layers : A_Layer_Array := null; 
  130.         end record; 
  131.  
  132.     procedure Adjust( this : access Map_Object ); 
  133.  
  134.     procedure Construct( this     : access Map_Object; 
  135.                          width, 
  136.                          height   : Positive; 
  137.                          physical : Boolean_Array ); 
  138.  
  139.     procedure Delete( this : in out Map_Object ); 
  140.  
  141.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Map_Object ); 
  142.     for Map_Object'Read use Object_Read; 
  143.  
  144.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Map_Object ); 
  145.     for Map_Object'Write use Object_Write; 
  146.  
  147.     ---------------------------------------------------------------------------- 
  148.  
  149.     function A_Map_Input( stream : access Root_Stream_Type'Class ) return A_Map; 
  150.     for A_Map'Input use A_Map_Input; 
  151.  
  152.     procedure A_Map_Output( stream : access Root_Stream_Type'Class; map : A_Map ); 
  153.     for A_Map'Output use A_Map_Output; 
  154.  
  155.     procedure A_Map_Read( stream : access Root_Stream_Type'Class; map : out A_Map ); 
  156.     for A_Map'Read use A_Map_Read; 
  157.  
  158.     procedure A_Map_Write( stream : access Root_Stream_Type'Class; map : A_Map ); 
  159.     for A_Map'Write use A_Map_Write; 
  160.  
  161.     ---------------------------------------------------------------------------- 
  162.  
  163.     function A_Layer_Input( stream : access Root_Stream_Type'Class ) return A_Layer; 
  164.     for A_Layer'Input use A_Layer_Input; 
  165.  
  166.     procedure A_Layer_Output( stream : access Root_Stream_Type'Class; lyr : A_Layer ); 
  167.     for A_Layer'Output use A_Layer_Output; 
  168.  
  169.     ---------------------------------------------------------------------------- 
  170.  
  171.     function A_Layer_Array_Input( stream : access Root_Stream_Type'Class ) return A_Layer_Array; 
  172.     for A_Layer_Array'Input use A_Layer_Array_Input; 
  173.  
  174.     procedure A_Layer_Array_Output( stream : access Root_Stream_Type'Class; la : A_Layer_Array ); 
  175.     for A_Layer_Array'Output use A_Layer_Array_Output; 
  176.  
  177. end Maps;