private with Ada.Real_Time;
private with Allegro.Keyboard;
package Widgets.Input_Boxes is
type Input_Action is new Action with private;
type A_Input_Action is access all Input_Action'Class;
Entered : constant Action_Id;
type Input_Listener is limited interface and Action_Listener;
type A_Input_Listener is access all Input_Listener'Class;
procedure Handle_Action( this : access Input_Listener;
action : A_Input_Action ) is abstract;
type A_Input_Handler is
access procedure( action : A_Input_Action );
type A_Constrain_Func is
access function( curstr, newstr : String ) return String;
type Input_Box is new Widget with private;
type A_Input_Box is access all Input_Box'Class;
function Create_Input_Box( view : not null access Game_Views.Game_View'Class;
id : String ) return A_Input_Box;
pragma Precondition( id'Length > 0 );
pragma Postcondition( Create_Input_Box'Result /= null );
procedure Add_Listener( this : access Input_Box;
listener : not null A_Input_Listener );
procedure Add_Listener( this : access Input_Box;
handler : not null A_Input_Handler );
function Get_Text( this : access Input_Box ) return String;
procedure Remove_Listener( this : access Input_Box;
listener : not null A_Input_Listener );
procedure Set_Constraint( this : access Input_Box;
constraint : A_Constrain_Func );
procedure Set_Max_Length( this : access Input_Box; maxlen : Positive );
procedure Set_Text( this : access Input_Box; text : String );
private
use Ada.Real_Time;
use Allegro.Keyboard;
type Move_Dir is (Go_First, Go_Left, Go_Right, Go_Last);
type Key_Delay_Array is array (1..KEY_MAX) of Time;
type Direction_Type is (From_First, From_Last);
type Input_Action is new Action with null record;
Entered : constant Action_Id := To_Action_Id( "input.entered" );
procedure Delete( this : in out A_Input_Action );
pragma Postcondition( this = null );
type Simple_Input_Listener is new Simple_Action_Listener and Input_Listener with
record
handler : A_Input_Handler := null;
end record;
type A_Simple_Input_Listener is access all Simple_Input_Listener'Class;
function Create_Listener( handler : not null A_Input_Handler ) return A_Input_Listener;
pragma Postcondition( Create_Listener'Result /= null );
procedure Handle_Action( this : access Simple_Input_Listener;
action : A_Input_Action );
type Input_Box is new Widget with
record
text : Unbounded_String;
cursor : Natural := 0;
firstchar : Natural := 0;
lastchar : Natural := 0;
constrain : A_Constrain_Func := null;
maxlen : Positive := 1024;
key_delay : Key_Delay_Array;
end record;
procedure Add_Character( this : not null access Input_Box'Class;
char : Character );
procedure Adjust_Visible_Text( this : not null access Input_Box'Class );
procedure Construct( this : access Input_Box;
view : not null access Game_Views.Game_View'Class;
id : String );
pragma Precondition( id'Length > 0 );
procedure Dispatch_Action( this : access Input_Box; id : Action_Id );
procedure Do_Backspace( this : not null access Input_Box'Class );
procedure Do_Delete( this : not null access Input_Box'Class );
procedure Do_Enter( this : not null access Input_Box'Class );
procedure Draw_Content( this : access Input_Box; dc : Drawing_Context );
function Handle_Key_Held( this : access Input_Box;
evt : not null A_Key_Event ) return Boolean;
function Handle_Key_Press( this : access Input_Box;
evt : not null A_Key_Event ) return Boolean;
function Handle_Key_Release( this : access Input_Box;
evt : not null A_Key_Event ) return Boolean;
procedure Handle_Mouse_Press( this : access Input_Box;
evt : not null A_Mouse_Button_Event );
procedure Move_Cursor( this : not null access Input_Box'Class; dir : Move_Dir );
procedure Pack( this : access Input_Box );
end Widgets.Input_Boxes;