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