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 Entities;                          use Entities; 
  11. with Entities.Players;                  use Entities.Players; 
  12. with Events;                            use Events; 
  13. with Events.Corrals;                    use Events.Corrals; 
  14. with Events.Entities;                   use Events.Entities; 
  15. with Events.Listeners;                  use Events.Listeners; 
  16. with Game_States;                       use Game_States; 
  17. with Maps;                              use Maps; 
  18. with Objects;                           use Objects; 
  19. with Processes;                         use Processes; 
  20. with Scripting;                         use Scripting; 
  21. with Tiles.Libraries;                   use Tiles.Libraries; 
  22. with Values;                            use Values; 
  23.  
  24. private with Ada.Containers; 
  25. private with Ada.Containers.Hashed_Sets; 
  26. private with Ada.Containers.Ordered_Maps; 
  27. private with Ada.Real_Time; 
  28. private with Tiles; 
  29. private with Values.Associations; 
  30. private with Values.Lists; 
  31.  
  32. package Worlds is 
  33.  
  34.     -- A World is an object which contains a map and entities. It can be 
  35.     -- created, loaded, saved, and handles its own state and execution during 
  36.     -- gameplay. 
  37.     -- 
  38.     -- A World acts as a Process and as an Event_Listener that can be attached 
  39.     -- to the game framework. Only one World at a time can be attached as the 
  40.     -- game session's currently active world. This is enforced by the Game logic 
  41.     -- that owns the active world. Attaching a World to the game framework means 
  42.     -- giving it a Corral so it can register to receive events, evaluate all 
  43.     -- its entities' OnAttach actions, and queue events to notify the view of 
  44.     -- the world. An attached World object has behavior; it listens for events, 
  45.     -- queues events, and executes as a Process. 
  46.     -- 
  47.     -- When a world is attached, its On_Attach procedure is called, which queues 
  48.     -- load-time events and register the object as an event listener. When a 
  49.     -- world is detached from the game framework, its On_Detach procedure is 
  50.     -- called to unregister the object as an event listener, etc. 
  51.     -- 
  52.     -- An unattached World has no behavior until it is attached. 
  53.     type World_Object is new Object and 
  54.                              Event_Listener and 
  55.                              Process and 
  56.                              Evaluation_Node with private; 
  57.     type A_World is access all World_Object'Class; 
  58.  
  59.     -- Creates a new empty world. An exception is raised on error. 
  60.     function Create_World( width, 
  61.                            height         : Positive; 
  62.                            physicalLayers : Maps.Boolean_Array; 
  63.                            library, 
  64.                            domain         : String ) return A_World; 
  65.     pragma Precondition( library'Length > 0 ); 
  66.     pragma Precondition( domain'Length > 0 ); 
  67.     pragma Postcondition( Create_World'Result /= null ); 
  68.  
  69.     -- Loads a world from disk. An exception is raised on error. 
  70.     function Load_World( name : String ) return A_World; 
  71.     pragma Postcondition( Load_World'Result /= null ); 
  72.  
  73.     -- Attaches the world to the game framework to send and receive events. 
  74.     procedure Attach_To_Framework( this      : not null access World_Object'Class; 
  75.                                    gameState : not null A_Game_State; 
  76.                                    corral    : not null A_Corral ); 
  77.  
  78.     -- Detaches the world from the game framework, removing itself as an event 
  79.     -- listener and ceasing execution as a process. 
  80.     procedure Detach_From_Framework( this : not null access World_Object'Class ); 
  81.  
  82.     -- Evaluates the script function 'name', given 'arguments'. The value of the 
  83.     -- evaluated function will be returned, or Null if the function name is not 
  84.     -- recognized. 
  85.     -- todo: make this private (public due to 6.2.0w bug) 
  86.     function Evaluate_Function( this      : access World_Object; 
  87.                                 name      : String; 
  88.                                 arguments : Value_Array ) return Value_Ptr; 
  89.  
  90.     -- Evaluates the symbol named 'symbol', resolving it as a game session 
  91.     -- variable. null will be returned if the symbol can't be resolved. 
  92.     -- todo: make this private (public due to 6.2.0w bug) 
  93.     function Evaluate_Symbol( this : access World_Object; symbol : String ) return Value_Ptr; 
  94.  
  95.     -- Iterate through all of the entities in the world, examining each. 
  96.     procedure Examine_Entities( this    : not null access World_Object'Class; 
  97.                                 examine : not null access procedure( e : not null A_Entity ) ); 
  98.  
  99.     -- Returns a reference to an entity with the given id, or null if the entity 
  100.     -- doesn't exist. 
  101.     function Get_Entity( this : not null access World_Object'Class; 
  102.                          id   : Entity_Id ) return A_Entity; 
  103.  
  104.     -- Returns the World's attached Game class, if it has been attached to the 
  105.     -- framework. 
  106.     function Get_Game_State( this : not null access World_Object'Class ) return A_Game_State; 
  107.  
  108.     -- Returns the actual map height in pixels. 
  109.     function Get_Height( this : not null access World_Object'Class ) return Positive; 
  110.  
  111.     -- Returns the height of the map in tiles. 
  112.     function Get_Height_Tiles( this : not null access World_Object'Class ) return Positive; 
  113.  
  114.     -- Returns the number of layers in the world's map. 
  115.     function Get_Layers( this : not null access World_Object'Class ) return Positive; 
  116.  
  117.     -- Returns the world's reference to its tile library. Do not modify it. 
  118.     function Get_Library( this : not null access World_Object'Class ) return A_Tile_Library; 
  119.  
  120.     -- Returns a reference to the world's current player entity. Do not modify 
  121.     -- it. 
  122.     function Get_Player( this : not null access World_Object'Class ) return A_Player; 
  123.  
  124.     -- Returns the property of the world named 'name', or Null if the property 
  125.     -- has not been defined. 
  126.     function Get_Property( this : not null access World_Object'Class; 
  127.                            name : String ) return Value_Ptr; 
  128.     pragma Postcondition( Get_Property'Result /= Values.Nul ); 
  129.  
  130.     -- Returns the id of the tile at the specified location. 
  131.     function Get_Tile_Id( this  : not null access World_Object'Class; 
  132.                           layer : Positive; 
  133.                           x, y  : Integer ) return Natural; 
  134.  
  135.     -- Returns the actual map width in pixels. 
  136.     function Get_Width( this : not null access World_Object'Class) return Positive; 
  137.  
  138.     -- Returns the width of the map in tiles. 
  139.     function Get_Width_Tiles( this : not null access World_Object'Class ) return Positive; 
  140.  
  141.     -- Resizes the map. An exception is raised on error. 
  142.     procedure Resize( this   : not null access World_Object'Class; 
  143.                       width, 
  144.                       height : Positive ); 
  145.  
  146.     -- Writes the world in its current state to a file on disk. An exception is 
  147.     -- raised on error. 
  148.     procedure Save( this      : not null access World_Object'Class; 
  149.                     name      : String; 
  150.                     overwrite : Boolean := True ); 
  151.     pragma Precondition( name'Length > 0 ); 
  152.  
  153.     -- Sets the value of a property named 'name' to 'value'. 
  154.     -- A World_Property_Changed event and a World_Modified event will be fired. 
  155.     procedure Set_Property( this  : not null access World_Object'Class; 
  156.                             name  : String; 
  157.                             value : Value_Ptr'Class ); 
  158.     pragma Precondition( name'Length > 0 ); 
  159.     pragma Precondition( Value_Ptr(value) /= Values.Nul ); 
  160.  
  161.     -- If 'notify' is True, Tile_Changed and World_Modified events will be sent. 
  162.     procedure Set_Tile( this   : not null access World_Object'Class; 
  163.                         layer  : Integer; 
  164.                         x, y   : Integer; 
  165.                         id     : Natural; 
  166.                         notify : Boolean := True ); 
  167.  
  168.     -- x, y are in pixel coordinates, not tile coordinates. If 'notify' is True, 
  169.     -- Tile_Changed and World_Modified events will be sent. 
  170.     procedure Set_Tile( this   : not null access World_Object'Class; 
  171.                         layer  : Integer; 
  172.                         x, y   : Float; 
  173.                         id     : Natural; 
  174.                         notify : Boolean := True ); 
  175.  
  176.     -- Spawns an entity of the given class id into the world. If 'width' or 
  177.     -- 'height' are equal to 0, the entity's natural width and height will be 
  178.     -- used. If the world is attached to the game framework, Entity_Created and 
  179.     -- World_Modified events will be generated. The id of the new entity will be 
  180.     -- returned, or INVALID_ID if the 
  181.     function Spawn_Entity( this   : not null access World_Object'Class; 
  182.                            id     : String; 
  183.                            x, y   : Float; 
  184.                            width, 
  185.                            height : Natural := 0; 
  186.                            xv, yv : Float := 0.0 ) return Entity_Id; 
  187.     pragma Precondition( id'Length > 0 ); 
  188.  
  189.     -- Returns the width of each tile in the world, in pixels. 
  190.     function Tile_Width( this : not null access World_Object'Class ) return Positive; 
  191.  
  192.     function Object_Input( stream : access Root_Stream_Type'Class ) return World_Object; 
  193.     for World_Object'Input use Object_Input; 
  194.  
  195.     -- Deletes the World. 
  196.     procedure Delete( this : in out A_World ); 
  197.     pragma Postcondition( this = null ); 
  198.  
  199.     ---------------------------------------------------------------------------- 
  200.  
  201.     -- Returns True if 'domain' is a registered domain name. Case sensitive. 
  202.     function Valid_Domain( domain : String ) return Boolean; 
  203.  
  204.     -- Returns the file extension for World files, without a leading dot. 
  205.     function World_Extension return String; 
  206.     pragma Postcondition( World_Extension'Result'Length > 0 ); 
  207.  
  208.     FILE_NOT_FOUND, 
  209.     READ_EXCEPTION, 
  210.     WRITE_EXCEPTION : exception; 
  211.  
  212. private 
  213.  
  214.     use Ada.Containers; 
  215.     use Ada.Real_Time; 
  216.     use Tiles; 
  217.     use Values.Lists; 
  218.     use Values.Associations; 
  219.  
  220.     -- Maps Entity_Ids to Entity objects. 
  221.     package Entity_Map is new Ada.Containers.Ordered_Maps( Entity_Id, A_Entity, "<", "=" ); 
  222.  
  223.     -- There are two kinds of tile animation: looping animations and one-shot. 
  224.     -- 
  225.     -- In the case of a one-shot animation, each frame progresses to the next 
  226.     -- after a fixed amount of time, beginning the moment the tile is set into 
  227.     -- the world. Generally, the last frame of a one-shot animation will end by 
  228.     -- progressing to a non-animated tile. It is possible for a frame in a 
  229.     -- one-shot animation to jump back to a previous frame, creating a frame 
  230.     -- cycle, but this is generally not very useful. 
  231.     -- 
  232.     -- Looping animations have a list of frames and a single delay. The biggest 
  233.     -- difference between looping and one-shot animations is that the animation 
  234.     -- frame is globally updated at specific time slices, based on the animation 
  235.     -- frame delay. This means that two world locations with the same tile id 
  236.     -- will always update simultaneously, regardless of being set into the map 
  237.     -- at different times or not. 
  238.     -- 
  239.     -- An animation is looping if the frames field of the Animated_Info is 
  240.     -- non-null, otherwise it's a one-shot. 
  241.     type Animated_Info is 
  242.         record 
  243.             layer      : Natural;           -- layer of animated tile 
  244.             x, y       : Integer;           -- coordinates of animated tile 
  245.             nextUpdate : Time;              -- next time to update the frame 
  246.             frameDelay : Time_Span;         -- (for looping) animation frame delay 
  247.             frames     : List_Ptr;          -- (for looping) frame list 
  248.         end record; 
  249.  
  250.     -- Returns True if 'l' and 'r' share the same world location. 
  251.     function Equivalent( l, r : Animated_Info ) return Boolean; 
  252.  
  253.     -- Returns the tile id of the frame at 'index' in the animation's frame 
  254.     -- loop, or 0 if the animation isn't loop or doesn't have index 'index'. 
  255.     -- Indexes start at 1. 
  256.     function Get_Frame( ai : Animated_Info; index : Integer ) return Natural; 
  257.  
  258.     -- Returns a hash value of the Animated_Info record. 
  259.     function Hash( ai : Animated_Info ) return Hash_Type; 
  260.  
  261.     -- Returns True if the animation is played as a loop. 
  262.     function Is_Looping( ai : Animated_Info ) return Boolean; 
  263.  
  264.     function Animated_Info_Input( stream : access Root_Stream_Type'Class ) return Animated_Info; 
  265.     for Animated_Info'Input use Animated_Info_Input; 
  266.  
  267.     procedure Animated_Info_Output( stream : access Root_Stream_Type'Class; info : Animated_Info ); 
  268.     for Animated_Info'Output use Animated_Info_Output; 
  269.  
  270.     package Animated_Set is new Ada.Containers.Hashed_Sets( Animated_Info, 
  271.                                                             Hash, Equivalent, 
  272.                                                             "=" ); 
  273.  
  274.     ---------------------------------------------------------------------------- 
  275.  
  276.     type World_Object is new Object and 
  277.                              Event_Listener and 
  278.                              Process and 
  279.                              Evaluation_Node with 
  280.         record 
  281.             -- the following fields are Not streamed 
  282.             attached   : Boolean := False; 
  283.             gameState  : A_Game_State := null; 
  284.             corral     : A_Corral:= null; 
  285.             lib        : A_Tile_Library := null; 
  286.  
  287.             -- the following fields are streamed 
  288.             properties : Assoc_Ptr; 
  289.             map        : A_Map := null; 
  290.             animated   : Animated_Set.Set; 
  291.             entities   : Entity_Map.Map; 
  292.         end record; 
  293.  
  294.     -- 
  295.     -- Standard World_Object Properties: 
  296.     -- 
  297.     -- filename : The filename the world was loaded from or saved to (not persisted) 
  298.     -- library  : The name of the world's tile library 
  299.     -- playerId : The id of the entity that is controlled by the view 
  300.     -- 
  301.  
  302.     -- raises COPY_NOT_ALLOWED 
  303.     procedure Adjust( this : access World_Object ); 
  304.  
  305.     -- Constructs an empty world without a map as part of reading it in from a 
  306.     -- stream, where the World's parameters are not yet known. 
  307.     procedure Construct( this : access World_Object ); 
  308.  
  309.     procedure Construct( this           : access World_Object; 
  310.                          width, 
  311.                          height         : Positive; 
  312.                          physicalLayers : Maps.Boolean_Array; 
  313.                          library, 
  314.                          domain         : String ); 
  315.     pragma Precondition( physicalLayers'Length > 0 ); 
  316.     pragma Precondition( library'Length > 0 ); 
  317.     pragma Precondition( domain'Length > 0 ); 
  318.  
  319.     procedure Delete( this : in out World_Object ); 
  320.  
  321.     -- Returns the name of the World as a Process. 
  322.     function Get_Process_Name( this : access World_Object ) return String; 
  323.     pragma Postcondition( Get_Process_Name'Result'Length > 0 ); 
  324.  
  325.     -- Handles a Delete_Entity event. 
  326.     procedure Handle_Delete_Entity( this : access World_Object; 
  327.                                     evt  : not null A_Entity_Event ); 
  328.  
  329.     -- Handles an Entity_Grounded event. 
  330.     procedure Handle_Entity_Grounded( this : access World_Object; 
  331.                                       evt  : not null A_Entity_Grounded_Event ); 
  332.  
  333.     -- Handles an Entity_Hit_Wall event. 
  334.     procedure Handle_Entity_Hit_Wall( this : access World_Object; 
  335.                                       evt  : not null A_Entity_Hit_Wall_Event ); 
  336.  
  337.     -- Handles an Entity_Moved event. 
  338.     procedure Handle_Entity_Moved( this : access World_Object; 
  339.                                    evt  : not null A_Entity_Moved_Event ); 
  340.  
  341.     -- Handles an Entity_Resized event. 
  342.     procedure Handle_Entity_Resized( this : access World_Object; 
  343.                                      evt  : not null A_Entity_Resized_Event ); 
  344.  
  345.     -- Handles a Set_Entity_Attribute event. 
  346.     procedure Handle_Set_Entity_Attribute( this : access World_Object; 
  347.                                            evt  : not null A_Entity_Attribute_Event ); 
  348.  
  349.     -- Handles a Spawn_Entity event. 
  350.     procedure Handle_Spawn_Entity( this : access World_Object; 
  351.                                    evt  : not null A_Spawn_Entity_Event ); 
  352.  
  353.     -- Handles all events the World receives and dispatches to the specific 
  354.     -- Handle procedure. If this procedure is overridden, the implementation 
  355.     -- should handle 'evt' if it's special. If the subclass doesn't do anything 
  356.     -- special with it, then it should call this implementation to dispatch it. 
  357.     procedure Handle_Event( this : access World_Object; 
  358.                             evt  : in out A_Event; 
  359.                             resp : out Response_Type ); 
  360.     pragma Precondition( evt /= null ); 
  361.  
  362.     -- Performs initialization immediately after load that can't be performed 
  363.     -- during construction, like passing a reference to 'this' to child objects 
  364.     -- (ie: entitites) that need it. An overriding implementation should call 
  365.     -- this first. 
  366.     procedure Initialize( this : access World_Object ); 
  367.  
  368.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out World_Object ); 
  369.     for World_Object'Read use Object_Read; 
  370.  
  371.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : World_Object ); 
  372.     for World_Object'Write use Object_Write; 
  373.  
  374.     -- This is called when the World is attached to the Game framework, to 
  375.     -- register for events and execute entities' On_Load handlers. Override this 
  376.     -- procedure to register the world to listen for special events or to queue 
  377.     -- any special events on load. An overriding implementation should call this 
  378.     -- first. 
  379.     procedure On_Attach( this : access World_Object ); 
  380.  
  381.     -- This is called when the World is removed from the Game framework, to 
  382.     -- unregister for the events it previously registered for with On_Attach. 
  383.     -- If On_Attach is overridden, On_Detach should be overridden too. The 
  384.     -- world can't remain registered as a listener for any event type on detach. 
  385.     -- An overriding implementation should call this first. 
  386.     procedure On_Detach( this : access World_Object ); 
  387.  
  388.     -- Queues world loaded events in order to send the world to the game views. 
  389.     -- This includes the events World_Loaded, World_Property_Changed, 
  390.     -- Entity_Created, and Follow_Entity. This procedure is called as part of 
  391.     -- On_Attach. 
  392.     procedure Queue_Load_Events( this : not null access World_Object'Class ); 
  393.  
  394.     -- Executes one frame of the world behavior; updates entities and animated 
  395.     -- tiles. An overriding implementation should call this first. 
  396.     procedure Tick( this : access World_Object; time : Tick_Time ); 
  397.  
  398.     -- Verifies a file format header before reading the World representation. 
  399.     -- If the header is invalid, READ_EXCEPTION will be raised. Raises an 
  400.     -- exception on streaming error. 
  401.     function A_World_Input( stream : access Root_Stream_Type'Class ) return A_World; 
  402.     for A_World'Input use A_World_Input; 
  403.  
  404.     -- Writes a file format header and then the World representation. 
  405.     procedure A_World_Output( stream : access Root_Stream_Type'Class; world : A_World ); 
  406.     for A_World'Output use A_World_Output; 
  407.  
  408.     -- Reads the concrete World tag and instantiates it. A Constraint_Error will 
  409.     -- be raised if the class is unknown. Raises an exception on streaming 
  410.     -- error. 
  411.     procedure A_World_Read( stream : access Root_Stream_Type'Class; world : out A_World ); 
  412.     for A_World'Read use A_World_Read; 
  413.  
  414.     -- Writes the conrete World tag. 
  415.     procedure A_World_Write( stream : access Root_Stream_Type'Class; world : A_World ); 
  416.     for A_World'Write use A_World_Write; 
  417.  
  418.     ---------------------------------------------------------------------------- 
  419.  
  420.     -- Registers 'domain' as a valid domain for Worlds. Case sensitive. 
  421.     procedure Register_Domain( domain : String ); 
  422.     pragma Precondition( domain'Length > 0 ); 
  423.  
  424. end Worlds;