--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
with Actions;
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;
----------------------------------------------------------------------------
-- 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 );
-- 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
-- direction to move the cursor on a key press
type Move_Dir is (Go_First, Go_Left, Go_Right, Go_Last);
----------------------------------------------------------------------------
type Input_Action is new Action with null record;
Entered : constant Action_Id := To_Action_Id( "input.entered" );
----------------------------------------------------------------------------
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;
end record;
procedure Construct( this : access Input_Box;
view : not null access Game_Views.Game_View'Class;
id : String );
pragma Precondition( id'Length > 0 );
-- 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 );
-- 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 );
procedure On_Key_Typed( this : access Input_Box;
evt : not null A_Key_Typed_Event;
handled : in out Boolean );
-- 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 );
procedure On_Mouse_Press( this : access Input_Box;
evt : not null A_Mouse_Button_Event );
-- Adjusts the visible text after packing the widget.
procedure Pack( this : access Input_Box );
end Widgets.Input_Boxes;