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