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