with Actions;
private with Ada.Real_Time;
private with Allegro.Keyboard;
pragma Warnings( Off, Actions );
pragma Elaborate_All( Actions );
package Widgets.Input_Boxes is
-- Represents a widget action involving an Input_Box, such as a input event.
type Input_Action is new Action with private;
type A_Input_Action is access all Input_Action'Class;
Entered : constant Action_Id; -- the enter key was pressed
-- This is the interface to implement in order to listen to input actions.
-- When an input action occurs, the listener will be notified of the type of
-- action performed and the input box that performed the action.
type Input_Listener is limited interface and Action_Listener;
type A_Input_Listener is access all Input_Listener'Class;
-- Handles the input action 'action'.
procedure Handle_Action( this : access Input_Listener;
action : A_Input_Action ) is abstract;
-- A simple procedure to handle an input action, used by Simple_Input_Listener.
type A_Input_Handler is
access procedure( action : A_Input_Action );
----------------------------------------------------------------------------
-- An access to a string constraint function. A constraint function returns
-- 'newstr' if it meets the constraint, otherwise 'curstr' will be returned.
type A_Constrain_Func is
access function( curstr, newstr : String ) return String;
----------------------------------------------------------------------------
-- An Input_Box widget allows a single line of text to be edited with the
-- keyboard. The text of the input box can be larger than the width of the
-- width; the portion of the text near the cursor will be displayed.
type Input_Box is new Widget with private;
type A_Input_Box is access all Input_Box'Class;
-- Creates a new Input_Box within 'view' with id 'id'.
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 );
-- Registers 'listener' as an Input_Action listener.
procedure Add_Listener( this : access Input_Box;
listener : not null A_Input_Listener );
-- Registers 'handler' to be invoked when an Input_Action occurs.
procedure Add_Listener( this : access Input_Box;
handler : not null A_Input_Handler );
-- Returns the input box's text.
function Get_Text( this : access Input_Box ) return String;
-- Unregisters 'listener' as an Input_Action listener.
procedure Remove_Listener( this : access Input_Box;
listener : not null A_Input_Listener );
-- Sets a constraint function to validate the input box's text. If
-- 'constraint' is null, any text can be added. No text can be entered into
-- the input box that is not validated by the constraint function.
procedure Set_Constraint( this : access Input_Box;
constraint : A_Constrain_Func );
-- Sets the maximum length of the input box's text in characters.
procedure Set_Max_Length( this : access Input_Box; maxlen : Positive );
-- Sets the input box's text value. The value will remain unchanged if
-- 'text' is not accepted by the current constraint function.
procedure Set_Text( this : access Input_Box; text : String );
private
use Ada.Real_Time;
use Allegro.Keyboard;
-- direction to move the cursor on a key press
type Move_Dir is (Go_First, Go_Left, Go_Right, Go_Last);
-- an array of time values for each key scancode. this is used for repeating
-- characters when a key is held.
type Key_Delay_Array is array (1..KEY_MAX) of Time;
----------------------------------------------------------------------------
type Input_Action is new Action with null record;
Entered : constant Action_Id := To_Action_Id( "input.entered" );
-- Deletes the Input_Action.
procedure Delete( this : in out A_Input_Action );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- A Simple_Input_Listener is an adapter class that listens for Input_Action
-- events and invokes a callback, A_Input_Handler. This allows callback
-- procedures to handle input actions instead of requiring an object to do
-- so.
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;
-- Creates a Simple_Input_Listener that invokes 'handler' when it receives
-- an input action.
function Create_Listener( handler : not null A_Input_Handler ) return A_Input_Listener;
pragma Postcondition( Create_Listener'Result /= null );
-- Invokes the simple input listener's Input_Handler procedure.
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; -- first character to draw. this is 0
-- unless the text is too long to fit
-- in the content area of the widget.
lastchar : Natural := 0; -- last character to draw. this is the
-- length of text unless the text is
-- too long to fit in the content area
-- of the widget.
constrain : A_Constrain_Func := null;
maxlen : Positive := 1024;
key_delay : Key_Delay_Array;
end record;
-- Inserts 'char' into the input box's value to the right of the cursor
-- position. If the updated text exceeds the max length or it does not
-- validate with the input box's constraint function, the character will not
-- be added.
procedure Add_Character( this : not null access Input_Box'Class;
char : Character );
-- Adjusts the range of the text that is visible in input box if it's too
-- long to fit in the widget's screen space, keeping the cursor in sight.
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 );
-- Dispatches Action_Id 'id' to all registered Input_Action listeners.
procedure Dispatch_Action( this : access Input_Box; id : Action_Id );
-- Deletes the character to the left of the cursor, if there is one, and if
-- the resulting text doesn't violate the constraint function.
procedure Do_Backspace( this : not null access Input_Box'Class );
-- Deletes the character to the right of the cursor, if there is one, and if
-- the resulting text doesn't violate the constraint function.
procedure Do_Delete( this : not null access Input_Box'Class );
-- Enters the current text, firing the 'Entered' Input_Action. This is
-- called when the Enter key is pressed.
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 );
-- Moves the cursor in the direction 'dir', if possible. The visible portion
-- of the text will be adjusted to always keep the cursor in view.
procedure Move_Cursor( this : not null access Input_Box'Class; dir : Move_Dir );
-- Adjusts the visible text after packing the widget.
procedure Pack( this : access Input_Box );
end Widgets.Input_Boxes;