with Actions;
with Ada.Real_Time; use Ada.Real_Time;
with Processes; use Processes;
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 A_PBoard_Handler is
access procedure( action : A_PBoard_Action );
type Progress_Board is new Widget and Process 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 );
procedure Add_Listener( this : access Progress_Board;
handler : not null A_PBoard_Handler );
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 : access Progress_Board; ammo : Natural );
procedure Set_Ancients( this : access Progress_Board; ancients : Natural );
procedure Set_Blue_Key( this : access Progress_Board; blueKey : Boolean );
procedure Set_Drops( this : access Progress_Board; drops : Natural );
procedure Set_Green_Key( this : access Progress_Board; greenKey : Boolean );
procedure Set_Lives( this : access Progress_Board; lives : Natural );
procedure Set_Location( this : access Progress_Board; location : String );
procedure Set_Next_Life( this : access Progress_Board; nextLife : Natural );
procedure Set_Points( this : access Progress_Board; points : Natural );
procedure Set_Red_Key( this : access Progress_Board; redKey : Boolean );
procedure Set_Scuba( this : access Progress_Board; scuba : Boolean );
procedure Set_Yellow_Key( this : access Progress_Board; 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" );
procedure Delete( this : in out A_PBoard_Action );
pragma Postcondition( this = null );
type Simple_PBoard_Listener is new Simple_Action_Listener and PBoard_Listener with
record
handler : A_PBoard_Handler := null;
end record;
type A_Simple_PBoard_Listener is access all Simple_PBoard_Listener'Class;
function Create_Listener( handler : not null A_PBoard_Handler ) return A_PBoard_Listener;
pragma Postcondition( Create_Listener'Result /= null );
procedure Construct( this : access Simple_PBoard_Listener;
handler : not null A_PBoard_Handler );
procedure Handle_Action( this : access Simple_PBoard_Listener;
action : A_PBoard_Action );
type Progress_Board is new Widget and Process 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; dc : Drawing_Context );
function Get_Min_Height( this : access Progress_Board ) return Natural;
function Get_Min_Width( this : access Progress_Board ) return Natural;
function Get_Process_Name( this : access Progress_Board ) return String;
procedure Tick( this : access Progress_Board; upTime, dt : Time_Span );
end Widgets.Progress_Boards;