1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Actions; 
  10.  
  11. pragma Warnings( Off, Actions ); 
  12. pragma Elaborate_All( Actions ); 
  13.  
  14. package Widgets.Input_Boxes is 
  15.  
  16.     -- Represents a widget action involving an Input_Box, such as a input event. 
  17.     type Input_Action is new Action with private; 
  18.     type A_Input_Action is access all Input_Action'Class; 
  19.  
  20.     Entered : constant Action_Id;             -- the enter key was pressed 
  21.  
  22.     -- This is the interface to implement in order to listen to input actions. 
  23.     -- When an input action occurs, the listener will be notified of the type of 
  24.     -- action performed and the input box that performed the action. 
  25.     type Input_Listener is limited interface and Action_Listener; 
  26.     type A_Input_Listener is access all Input_Listener'Class; 
  27.  
  28.     -- Handles the input action 'action'. 
  29.     procedure Handle_Action( this   : access Input_Listener; 
  30.                              action : A_Input_Action ) is abstract; 
  31.  
  32.     ---------------------------------------------------------------------------- 
  33.  
  34.     -- An access to a string constraint function. A constraint function returns 
  35.     -- 'newstr' if it meets the constraint, otherwise 'curstr' will be returned. 
  36.     type A_Constrain_Func is 
  37.         access function( curstr, newstr : String ) return String; 
  38.  
  39.     ---------------------------------------------------------------------------- 
  40.  
  41.     -- An Input_Box widget allows a single line of text to be edited with the 
  42.     -- keyboard. The text of the input box can be larger than the width of the 
  43.     -- width; the portion of the text near the cursor will be displayed. 
  44.     type Input_Box is new Widget with private; 
  45.     type A_Input_Box is access all Input_Box'Class; 
  46.  
  47.     -- Creates a new Input_Box within 'view' with id 'id'. 
  48.     function Create_Input_Box( view : not null access Game_Views.Game_View'Class; 
  49.                                id   : String ) return A_Input_Box; 
  50.     pragma Precondition( id'Length > 0 ); 
  51.     pragma Postcondition( Create_Input_Box'Result /= null ); 
  52.  
  53.     -- Registers 'listener' as an Input_Action listener. 
  54.     procedure Add_Listener( this     : access Input_Box; 
  55.                             listener : not null A_Input_Listener ); 
  56.  
  57.     -- Returns the input box's text. 
  58.     function Get_Text( this : access Input_Box ) return String; 
  59.  
  60.     -- Unregisters 'listener' as an Input_Action listener. 
  61.     procedure Remove_Listener( this     : access Input_Box; 
  62.                                listener : not null A_Input_Listener ); 
  63.  
  64.     -- Sets a constraint function to validate the input box's text. If 
  65.     -- 'constraint' is null, any text can be added. No text can be entered into 
  66.     -- the input box that is not validated by the constraint function. 
  67.     procedure Set_Constraint( this       : access Input_Box; 
  68.                               constraint : A_Constrain_Func ); 
  69.  
  70.     -- Sets the maximum length of the input box's text in characters. 
  71.     procedure Set_Max_Length( this : access Input_Box; maxlen : Positive ); 
  72.  
  73.     -- Sets the input box's text value. The value will remain unchanged if 
  74.     -- 'text' is not accepted by the current constraint function. 
  75.     procedure Set_Text( this : access Input_Box; text : String ); 
  76.  
  77. private 
  78.  
  79.     -- direction to move the cursor on a key press 
  80.     type Move_Dir is (Go_First, Go_Left, Go_Right, Go_Last); 
  81.  
  82.     ---------------------------------------------------------------------------- 
  83.  
  84.     type Input_Action is new Action with null record; 
  85.  
  86.     Entered : constant Action_Id := To_Action_Id( "input.entered" ); 
  87.  
  88.     ---------------------------------------------------------------------------- 
  89.  
  90.     type Input_Box is new Widget with 
  91.         record 
  92.             text      : Unbounded_String; 
  93.             cursor    : Natural := 0; 
  94.             firstchar : Natural := 0;   -- first character to draw. this is 0 
  95.                                         --   unless the text is too long to fit 
  96.                                         --   in the content area of the widget. 
  97.             lastchar  : Natural := 0;   -- last character to draw. this is the 
  98.                                         --   length of text unless the text is 
  99.                                         --   too long to fit in the content area 
  100.                                         --   of the widget. 
  101.             constrain : A_Constrain_Func := null; 
  102.             maxlen    : Positive := 1024; 
  103.         end record; 
  104.  
  105.     procedure Construct( this : access Input_Box; 
  106.                          view : not null access Game_Views.Game_View'Class; 
  107.                          id   : String ); 
  108.     pragma Precondition( id'Length >  0 ); 
  109.  
  110.     -- Inserts 'char' into the input box's value to the right of the cursor 
  111.     -- position. If the updated text exceeds the max length or it does not 
  112.     -- validate with the input box's constraint function, the character will not 
  113.     -- be added. 
  114.     procedure Add_Character( this : not null access Input_Box'Class; 
  115.                              char : Character ); 
  116.  
  117.     -- Adjusts the range of the text that is visible in input box if it's too 
  118.     -- long to fit in the widget's screen space, keeping the cursor in sight. 
  119.     procedure Adjust_Visible_Text( this : not null access Input_Box'Class ); 
  120.  
  121.     -- Dispatches Action_Id 'id' to all registered Input_Action listeners. 
  122.     procedure Dispatch_Action( this : access Input_Box; id : Action_Id ); 
  123.  
  124.     -- Deletes the character to the left of the cursor, if there is one, and if 
  125.     -- the resulting text doesn't violate the constraint function. 
  126.     procedure Do_Backspace( this : not null access Input_Box'Class ); 
  127.  
  128.     -- Deletes the character to the right of the cursor, if there is one, and if 
  129.     -- the resulting text doesn't violate the constraint function. 
  130.     procedure Do_Delete( this : not null access Input_Box'Class ); 
  131.  
  132.     -- Enters the current text, firing the 'Entered' Input_Action. This is 
  133.     -- called when the Enter key is pressed. 
  134.     procedure Do_Enter( this : not null access Input_Box'Class ); 
  135.  
  136.     procedure Draw_Content( this : access Input_Box ); 
  137.  
  138.     procedure On_Key_Typed( this    : access Input_Box; 
  139.                             evt     : not null A_Key_Typed_Event; 
  140.                             handled : in out Boolean ); 
  141.  
  142.     -- Moves the cursor in the direction 'dir', if possible. The visible portion 
  143.     -- of the text will be adjusted to always keep the cursor in view. 
  144.     procedure Move_Cursor( this : not null access Input_Box'Class; dir : Move_Dir ); 
  145.  
  146.     procedure On_Mouse_Press( this : access Input_Box; 
  147.                               evt  : not null A_Mouse_Button_Event ); 
  148.  
  149.     -- Adjusts the visible text after packing the widget. 
  150.     procedure Pack( this : access Input_Box ); 
  151.  
  152. end Widgets.Input_Boxes;