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 Events; 
  10. with Maps;                              use Maps; 
  11. with Values;                            use Values; 
  12.  
  13. pragma Elaborate_All( Events ); 
  14.  
  15. package Events.World is 
  16.  
  17.     CREATE_WORLD_ID : constant Event_Id := To_Event_Id( "Create_World" ); 
  18.  
  19.     -- A command to create a new, empty world. 
  20.     type Create_World_Event is new Event with private; 
  21.     type A_Create_World_Event is access all Create_World_Event'Class; 
  22.  
  23.     -- Returns the domain of the world to create (map, platform, etc.) 
  24.     function Get_Domain( this : not null access Create_World_Event'Class ) return String; 
  25.     pragma Postcondition( Get_Domain'Result'Length > 0 ); 
  26.  
  27.     -- Returns the height of the new world in tiles. 
  28.     function Get_Height( this : not null access Create_World_Event'Class ) return Positive; 
  29.  
  30.     -- Returns the name of the library to be used for tiles. 
  31.     function Get_Library_Name( this : not null access Create_World_Event'Class ) return String; 
  32.     pragma Postcondition( Get_Library_Name'Result'Length > 0 ); 
  33.  
  34.     -- Returns the width of the new world in tiles. 
  35.     function Get_Width( this : not null access Create_World_Event'Class ) return Positive; 
  36.  
  37.     ---------------------------------------------------------------------------- 
  38.  
  39.     LOAD_WORLD_ID : constant Event_Id := To_Event_Id( "Load_World" ); 
  40.  
  41.     -- A command to load a world from disk. 
  42.     type Load_World_Event is new Event with private; 
  43.     type A_Load_World_Event is access all Load_World_Event'Class; 
  44.  
  45.     -- Returns the filename of the world to load. 
  46.     function Get_Filename( this : not null access Load_World_Event'Class ) return String; 
  47.  
  48.     ---------------------------------------------------------------------------- 
  49.  
  50.     WORLD_LOADED_ID : constant Event_Id := To_Event_Id( "World_Loaded" ); 
  51.  
  52.     -- A notification that a world has been loaded/created/resized. 
  53.     type World_Loaded_Event is new Event with private; 
  54.     type A_World_Loaded_Event is access all World_Loaded_Event'Class; 
  55.  
  56.     -- Returns the height of the world in tiles. 
  57.     function Get_Height( this : not null access World_Loaded_Event'Class ) return Positive; 
  58.  
  59.     -- Returns the world map as an array of tile layers. 
  60.     function Get_Layers( this : not null access World_Loaded_Event'Class ) return A_Layer_Array; 
  61.     pragma Postcondition( Get_Layers'Result /= null ); 
  62.  
  63.     -- Returns the name of the library used for tiles. 
  64.     function Get_Library_Name( this : not null access World_Loaded_Event'Class ) return String; 
  65.     pragma Postcondition( Get_Library_Name'Result'Length > 0 ); 
  66.  
  67.     -- Returns the width of a tile in the world in pixels. 
  68.     function Get_Tile_Width( this : not null access World_Loaded_Event'Class ) return Positive; 
  69.  
  70.     -- Returns the width of the world in tiles. 
  71.     function Get_Width( this : not null access World_Loaded_Event'Class ) return Positive; 
  72.  
  73.     ---------------------------------------------------------------------------- 
  74.  
  75.     -- A command to set the value of a world property. 
  76.     SET_WORLD_PROPERTY_ID : constant Event_Id := To_Event_Id( "Set_World_Property" ); 
  77.  
  78.     -- A notification that a world property changed. 
  79.     WORLD_PROPERTY_CHANGED_ID : constant Event_Id := To_Event_Id( "World_Property_Changed" ); 
  80.  
  81.     -- An event involving a world property value. 
  82.     type World_Property_Event is new Event with private; 
  83.     type A_World_Property_Event is access all World_Property_Event'Class; 
  84.  
  85.     -- Returns the name of the property. 
  86.     function Get_Property_Name( this : not null access World_Property_Event'Class ) return String; 
  87.     pragma Postcondition( Get_Property_Name'Result'Length > 0 ); 
  88.  
  89.     -- Returns the property's value. 
  90.     function Get_Value( this : not null access World_Property_Event'Class ) return Value_Ptr; 
  91.     pragma Postcondition( Get_Value'Result /= Values.Nul ); 
  92.  
  93.     ---------------------------------------------------------------------------- 
  94.  
  95.     RESIZE_WORLD_ID : constant Event_Id := To_Event_Id( "Resize_World" ); 
  96.  
  97.     -- A command to resize the world map. 
  98.     type Resize_World_Event is new Event with private; 
  99.     type A_Resize_World_Event is access all Resize_World_Event'Class; 
  100.  
  101.     -- Returns the new height of the map in tiles. 
  102.     function Get_Height( this : not null access Resize_World_Event'Class ) return Positive; 
  103.  
  104.     -- Returns the new width of the map in tiles. 
  105.     function Get_Width( this : not null access Resize_World_Event'Class ) return Positive; 
  106.  
  107.     ---------------------------------------------------------------------------- 
  108.  
  109.     SET_TILE_ID : constant Event_Id := To_Event_Id( "Set_Tile" ); 
  110.  
  111.     -- A command to set the tile id at a specific location. 
  112.     type Set_Tile_Event is new Event with private; 
  113.     type A_Set_Tile_Event is access all Set_Tile_Event'Class; 
  114.  
  115.     -- Returns the layer of the tile to set. 
  116.     function Get_Layer( this : not null access Set_Tile_Event'Class ) return Integer; 
  117.  
  118.     -- Returns new tile id to set. 
  119.     function Get_Tile_ID( this : not null access Set_Tile_Event'Class ) return Natural; 
  120.  
  121.     -- Returns the X coordinate of the tile to set. 
  122.     function Get_X( this : not null access Set_Tile_Event'Class ) return Float; 
  123.  
  124.     -- Returns the Y coordinate of the tile to set. 
  125.     function Get_Y( this : not null access Set_Tile_Event'Class ) return Float; 
  126.  
  127.     ---------------------------------------------------------------------------- 
  128.  
  129.     TILE_CHANGED_ID : constant Event_Id := To_Event_Id( "Tile_Changed" ); 
  130.  
  131.     -- A notification that a tile in the map changed. 
  132.     type Tile_Changed_Event is new Event with private; 
  133.     type A_Tile_Changed_Event is access all Tile_Changed_Event'Class; 
  134.  
  135.     -- Returns the map layer of the tile that changed. 
  136.     function Get_Layer( this : not null access Tile_Changed_Event'Class ) return Integer; 
  137.  
  138.     -- Returns the new tile id. 
  139.     function Get_Tile_ID( this : not null access Tile_Changed_Event'Class ) return Natural; 
  140.  
  141.     -- Returns the X coordinate of the tile that changed. 
  142.     function Get_X( this : not null access Tile_Changed_Event'Class ) return Natural; 
  143.  
  144.     -- Returns the Y coordinate of the tile that changed. 
  145.     function Get_Y( this : not null access Tile_Changed_Event'Class ) return Natural; 
  146.  
  147.     ---------------------------------------------------------------------------- 
  148.  
  149.     WORLD_MODIFIED_ID : constant Event_Id := To_Event_Id( "World_Modified" ); 
  150.  
  151.     -- A notification that the world has been modified somehow. 
  152.     type World_Modified_Event is new Event with private; 
  153.     type A_World_Modified_Event is access all World_Modified_Event'Class; 
  154.  
  155.     ---------------------------------------------------------------------------- 
  156.  
  157.     -- Creates a new, empty world synchronously. An exception is raised on error. 
  158.     procedure Trigger_Create_World( width, 
  159.                                     height : Positive; 
  160.                                     libName, 
  161.                                     domain : String ); 
  162.     pragma Precondition( libName'Length > 0 ); 
  163.     pragma Precondition( domain'Length > 0 ); 
  164.  
  165.     -- Load a world from disk asynchronously. 
  166.     procedure Queue_Load_World( filename : String ); 
  167.  
  168.     -- Loads a world from disk synchronously. An exception is raised on error. 
  169.     procedure Trigger_Load_World( filename : String ); 
  170.     pragma Precondition( filename'Length > 0 ); 
  171.  
  172.     -- A world has been loaded into the Game, by loading from disk, by creating 
  173.     -- a new world, etc. 
  174.     procedure Queue_World_Loaded( width, 
  175.                                   height, 
  176.                                   tileWidth : Positive; 
  177.                                   layers    : not null A_Layer_Array; 
  178.                                   libName   : String ); 
  179.     pragma Precondition( libName'Length > 0 ); 
  180.  
  181.     -- Resizes the world sychronously. An exception is raised on failure. 
  182.     -- (ie: parameters rejected) 
  183.     procedure Trigger_Resize_World( width, height : Positive ); 
  184.  
  185.     -- Set a tile in the world by location (layer, x, y). 
  186.     procedure Queue_Set_Tile( layer   : Integer; 
  187.                               x, y    : Float;      -- world pixel coordinates 
  188.                               tile_id : Natural ); 
  189.  
  190.     -- Asynchronously sets a world property 'name' to 'value'. The value will be 
  191.     -- copied. 
  192.     procedure Queue_Set_World_Property( name : String; value : Value_Ptr'Class ); 
  193.     pragma Precondition( name'Length > 0 ); 
  194.  
  195.     -- A tile in the world has changed. 
  196.     procedure Queue_Tile_Changed( layer   : Integer; 
  197.                                   x, y    : Natural; 
  198.                                   tile_id : Natural ); 
  199.  
  200.     -- Something about the world has changed. This is an indication that the 
  201.     -- world has changed since it was loaded from disk. 
  202.     procedure Queue_World_Modified; 
  203.  
  204.     -- Notifies listeners that the property 'name' of the world has changed. The 
  205.     -- property's new value is 'value'. The value will be copied. 
  206.     procedure Queue_World_Property_Changed( name : String; value : Value_Ptr'Class ); 
  207.     pragma Precondition( name'Length > 0 ); 
  208.  
  209. private 
  210.  
  211.     type Create_World_Event is new Event with 
  212.         record 
  213.             width, 
  214.             height  : Positive := 1; 
  215.             libName : Unbounded_String; 
  216.             domain  : Unbounded_String; 
  217.         end record; 
  218.  
  219.     procedure Construct( this    : access Create_World_Event; 
  220.                          width, 
  221.                          height  : Positive; 
  222.                          libName, 
  223.                          domain  : String ); 
  224.     pragma Precondition( libName'Length > 0 ); 
  225.     pragma Precondition( domain'Length > 0 ); 
  226.  
  227.     ---------------------------------------------------------------------------- 
  228.  
  229.     type Load_World_Event is new Event with 
  230.         record 
  231.             filename : Unbounded_String; 
  232.         end record; 
  233.  
  234.     procedure Construct( this : access Load_World_Event; filename : String ); 
  235.  
  236.     function To_String( this : access Load_World_Event ) return String; 
  237.  
  238.     ---------------------------------------------------------------------------- 
  239.  
  240.     type World_Loaded_Event is new Event with 
  241.         record 
  242.             width, 
  243.             height, 
  244.             tileWidth : Positive := 1; 
  245.             layers    : A_Layer_Array := null; 
  246.             libName   : Unbounded_String; 
  247.         end record; 
  248.  
  249.     procedure Adjust( this : access World_Loaded_Event ); 
  250.  
  251.     procedure Construct( this      : access World_Loaded_Event; 
  252.                          width, 
  253.                          height, 
  254.                          tileWidth : Positive; 
  255.                          layers    : not null A_Layer_Array; 
  256.                          libName   : String ); 
  257.     pragma Precondition( libName'Length > 0 ); 
  258.  
  259.     procedure Delete( this : in out World_Loaded_Event ); 
  260.  
  261.     ---------------------------------------------------------------------------- 
  262.  
  263.     type World_Property_Event is new Event with 
  264.         record 
  265.             name  : Unbounded_String; 
  266.             value : Value_Ptr; 
  267.         end record; 
  268.  
  269.     procedure Construct( this    : access World_Property_Event; 
  270.                          evtName : String; 
  271.                          name    : String; 
  272.                          value   : Value_Ptr'Class ); 
  273.     pragma Precondition( name'Length > 0 ); 
  274.  
  275.     function To_String( this : access World_Property_Event ) return String; 
  276.  
  277.     ---------------------------------------------------------------------------- 
  278.  
  279.     type Resize_World_Event is new Event with 
  280.         record 
  281.             width, 
  282.             height : Positive := 1; 
  283.         end record; 
  284.  
  285.     procedure Construct( this   : access Resize_World_Event; 
  286.                          width, 
  287.                          height : Positive ); 
  288.  
  289.     ---------------------------------------------------------------------------- 
  290.  
  291.     type Set_Tile_Event is new Event with 
  292.         record 
  293.             layer   : Integer := 0; 
  294.             x, y    : Float := 0.0; 
  295.             tile_id : Natural := 0; 
  296.         end record; 
  297.  
  298.     procedure Construct( this    : access Set_Tile_Event; 
  299.                          layer   : Integer; 
  300.                          x, y    : Float; 
  301.                          tile_id : Natural ); 
  302.  
  303.     ---------------------------------------------------------------------------- 
  304.  
  305.     type Tile_Changed_Event is new Event with 
  306.         record 
  307.             layer   : Integer := 0; 
  308.             x, y    : Natural := 0; 
  309.             tile_id : Natural := 0; 
  310.         end record; 
  311.  
  312.     procedure Construct( this    : access Tile_Changed_Event; 
  313.                          layer   : Integer; 
  314.                          x, y    : Natural; 
  315.                          tile_id : Natural ); 
  316.  
  317.     ---------------------------------------------------------------------------- 
  318.  
  319.     type World_Modified_Event is new Event with null record; 
  320.  
  321. end Events.World;