1. with Entities;                          use Entities; 
  2. with Events.Listeners;                  use Events.Listeners; 
  3.  
  4. private with Ada.Containers.Ordered_Maps; 
  5. private with Ada.Containers.Ordered_Sets; 
  6. private with Events; 
  7. private with Events.Entities; 
  8. private with Events.World; 
  9. private with Interfaces; 
  10. private with Maps; 
  11. private with Tiles.Libraries; 
  12. private with Widgets.Sprites; 
  13.  
  14. package Widgets.Containers.Scenes is 
  15.  
  16.     -- A Scene displays a graphical view of a game world as a layered map built 
  17.     -- from tiles. As a container widget, it contains Sprite widgets, each 
  18.     -- corresponding to a non-metaphysical entity in the world. The Scene's 
  19.     -- viewport generally shows only a portion of the world at a time and can be 
  20.     -- zoomed or scrolled, either manually or by following an entity. 
  21.     type Scene is abstract new Container and Event_Listener with private; 
  22.     type A_Scene is access all Scene'Class; 
  23.  
  24.     -- Draws the range of tiles visible in the scene's viewport for layer 
  25.     -- 'layer' of the scene's map. The drawing location for the tile at 
  26.     -- 'tileX1','tileY1' is given by 'startX', 'startY'. Missing tiles should 
  27.     -- not drawn. All tiles in this layer are assumed to be opaque so 
  28.     -- transparency doesn't need to be handled when drawin. This procedure will 
  29.     -- be called per redraw per layer from background to foreground. 
  30.     procedure Draw_Layer( this   : access Scene; 
  31.                           dc     : Drawing_Context; 
  32.                           layer  : Positive;      -- layer to draw 
  33.                           startX,                 -- location in content coordinates 
  34.                           startY : Integer;       --     to start drawing 
  35.                           tileX1,                 -- range of the visible layer 
  36.                           tileY1,                 --     in tile coordinates 
  37.                           tileX2,                 -- 
  38.                           tileY2 : Integer        -- 
  39.                         ) is abstract; 
  40.  
  41.     -- Returns the height of the scene's map in tiles. 
  42.     function Get_Height_Tiles( this : not null access Scene'Class ) return Natural; 
  43.  
  44.     -- Returns the width of the scene's map in tiles. 
  45.     function Get_Width_Tiles( this : not null access Scene'Class ) return Natural; 
  46.  
  47.     -- Scrolls the viewport by x, y in world coordinates. If the scene is 
  48.     -- following an entity then scrolling will be constrained to the target by 
  49.     -- the slack distance. 
  50.     procedure Scroll( this : not null access Scene'Class; x, y : Float ); 
  51.  
  52.     -- Passing null in 'child' will clear the selection. 
  53.     procedure Set_Selection( this : access Scene; child : A_Widget ); 
  54.  
  55.     -- Sets the scene's target entity, 'target', by Entity_Id. The scene will 
  56.     -- automatically scroll its viewport to keep the target entity in sight, 
  57.     -- constrained by a slack distance from dead center. If 'target' equals 
  58.     -- INVALID_ID then the scene will not follow an entity. 
  59.     procedure Set_Target( this : access Scene; target : Entity_Id ); 
  60.  
  61.     -- Unselects 'child' widget, removing it from the set of selected children. 
  62.     -- This is not the same thing as input focus. 
  63.     procedure Unselect( this : access Scene; child : not null A_Widget ); 
  64.  
  65. private 
  66.  
  67.     use Events; 
  68.     use Events.Entities; 
  69.     use Events.World; 
  70.     use Interfaces; 
  71.     use Maps; 
  72.     use Tiles.Libraries; 
  73.     use Widgets.Sprites; 
  74.  
  75.     -- Provides a Map to map entity id values to their respective Sprite widgets. 
  76.     package Sprite_Maps is new Ada.Containers.Ordered_Maps( Entity_Id, A_Sprite, "<", "=" ); 
  77.     use Sprite_Maps; 
  78.  
  79.     -- Provides an ordered Set of widget references. 
  80.     package Widget_Sets is new Ada.Containers.Ordered_Sets( A_Widget, Lt, "=" ); 
  81.     use Widget_Sets; 
  82.  
  83.     type Boolean_Array is array (Natural range <>) of Boolean; 
  84.     type A_Boolean_Array is access all Boolean_Array; 
  85.  
  86.     type Byte_Array is array (Natural range <>) of Unsigned_8; 
  87.     type A_Byte_Array is access all Byte_Array; 
  88.  
  89.     -- A cache record of a tile bitmap retrieved from the scene's tile library. 
  90.     -- A Cached_Bitmap doesn't maintain a copy of the bitmap, but only a 
  91.     -- reference. A Cached_Bitmap should not be used after the scene's tile 
  92.     -- library is unloaded. 
  93.     type Cached_Bitmap is 
  94.         record 
  95.             tileId : Natural := 0; 
  96.             bmp    : A_Bitmap := null; 
  97.         end record; 
  98.  
  99.     -- An array of Cached_Bitmap records. 
  100.     type Cached_Bitmap_Array is array (Natural range <>) of Cached_Bitmap; 
  101.     type A_Cached_Bitmap_Array is access all Cached_Bitmap_Array; 
  102.  
  103.     -- An array of Cached_Bitmap_Arrays. 
  104.     type Bitmap_Cache is array (Natural range <>) of A_Cached_Bitmap_Array; 
  105.     type A_Bitmap_Cache is access all Bitmap_Cache; 
  106.  
  107.     ---------------------------------------------------------------------------- 
  108.  
  109.     type Scene is abstract new Container and Event_Listener with 
  110.         record 
  111.             hasData       : Boolean := False; 
  112.             mapWidth, 
  113.             mapHeight     : Natural := 0; 
  114.             mapLayers     : A_Layer_Array := null; 
  115.             bitmapCache   : A_Bitmap_Cache := null; 
  116.             visibleLayers : A_Boolean_Array := null; 
  117.             lightLevels   : A_Byte_Array := null; 
  118.             spriteLayer   : Integer := Integer'Last;   -- sprites draw on top of this layer 
  119.             tileWidth     : Positive := 1; 
  120.             tileLib       : A_Tile_Library := null; 
  121.             target        : Entity_Id := INVALID_ID;   -- target entity to follow 
  122.             wFocusX,                          -- world coords at center of scene 
  123.             wFocusY       : Float := 0.0;     -- 
  124.             wSlackX,                          -- max pixels target can be from center 
  125.             wSlackY       : Float := 0.0;     -- in world units (changes with zoom) 
  126.             spriteMap     : Sprite_Maps.Map;  -- maps entity id to sprite widget 
  127.             selectedSet   : Widget_Sets.Set;  -- set of selected widgets 
  128.             waitForLoad   : Boolean := False; -- waits for the tile library to 
  129.                                               -- load completely before drawing 
  130.                                               -- any tiles. 
  131.         end record; 
  132.  
  133.     -- Adds a widget to the scene as a child, updating the entity id/sprite map 
  134.     -- as necessary. 'child' will be consumed only if 'consume' is True. 
  135.     -- However, 'child' will be owned by the scene after this call. 
  136.     procedure Add( this    : access Scene; 
  137.                    child   : in out A_Widget; 
  138.                    consume : Boolean := True ); 
  139.     pragma Precondition( child /= null ); 
  140.     pragma Postcondition( consume xor child /= null ); 
  141.  
  142.     -- Unselects all currently selected child widgets. 
  143.     procedure Clear_Selection( this : access Scene ); 
  144.  
  145.     procedure Construct( this : access Scene; 
  146.                          view : not null access Game_Views.Game_View'Class; 
  147.                          id   : String ); 
  148.     pragma Precondition( id'Length > 0 ); 
  149.  
  150.     procedure Delete( this : in out Scene ); 
  151.  
  152.     -- Deletes child widget 'child', updating the sprite map and selection set 
  153.     -- as necessary. 'child' will be consumed. Exception WIDGET_NOT_FOUND will 
  154.     -- be raised if 'child' is not a child of the scene. 
  155.     procedure Delete_Child( this : access Scene; child : in out A_Widget ); 
  156.  
  157.     -- Deletes all child widgets, updating the sprite map and selection set as 
  158.     -- necessary. 
  159.     procedure Delete_Children( this : access Scene ); 
  160.  
  161.     -- Draws the scene's content area, including map layers, to 'dc'. This is 
  162.     -- called twice per widget redraw; once where the drawing context layer 
  163.     -- equals Background and againwhen the drawing context layer equals 
  164.     -- Foreground. The content drawing is split into two calls like this so that 
  165.     -- the background map layers can be drawn in the first call, then after the 
  166.     -- child widgets are drawn, this procedure can be called again to draw the 
  167.     -- map's foreground layers and any additional overlayed graphics on top of 
  168.     -- the widget's children. This makes the Scene widget special, in that it 
  169.     -- can draw both below and on top (ie: behind and in front) of its children. 
  170.     procedure Draw_Content( this : access Scene; dc : Drawing_Context ); 
  171.  
  172.     -- Draws any visuals that should overlay the foreground of the scene within 
  173.     -- the viewport. The signature is similar to Draw_Layer with the exception 
  174.     -- of a layer parameter. The drawing location for the tile at 
  175.     -- 'tileX1','tileY1' is given by 'startX', 'startY'. This procedure is 
  176.     -- called once per redraw, directly after the map and sprites have been 
  177.     -- drawn. 
  178.     procedure Draw_Layer_Overlay( this   : access Scene; 
  179.                                   dc     : Drawing_Context; 
  180.                                   startX, 
  181.                                   startY : Integer; 
  182.                                   tileX1, 
  183.                                   tileY1, 
  184.                                   tileX2, 
  185.                                   tileY2 : Integer ); 
  186.  
  187.     -- Returns a reference to an entity's representative Sprite, which is a 
  188.     -- child widget of the scene. If 'id' is not recognized entity then null 
  189.     -- will be returned. 
  190.     function Find_Sprite( this : not null access Scene'Class; 
  191.                           id   : Entity_Id ) return A_Sprite; 
  192.  
  193.     -- Focus the scene on a point in world coordinates. If the point is already 
  194.     -- within the slack focus area, the viewport will not change. However, if 
  195.     -- centered is set to True then the viewport will ignore slack constraints 
  196.     -- and attempt to center the focal point. 
  197.     procedure Focus_On( this     : not null access Scene'Class; 
  198.                         x, y     : Float; 
  199.                         centered : Boolean := False ); 
  200.  
  201.     -- Returns the minimum height of the scene, taking into account a previously 
  202.     -- specified minimum height or the height of the scene's map in pixels. 
  203.     function Get_Min_Height( this : access Scene ) return Natural; 
  204.  
  205.     -- Returns the minimum width of the scene, taking into account a previously 
  206.     -- specified minimum width or the width of the scene's map in pixels. 
  207.     function Get_Min_Width( this : access Scene ) return Natural; 
  208.  
  209.     -- Handles an Entity_Attribute_Changed event by calling Set_Attribute on 
  210.     -- the affected entity's Sprite. 
  211.     procedure Handle_Entity_Attribute_Changed( this : access Scene; 
  212.                                                evt  : not null A_Entity_Attribute_Changed_Event ); 
  213.  
  214.     -- Handles an Entity_Created event by creating and adding a corresponding 
  215.     -- Sprite child widget to represent the entity, if it is non-metaphysical. 
  216.     procedure Handle_Entity_Created( this : access Scene; 
  217.                                      evt  : not null A_Entity_Created_Event ); 
  218.  
  219.     -- Handles an Entity_Deleted event by deleting the entity's corresponding 
  220.     -- Sprite, if it has one. 
  221.     procedure Handle_Entity_Deleted( this : access Scene; 
  222.                                      evt  : not null A_Entity_Deleted_Event ); 
  223.  
  224.     -- Handles an Entity_Moved event by moving the entity's corresponding Sprite 
  225.     -- and focusing the viewport on the entity, if it's the scene's target. 
  226.     procedure Handle_Entity_Moved( this : access Scene; 
  227.                                    evt  : not null A_Entity_Moved_Event ); 
  228.  
  229.     -- Handles an Entity_Resized event by resizing the entity's corresponding 
  230.     -- Sprite. 
  231.     procedure Handle_Entity_Resized( this : access Scene; 
  232.                                      evt  : not null A_Entity_Resized_Event ); 
  233.  
  234.     -- Handles an event received from the corral is registered with. This is the 
  235.     -- same corral provided by the Game View system's Game_View object. If 'evt' 
  236.     -- is returned null then the event was consumed. 
  237.     procedure Handle_Event( this : access Scene; 
  238.                             evt  : in out A_Event; 
  239.                             resp : out Response_Type ); 
  240.     pragma Precondition( evt /= null ); 
  241.  
  242.     -- Handles a Frame_Changed event by changing the image of the entity's 
  243.     -- corresponding Sprite. 
  244.     procedure Handle_Frame_Changed( this : access Scene; 
  245.                                     evt  : not null A_Frame_Changed_Event ); 
  246.  
  247.     -- Handles a New_World event by clearing the scene's current map and all 
  248.     -- child widgets, and loading the new world's tile library and map. No 
  249.     -- sprites will be added yet because the New_World event does not contain 
  250.     -- entity information. A series of Entity_Created events will follow to 
  251.     -- populate the world's entities in the scene. 
  252.     procedure Handle_New_World( this : access Scene; 
  253.                                 evt  : not null A_New_World_Event ); 
  254.  
  255.     -- Handles a widget resize, keeping the target entity in focus, if a target 
  256.     -- entity has been specified. 
  257.     procedure Handle_Resize( this : access Scene ); 
  258.  
  259.     -- Handles a Tile_Changed event by updating the specified tile in the 
  260.     -- scene's tile map. 
  261.     procedure Handle_Tile_Changed( this : access Scene; 
  262.                                    evt  : not null A_Tile_Changed_Event ); 
  263.  
  264.     -- Handles a World_Property_Changed event. This implementation of this 
  265.     -- procedure does nothing. It is intended to be overridden as necessary, 
  266.     -- to handle changes to project-specific world properties. 
  267.     procedure Handle_World_Property_Changed( this : access Scene; 
  268.                                              evt  : not null A_World_Property_Changed_Event ); 
  269.  
  270.     -- Returns True if the tile at 'x','y' in layer 'layer' of the scene's map 
  271.     -- is currently visible in the scene's viewport. 
  272.     function Is_Tile_Visible( this  : not null access Scene'Class; 
  273.                               layer : Positive; 
  274.                               x, y  : Integer ) return Boolean; 
  275.  
  276.     -- Removes a child widget from the scene, updating the sprite map and 
  277.     -- selection set as necessary. 'child' will belong to the caller. 
  278.     procedure Remove( this : access Scene; child : not null A_Widget ); 
  279.  
  280.     ---------------------------------------------------------------------------- 
  281.  
  282.     -- Deletes a Boolean_Array. 
  283.     procedure Delete( ba : in out A_Boolean_Array ); 
  284.  
  285.     -- Deletes a Byte_Array. 
  286.     procedure Delete( ba : in out A_Byte_Array ); 
  287.  
  288.     -- Deletes a Bitmap_Cache record. The bitmap referenced by this record is 
  289.     -- not owned so it will not be touched. 
  290.     procedure Delete( bc : in out A_Bitmap_Cache ); 
  291.  
  292. end Widgets.Containers.Scenes;