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 Actions; 
  10.  
  11. private with Tiles; 
  12. private with Tiles.Libraries; 
  13.  
  14. pragma Warnings( Off, Actions ); 
  15. pragma Elaborate_All( Actions ); 
  16.  
  17. package Widgets.Progress_Boards is 
  18.  
  19.     type PBoard_Action is new Action with private; 
  20.     type A_PBoard_Action is access all PBoard_Action'Class; 
  21.  
  22.     Opened : constant Action_Id; 
  23.     Closed : constant Action_Id; 
  24.  
  25.     ---------------------------------------------------------------------------- 
  26.  
  27.     -- This is the interface to implement in order to listen to progress board 
  28.     -- actions. When an action occurs, the listener will be notified of the type 
  29.     -- of action performed and the progress board that performed the action. 
  30.     type PBoard_Listener is limited interface and Action_Listener; 
  31.     type A_PBoard_Listener is access all PBoard_Listener'Class; 
  32.  
  33.     procedure Handle_Action( this   : access PBoard_Listener; 
  34.                              action : A_PBoard_Action ) is abstract; 
  35.  
  36.     ---------------------------------------------------------------------------- 
  37.  
  38.     type Progress_Board is new Widget and Animated with private; 
  39.     type A_Progress_Board is access all Progress_Board'Class; 
  40.  
  41.     function Create_Progress_Board( view    : not null access Game_Views.Game_View'Class; 
  42.                                     id      : String; 
  43.                                     libName : String ) return A_Progress_Board; 
  44.     pragma Precondition( id'Length > 0 ); 
  45.     pragma Precondition( libName'Length > 0 ); 
  46.     pragma Postcondition( Create_Progress_Board'Result /= null ); 
  47.  
  48.     procedure Add_Listener( this     : access Progress_Board; 
  49.                             listener : not null A_PBoard_Listener ); 
  50.  
  51.     -- Returns true if the board is not currently closed. It may be fully open 
  52.     -- or sliding in either direction. 
  53.     function Is_Open( this : access Progress_Board ) return Boolean; 
  54.  
  55.     procedure Remove_Listener( this     : access Progress_Board; 
  56.                                listener : not null A_PBoard_Listener ); 
  57.  
  58.     procedure Set_Ammo( this : not null access Progress_Board'Class; ammo : Natural ); 
  59.  
  60.     procedure Set_Ancients( this : not null access Progress_Board'Class; ancients : Natural ); 
  61.  
  62.     procedure Set_Blue_Key( this : not null access Progress_Board'Class; blueKey : Boolean ); 
  63.  
  64.     procedure Set_Drops( this : not null access Progress_Board'Class; drops : Natural ); 
  65.  
  66.     procedure Set_Green_Key( this : not null access Progress_Board'Class; greenKey : Boolean ); 
  67.  
  68.     procedure Set_Lives( this : not null access Progress_Board'Class; lives : Natural ); 
  69.  
  70.     procedure Set_Location( this : not null access Progress_Board'Class; location : String ); 
  71.  
  72.     procedure Set_Next_Life( this : not null access Progress_Board'Class; nextLife : Natural ); 
  73.  
  74.     procedure Set_Points( this : not null access Progress_Board'Class; points : Natural ); 
  75.  
  76.     procedure Set_Red_Key( this : not null access Progress_Board'Class; redKey : Boolean ); 
  77.  
  78.     procedure Set_Scuba( this : not null access Progress_Board'Class; scuba : Boolean ); 
  79.  
  80.     procedure Set_Yellow_Key( this : not null access Progress_Board'Class; yellowKey : Boolean ); 
  81.  
  82.     procedure Show( this : access Progress_Board; enabled : Boolean ); 
  83.  
  84.     -- Toggles the open/closed state of the progress board. Calling this is 
  85.     -- equivalent to this.Show( not this.Is_Open ). 
  86.     procedure Toggle( this : access Progress_Board ); 
  87.  
  88. private 
  89.  
  90.     use Tiles; 
  91.     use Tiles.Libraries; 
  92.  
  93.     ---------------------------------------------------------------------------- 
  94.  
  95.     type PBoard_Action is new Action with null record; 
  96.  
  97.     Opened : constant Action_Id := To_Action_Id( "progress_board.opened" ); 
  98.     Closed : constant Action_Id := To_Action_Id( "progress_board.closed" ); 
  99.  
  100.     ---------------------------------------------------------------------------- 
  101.  
  102.     type Progress_Board is new Widget and Animated with 
  103.         record 
  104.             lib          : A_Tile_Library := null;    -- may be null if library cant load 
  105.             backgroundId : Natural := 0;              -- id of background tile 
  106.             digitId      : Tile_Id_Array(0..9) := (others => 0);  -- tile ids for digit icons 
  107.             ammo         : Natural := 0; 
  108.             ancients     : Natural := 0; 
  109.             blueKey      : Boolean := False; 
  110.             drops        : Natural := 0; 
  111.             greenKey     : Boolean := False; 
  112.             lives        : Natural := 0; 
  113.             location     : Unbounded_String; 
  114.             points       : Natural := 0; 
  115.             nextLife     : Natural := 0; 
  116.             redKey       : Boolean := False; 
  117.             scuba        : Boolean := False; 
  118.             yellowKey    : Boolean := False; 
  119.             ancientId, 
  120.             redKeyId, 
  121.             blueKeyId, 
  122.             yellowKeyId, 
  123.             greenKeyId   : Natural := 0;   -- tile ids for key icons 
  124.             slideDelay   : Float := 0.3;   -- seconds to fully slide up/down 
  125.             slideDir     : Integer := 0;   -- <0 = up, >0 = down 
  126.             slidePos     : Float := -1.0;  -- bottom of the board within its parent 
  127.         end record; 
  128.  
  129.     procedure Construct( this    : access Progress_Board; 
  130.                          view    : not null access Game_Views.Game_View'Class; 
  131.                          id      : String; 
  132.                          libName : String ); 
  133.     pragma Precondition( id'Length > 0 ); 
  134.     pragma Precondition( libName'Length > 0 ); 
  135.  
  136.     procedure Delete( this : in out Progress_Board ); 
  137.  
  138.     procedure Dispatch_Action( this : access Progress_Board; id : Action_Id ); 
  139.  
  140.     procedure Draw_Content( this : access Progress_Board ); 
  141.  
  142.     procedure Tick( this : access Progress_Board; time : Tick_Time ); 
  143.  
  144. end Widgets.Progress_Boards;