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 := 1024; 
  8.     MAX_HEIGHT : constant := 1024; 
  9.  
  10.     ---------------------------------------------------------------------------- 
  11.  
  12.     -- one dimensional array of tiles in a map layer 
  13.     type Layer_Data is array(Natural range <>) of Natural; 
  14.  
  15.     -- a map layer, where size is the number of tiles in the layer (w * h) 
  16.     type Layer(size : Natural) is 
  17.         record 
  18.             physical : Boolean := False;     -- entities should clip to layer 
  19.             data     : Layer_Data(1..size);  -- tile ids 
  20.         end record; 
  21.     type A_Layer is access all Layer; 
  22.  
  23.     type Layer_Array is array (Natural range <>) of A_Layer; 
  24.     type A_Layer_Array is access all Layer_Array; 
  25.  
  26.     function Copy( src : A_Layer_Array ) return A_Layer_Array; 
  27.  
  28.     procedure Delete( la : in out A_Layer_Array ); 
  29.  
  30.     procedure Move( dst, src : in out A_Layer_Array ); 
  31.  
  32.     ---------------------------------------------------------------------------- 
  33.  
  34.     type Map_Object is abstract new Object with private; 
  35.     type A_Map is access all Map_Object'Class; 
  36.  
  37.     -- Raises exception if map size is unsupported. 
  38.     function Create_Map( width, height : Positive ) return A_Map; 
  39.     pragma Postcondition( Create_Map'Result /= null ); 
  40.  
  41.     -- Returns the map's height in tiles. 
  42.     function Get_Height( this : not null access Map_Object'Class ) return Positive; 
  43.  
  44.     -- Returns the number of layers in the map. 
  45.     function Get_Layers( this : not null access Map_Object'Class ) return Natural; 
  46.  
  47.     -- Returns a pointer to the layer data owned by the map. Do not modify the 
  48.     -- contents. 
  49.     function Get_Layers_Data( this : access Map_Object ) return A_Layer_Array; 
  50.     pragma Postcondition( Get_Layers_Data'Result /= null ); 
  51.  
  52.     -- Returns the id of a tile in the map. 
  53.     function Get_Tile_Id( this  : not null access Map_Object'Class; 
  54.                           layer, 
  55.                           x, y  : Integer ) return Natural; 
  56.  
  57.     -- Returns the width of the map in tiles. 
  58.     function Get_Width( this : not null access Map_Object'Class ) return Positive; 
  59.  
  60.     function Object_Input( stream : access Root_Stream_Type'Class ) return Map_Object is abstract; 
  61.  
  62.     procedure Object_Output( stream : access Root_Stream_Type'Class; obj : Map_Object ) is abstract; 
  63.  
  64.     -- Raises an exception if map size is unsupported. 
  65.     procedure Resize( this   : not null access Map_Object'Class; 
  66.                       width, 
  67.                       height : Positive ); 
  68.  
  69.     -- Sets the tile id at a location in the map. 
  70.     procedure Set_Tile( this  : access Map_Object; 
  71.                         layer : Integer; 
  72.                         x, y  : Integer; 
  73.                         tile  : Natural ); 
  74.  
  75.     -- Returns the width of tiles in the map in pixels. 
  76.     function Tile_Width( this : not null access Map_Object'Class ) return Positive; 
  77.  
  78.     -- Returns a deep copy of the map. 
  79.     function Copy( src : A_Map ) return A_Map; 
  80.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  81.  
  82.     -- Deletes the map. 
  83.     procedure Delete( this : in out A_Map ); 
  84.     pragma Postcondition( this = null ); 
  85.  
  86. private 
  87.  
  88.     type Map_Object is abstract new Object with 
  89.         record 
  90.             width, 
  91.             height : Positive := 1; 
  92.             layers : A_Layer_Array := null; 
  93.         end record; 
  94.  
  95.     procedure Adjust( this : access Map_Object ); 
  96.  
  97.     procedure Construct( this   : access Map_Object; 
  98.                          width, 
  99.                          height, 
  100.                          layers : Positive ); 
  101.  
  102.     procedure Delete( this : in out Map_Object ); 
  103.  
  104.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Map_Object ); 
  105.     for Map_Object'Read use Object_Read; 
  106.  
  107.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Map_Object ); 
  108.     for Map_Object'Write use Object_Write; 
  109.  
  110.     ---------------------------------------------------------------------------- 
  111.  
  112.     function A_Map_Input( stream : access Root_Stream_Type'Class ) return A_Map; 
  113.     for A_Map'Input use A_Map_Input; 
  114.  
  115.     procedure A_Map_Output( stream : access Root_Stream_Type'Class; map : A_Map ); 
  116.     for A_Map'Output use A_Map_Output; 
  117.  
  118.     procedure A_Map_Read( stream : access Root_Stream_Type'Class; map : out A_Map ); 
  119.     for A_Map'Read use A_Map_Read; 
  120.  
  121.     procedure A_Map_Write( stream : access Root_Stream_Type'Class; map : A_Map ); 
  122.     for A_Map'Write use A_Map_Write; 
  123.  
  124.     ---------------------------------------------------------------------------- 
  125.  
  126.     procedure Delete( lyr : in out A_Layer ); 
  127.  
  128.     function A_Layer_Input( stream : access Root_Stream_Type'Class ) return A_Layer; 
  129.     for A_Layer'Input use A_Layer_Input; 
  130.  
  131.     procedure A_Layer_Output( stream : access Root_Stream_Type'Class; lyr : A_Layer ); 
  132.     for A_Layer'Output use A_Layer_Output; 
  133.  
  134.     ---------------------------------------------------------------------------- 
  135.  
  136.     function A_Layer_Array_Input( stream : access Root_Stream_Type'Class ) return A_Layer_Array; 
  137.     for A_Layer_Array'Input use A_Layer_Array_Input; 
  138.  
  139.     procedure A_Layer_Array_Output( stream : access Root_Stream_Type'Class; la : A_Layer_Array ); 
  140.     for A_Layer_Array'Output use A_Layer_Array_Output; 
  141.  
  142.     ---------------------------------------------------------------------------- 
  143.  
  144.     type Allocator is access function( width, height : Positive ) return A_Map; 
  145.  
  146.     procedure Register_Allocator( allocate : not null Allocator ); 
  147.  
  148. end Maps;