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 Objects;                           use Objects; 
  9. with Processes;                         use Processes; 
  10. with Processes.Managers;                use Processes.Managers; 
  11. with Tiles.Libraries;                   use Tiles.Libraries; 
  12.  
  13. private with Ada.Containers; 
  14. private with Ada.Containers.Hashed_Sets; 
  15. private with Ada.Containers.Ordered_Maps; 
  16. private with Ada.Real_Time; 
  17. private with Ada.Strings.Unbounded; 
  18. private with Maps; 
  19. private with Tiles; 
  20.  
  21. package Worlds is 
  22.  
  23.     -- A World is an object which contains a map and entities. It can be 
  24.     -- created, loaded and saved as a simple data object and it can be copied. 
  25.     -- 
  26.     -- Worlds are also Processes and Event_Listeners which can be attached to 
  27.     -- the game framework. Only one World at a time can be attached. This is 
  28.     -- enforced by the Game logic. Attaching a World to the game framework means 
  29.     -- giving it a Corral so it can register to receive events and attaching it 
  30.     -- to a Process_Manager so it can execute code. An attached World object 
  31.     -- then has behavior because it listens for events, queues events, and 
  32.     -- executes code as a Process. When a world is attached, its dispatching 
  33.     -- On_Attach procedure is called, which may queue load-time events and 
  34.     -- register the object as an event listener. When a world is detached from 
  35.     -- the game framework, its dispatching On_Detach procedure is called to 
  36.     -- unregister the object as an event listener, etc. A World object can't be 
  37.     -- copied while it is attached to the Game framework. 
  38.     -- 
  39.     -- An unattached World should not have any independent behavior and should 
  40.     -- only do as it is instructed by calling the class procedures. 
  41.  
  42.     type World_Object is abstract new Object and Event_Listener and Process with private; 
  43.     type A_World is access all World_Object'Class; 
  44.  
  45.     -- Creates a new empty world. An exception is raised on error. 
  46.     function Create_World( width, 
  47.                            height  : Positive; 
  48.                            libName, 
  49.                            domain  : String ) return A_World; 
  50.     pragma Precondition( libName'Length > 0 ); 
  51.     pragma Precondition( domain'Length > 0 ); 
  52.     pragma Postcondition( Create_World'Result /= null ); 
  53.  
  54.     -- Loads a world from disk. An exception is raised on error. 
  55.     function Load_World( name : String ) return A_World; 
  56.     pragma Postcondition( Load_World'Result /= null ); 
  57.  
  58.     -- Attaches the world to the game framework to send and receive events and 
  59.     -- execute as a process. 
  60.     procedure Attach_To_Framework( this   : not null access World_Object'Class; 
  61.                                    corral : not null A_Corral; 
  62.                                    pman   : not null A_Process_Manager ); 
  63.  
  64.     -- Detaches the world from the game framework, removing itself as an event 
  65.     -- listener and ceasing execution as a process. 
  66.     procedure Detach_From_Framework( this : not null access World_Object'Class ); 
  67.  
  68.     -- Returns a reference to an entity with the given id, or null if the entity 
  69.     -- doesn't exist. 
  70.     function Get_Entity( this : access World_Object; id : Entity_Id ) return A_Entity; 
  71.  
  72.     -- Returns the actual map height in pixels. 
  73.     function Get_Height( this : not null access World_Object'Class ) return Positive; 
  74.  
  75.     -- Returns the height of the map in tiles. 
  76.     function Get_Height_Tiles( this : not null access World_Object'Class ) return Positive; 
  77.  
  78.     -- Returns the world's reference to its tile library. Do not modify it. 
  79.     function Get_Library( this : not null access World_Object'Class ) return A_Tile_Library; 
  80.  
  81.     -- Returns the name of the background music track. 
  82.     function Get_Music( this : not null access World_Object'Class ) return String; 
  83.  
  84.     -- Returns a reference to the world's current player entity. Do not modify 
  85.     -- it. 
  86.     function Get_Player( this : not null access World_Object'Class ) return A_Player; 
  87.  
  88.     -- Returns the id of the tile at the specified location. 
  89.     function Get_Tile_Id( this  : not null access World_Object'Class; 
  90.                           layer, 
  91.                           x, y  : Integer ) return Natural; 
  92.  
  93.     -- Returns the actual map width in pixels. 
  94.     function Get_Width( this : not null access World_Object'Class) return Positive; 
  95.  
  96.     -- Returns the width of the map in tiles. 
  97.     function Get_Width_Tiles( this : not null access World_Object'Class ) return Positive; 
  98.  
  99.     -- Resizes the map. An exception is raised on error. 
  100.     procedure Resize( this   : not null access World_Object'Class; 
  101.                       width, 
  102.                       height : Positive ); 
  103.  
  104.     -- Writes the world in its current state to a file on disk. An exception is 
  105.     -- raised on error. 
  106.     procedure Save( this      : not null access World_Object'Class; 
  107.                     name      : String; 
  108.                     overwrite : Boolean := True ); 
  109.     pragma Precondition( name'Length > 0 ); 
  110.  
  111.     -- basic properties: 
  112.     -- "filename" : the filename 
  113.     -- "music"    : the background music track name 
  114.     -- "domain"   : determines player movement, physical rules 
  115.     procedure Set_Property( this : access World_Object; name, value : String ); 
  116.     pragma Precondition( name'Length > 0 ); 
  117.  
  118.     -- If 'notify' is True, Tile_Changed and World_Modified events will be sent. 
  119.     procedure Set_Tile( this   : access World_Object; 
  120.                         layer  : Integer; 
  121.                         x, y   : Integer; 
  122.                         id     : Natural; 
  123.                         notify : Boolean := True ); 
  124.  
  125.     -- Spawns an entity of the given class id into the world. If 'width' or 
  126.     -- 'height' are equal to 0, the entity's natural width and height will be 
  127.     -- used. 
  128.     procedure Spawn_Entity( this   : access World_Object; 
  129.                             id     : String; 
  130.                             x, y   : Float; 
  131.                             width, 
  132.                             height : Natural := 0; 
  133.                             xv, yv : Float := 0.0 ); 
  134.     pragma Precondition( id'Length > 0 ); 
  135.  
  136.     function Tile_Width( this : not null access World_Object'Class ) return Positive; 
  137.  
  138.     function Object_Input( stream : access Root_Stream_Type'Class ) return World_Object is abstract; 
  139.  
  140.     function Copy( src : A_World ) return A_World; 
  141.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  142.  
  143.     procedure Delete( this : in out A_World ); 
  144.     pragma Postcondition( this = null ); 
  145.  
  146.     ---------------------------------------------------------------------------- 
  147.  
  148.     function Valid_Domain( domain : String ) return Boolean; 
  149.  
  150.     function World_Extension return String; 
  151.     pragma Postcondition( World_Extension'Result'Length > 0 ); 
  152.  
  153.     FILE_NOT_FOUND, 
  154.     READ_EXCEPTION, 
  155.     WRITE_EXCEPTION : exception; 
  156.  
  157. private 
  158.  
  159.     use Ada.Containers; 
  160.     use Ada.Real_Time; 
  161.     use Ada.Strings.Unbounded; 
  162.     use Maps; 
  163.     use Tiles; 
  164.  
  165.     package Entity_Map is new Ada.Containers.Ordered_Maps( Entity_Id, A_Entity, "<", "=" ); 
  166.  
  167.     -- There are two kinds of tile animation: looping animations and one-shot. 
  168.     -- 
  169.     -- In the case of a one-shot animation, each frame progresses to the next 
  170.     -- after a fixed amount of time, beginning the moment the tile is set into 
  171.     -- the world. Generally, the last frame of a one-shot animation will end by 
  172.     -- progressing to a non-animated tile. It is possible for a frame in a 
  173.     -- one-shot animation to jump back to a previous frame, creating a frame 
  174.     -- cycle, but this is generally not very useful. 
  175.     -- 
  176.     -- Looping animations have a list of frames and a single delay. The biggest 
  177.     -- difference between looping and one-shot animations is that the animation 
  178.     -- frame is globally updated at specific time slices, based on the animation 
  179.     -- frame delay. This means that two world locations with the same tile id 
  180.     -- will always update simultaneously, regardless of being set into the map 
  181.     -- at different times or not. 
  182.     -- 
  183.     -- An animation is looping if the frames field of the Animated_Info is 
  184.     -- non-null, otherwise it's a one-shot. 
  185.     type Animated_Info is 
  186.         record 
  187.             layer      : Integer;           -- layer of animated tile 
  188.             x, y       : Integer;           -- coordinates of animated tile 
  189.             nextUpdate : Time;              -- next time to update the frame 
  190.             frameDelay : Time_Span;         -- (for looping) animation frame delay 
  191.             frames     : A_Tile_Id_Array;   -- (for looping) frame list 
  192.         end record; 
  193.  
  194.     function Equivalent( l, r : Animated_Info ) return Boolean; 
  195.  
  196.     function Hash( a : Animated_Info ) return Hash_Type; 
  197.  
  198.     function Is_Looping( ai : Animated_Info ) return Boolean; 
  199.  
  200.     function Animated_Info_Input( stream : access Root_Stream_Type'Class ) return Animated_Info; 
  201.     for Animated_Info'Input use Animated_Info_Input; 
  202.  
  203.     procedure Animated_Info_Output( stream : access Root_Stream_Type'Class; info : Animated_Info ); 
  204.     for Animated_Info'Output use Animated_Info_Output; 
  205.  
  206.     package Animated_Set is new Ada.Containers.Hashed_Sets( Animated_Info, 
  207.                                                             Hash, Equivalent, 
  208.                                                             "=" ); 
  209.  
  210.     ---------------------------------------------------------------------------- 
  211.  
  212.     type World_Object is abstract new Object and Event_Listener and Process with 
  213.         record 
  214.             attached : Boolean := False; 
  215.             corral   : A_Corral; 
  216.             pman     : A_Process_Manager; 
  217.  
  218.             filename : Unbounded_String; 
  219.             map      : A_Map := null; 
  220.             lib      : A_Tile_Library := null; 
  221.             libName  : Unbounded_String; 
  222.             music    : Unbounded_String; 
  223.             domain   : Unbounded_String; 
  224.             entities : Entity_Map.Map; 
  225.             animated : Animated_Set.Set; 
  226.             player   : Entity_Id := INVALID_ID; 
  227.         end record; 
  228.  
  229.     procedure Adjust( this : access World_Object ); 
  230.  
  231.     -- Construction with an empty filename, map, libName and domain is allowed 
  232.     -- if the object is being constructed as part of a streaming read operation. 
  233.     -- The fields should be be immediately read in before the World is returned 
  234.     -- to the application for use. 
  235.     procedure Construct( this     : access World_Object; 
  236.                          filename : String; 
  237.                          map      : in out A_Map; 
  238.                          libName, 
  239.                          domain   : String ); 
  240.  
  241.     procedure Delete( this : in out World_Object ); 
  242.  
  243.     procedure Initialize( this : access World_Object ); 
  244.  
  245.     function Get_Process_Name( this : access World_Object ) return String; 
  246.     pragma Postcondition( Get_Process_Name'Result'Length > 0 ); 
  247.  
  248.     procedure Handle( this : access World_Object; evt : not null A_Delete_Entity_Event ); 
  249.  
  250.     procedure Handle( this : access World_Object; evt : not null A_Entities_Collided_Event ); 
  251.  
  252.     procedure Handle( this : access World_Object; evt : not null A_Entities_Separated_Event ); 
  253.  
  254.     procedure Handle( this : access World_Object; evt : not null A_Entity_Face_Event ); 
  255.  
  256.     procedure Handle( this : access World_Object; evt : not null A_Entity_Grounded_Event ); 
  257.  
  258.     procedure Handle( this : access World_Object; evt : not null A_Entity_Hit_Wall_Event ); 
  259.  
  260.     procedure Handle( this : access World_Object; evt : not null A_Entity_Moved_Event ); 
  261.  
  262.     procedure Handle( this : access World_Object; evt : not null A_Entity_Resized_Event ); 
  263.  
  264.     procedure Handle( this : access World_Object; evt : not null A_Set_Entity_Attribute_Event ); 
  265.  
  266.     procedure Handle( this : access World_Object; evt : not null A_Spawn_Entity_Event ); 
  267.  
  268.     procedure Handle_Event( this : access World_Object; 
  269.                             evt  : in out A_Event; 
  270.                             resp : out Response_Type ); 
  271.     pragma Precondition( evt /= null ); 
  272.  
  273.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out World_Object ); 
  274.     for World_Object'Read use Object_Read; 
  275.  
  276.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : World_Object ); 
  277.     for World_Object'Write use Object_Write; 
  278.  
  279.     -- Calls Queue_Load_Events 
  280.     procedure On_Attach( this : access World_Object ); 
  281.  
  282.     procedure On_Detach( this : access World_Object ); 
  283.  
  284.     -- Queues world loaded events in order to send the world to the game views. 
  285.     procedure Queue_Load_Events( this : access World_Object ); 
  286.  
  287.     procedure Tick( this : access World_Object; upTime, dt : Time_Span ); 
  288.  
  289.     function A_World_Input( stream : access Root_Stream_Type'Class ) return A_World; 
  290.     for A_World'Input use A_World_Input; 
  291.  
  292.     procedure A_World_Output( stream : access Root_Stream_Type'Class; world : A_World ); 
  293.     for A_World'Output use A_World_Output; 
  294.  
  295.     procedure A_World_Read( stream : access Root_Stream_Type'Class; world : out A_World ); 
  296.     for A_World'Read use A_World_Read; 
  297.  
  298.     procedure A_World_Write( stream : access Root_Stream_Type'Class; world : A_World ); 
  299.     for A_World'Write use A_World_Write; 
  300.  
  301.     ---------------------------------------------------------------------------- 
  302.  
  303.     type Allocator is 
  304.         access function( width, 
  305.                          height  : Positive; 
  306.                          libName, 
  307.                          domain  : String ) return A_World; 
  308.  
  309.     procedure Register( allocate      : not null Allocator; 
  310.                         identifier    : String; 
  311.                         read_version, 
  312.                         write_version : Positive ); 
  313.     pragma Precondition( identifier'Length > 0 ); 
  314.  
  315.     procedure Register_Domain( domain : String ); 
  316.     pragma Precondition( domain'Length > 0 ); 
  317.  
  318.     function World_Identifier return String; 
  319.  
  320. end Worlds;