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