with Actions;
private with Tiles;
private with Tiles.Libraries;
pragma Warnings( Off, Actions );
pragma Elaborate_All( Actions );
package Widgets.Progress_Boards is
type PBoard_Action is new Action with private;
type A_PBoard_Action is access all PBoard_Action'Class;
Opened : constant Action_Id;
Closed : constant Action_Id;
type PBoard_Listener is limited interface and Action_Listener;
type A_PBoard_Listener is access all PBoard_Listener'Class;
procedure Handle_Action( this : access PBoard_Listener;
action : A_PBoard_Action ) is abstract;
type Progress_Board is new Widget and Animated with private;
type A_Progress_Board is access all Progress_Board'Class;
function Create_Progress_Board( view : not null access Game_Views.Game_View'Class;
id : String;
libName : String ) return A_Progress_Board;
pragma Precondition( id'Length > 0 );
pragma Precondition( libName'Length > 0 );
pragma Postcondition( Create_Progress_Board'Result /= null );
procedure Add_Listener( this : access Progress_Board;
listener : not null A_PBoard_Listener );
function Is_Open( this : access Progress_Board ) return Boolean;
procedure Remove_Listener( this : access Progress_Board;
listener : not null A_PBoard_Listener );
procedure Set_Ammo( this : not null access Progress_Board'Class; ammo : Natural );
procedure Set_Ancients( this : not null access Progress_Board'Class; ancients : Natural );
procedure Set_Blue_Key( this : not null access Progress_Board'Class; blueKey : Boolean );
procedure Set_Drops( this : not null access Progress_Board'Class; drops : Natural );
procedure Set_Green_Key( this : not null access Progress_Board'Class; greenKey : Boolean );
procedure Set_Lives( this : not null access Progress_Board'Class; lives : Natural );
procedure Set_Location( this : not null access Progress_Board'Class; location : String );
procedure Set_Next_Life( this : not null access Progress_Board'Class; nextLife : Natural );
procedure Set_Points( this : not null access Progress_Board'Class; points : Natural );
procedure Set_Red_Key( this : not null access Progress_Board'Class; redKey : Boolean );
procedure Set_Scuba( this : not null access Progress_Board'Class; scuba : Boolean );
procedure Set_Yellow_Key( this : not null access Progress_Board'Class; yellowKey : Boolean );
procedure Show( this : access Progress_Board; enabled : Boolean );
procedure Toggle( this : access Progress_Board );
private
use Tiles;
use Tiles.Libraries;
type PBoard_Action is new Action with null record;
Opened : constant Action_Id := To_Action_Id( "progress_board.opened" );
Closed : constant Action_Id := To_Action_Id( "progress_board.closed" );
type Progress_Board is new Widget and Animated with
record
lib : A_Tile_Library := null;
backgroundId : Natural := 0;
digitId : Tile_Id_Array(0..9) := (others => 0);
ammo : Natural := 0;
ancients : Natural := 0;
blueKey : Boolean := False;
drops : Natural := 0;
greenKey : Boolean := False;
lives : Natural := 0;
location : Unbounded_String;
points : Natural := 0;
nextLife : Natural := 0;
redKey : Boolean := False;
scuba : Boolean := False;
yellowKey : Boolean := False;
ancientId,
redKeyId,
blueKeyId,
yellowKeyId,
greenKeyId : Natural := 0;
slideDelay : Float := 0.3;
slideDir : Integer := 0;
slidePos : Float := -1.0;
end record;
procedure Construct( this : access Progress_Board;
view : not null access Game_Views.Game_View'Class;
id : String;
libName : String );
pragma Precondition( id'Length > 0 );
pragma Precondition( libName'Length > 0 );
procedure Delete( this : in out Progress_Board );
procedure Dispatch_Action( this : access Progress_Board; id : Action_Id );
procedure Draw_Content( this : access Progress_Board );
procedure Tick( this : access Progress_Board; time : Tick_Time );
end Widgets.Progress_Boards;