| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT ncurses Binding Samples -- |
| -- -- |
| -- Sample.Keyboard_Handler -- |
| -- -- |
| -- B O D Y -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| -- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. -- |
| -- -- |
| -- Permission is hereby granted, free of charge, to any person obtaining a -- |
| -- copy of this software and associated documentation files (the -- |
| -- "Software"), to deal in the Software without restriction, including -- |
| -- without limitation the rights to use, copy, modify, merge, publish, -- |
| -- distribute, distribute with modifications, sublicense, and/or sell -- |
| -- copies of the Software, and to permit persons to whom the Software is -- |
| -- furnished to do so, subject to the following conditions: -- |
| -- -- |
| -- The above copyright notice and this permission notice shall be included -- |
| -- in all copies or substantial portions of the Software. -- |
| -- -- |
| -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- |
| -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- |
| -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- |
| -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- |
| -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- |
| -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- |
| -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- |
| -- -- |
| -- Except as contained in this notice, the name(s) of the above copyright -- |
| -- holders shall not be used in advertising or otherwise to promote the -- |
| -- sale, use or other dealings in this Software without prior written -- |
| -- authorization. -- |
| ------------------------------------------------------------------------------ |
| -- Author: Juergen Pfeifer, 1996 |
| -- Version Control |
| -- $Revision: 1.14 $ |
| -- $Date: 2006/06/25 14:30:22 $ |
| -- Binding Version 01.00 |
| ------------------------------------------------------------------------------ |
| with Ada.Strings; use Ada.Strings; |
| with Ada.Strings.Fixed; use Ada.Strings.Fixed; |
| with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; |
| with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; |
| with Ada.Characters.Handling; use Ada.Characters.Handling; |
| |
| with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; |
| with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms; |
| with Terminal_Interface.Curses.Forms.Field_Types.Enumeration; |
| use Terminal_Interface.Curses.Forms.Field_Types.Enumeration; |
| |
| with Sample.Header_Handler; use Sample.Header_Handler; |
| with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux; |
| with Sample.Manifest; use Sample.Manifest; |
| with Sample.Form_Demo.Handler; |
| |
| -- This package contains a centralized keyboard handler used throughout |
| -- this example. The handler establishes a timeout mechanism that provides |
| -- periodical updates of the common header lines used in this example. |
| -- |
| |
| package body Sample.Keyboard_Handler is |
| |
| In_Command : Boolean := False; |
| |
| function Get_Key (Win : Window := Standard_Window) return Real_Key_Code |
| is |
| K : Real_Key_Code; |
| |
| function Command return Real_Key_Code; |
| |
| function Command return Real_Key_Code |
| is |
| function My_Driver (F : Form; |
| C : Key_Code; |
| P : Panel) return Boolean; |
| package Fh is new Sample.Form_Demo.Handler (My_Driver); |
| |
| type Label_Array is array (Label_Number) of String (1 .. 8); |
| |
| Labels : Label_Array; |
| |
| FA : Field_Array_Access := new Field_Array' |
| (Make (0, 0, "Command:"), |
| Make (Top => 0, Left => 9, Width => Columns - 11), |
| Null_Field); |
| |
| K : Real_Key_Code := Key_None; |
| N : Natural := 0; |
| |
| function My_Driver (F : Form; |
| C : Key_Code; |
| P : Panel) return Boolean |
| is |
| Ch : Character; |
| begin |
| if P = Null_Panel then |
| raise Panel_Exception; |
| end if; |
| if C in User_Key_Code'Range and then C = QUIT then |
| if Driver (F, F_Validate_Field) = Form_Ok then |
| K := Key_None; |
| return True; |
| end if; |
| elsif C in Normal_Key_Code'Range then |
| Ch := Character'Val (C); |
| if Ch = LF or else Ch = CR then |
| if Driver (F, F_Validate_Field) = Form_Ok then |
| declare |
| Buffer : String (1 .. Positive (Columns - 11)); |
| Cmdc : String (1 .. 8); |
| begin |
| Get_Buffer (Fld => FA (2), Str => Buffer); |
| Trim (Buffer, Left); |
| if Buffer (1) /= ' ' then |
| Cmdc := To_Upper (Buffer (Cmdc'Range)); |
| for I in Labels'Range loop |
| if Cmdc = Labels (I) then |
| K := Function_Key_Code |
| (Function_Key_Number (I)); |
| exit; |
| end if; |
| end loop; |
| end if; |
| return True; |
| end; |
| end if; |
| end if; |
| end if; |
| return False; |
| end My_Driver; |
| |
| begin |
| In_Command := True; |
| for I in Label_Number'Range loop |
| Get_Soft_Label_Key (I, Labels (I)); |
| Trim (Labels (I), Left); |
| Translate (Labels (I), Upper_Case_Map); |
| if Labels (I) (1) /= ' ' then |
| N := N + 1; |
| end if; |
| end loop; |
| if N > 0 then -- some labels were really set |
| declare |
| Enum_Info : Enumeration_Info (N); |
| Enum_Field : Enumeration_Field; |
| J : Positive := Enum_Info.Names'First; |
| |
| Frm : Form := Create (FA); |
| |
| begin |
| for I in Label_Number'Range loop |
| if Labels (I) (1) /= ' ' then |
| Enum_Info.Names (J) := new String'(Labels (I)); |
| J := J + 1; |
| end if; |
| end loop; |
| Enum_Field := Create (Enum_Info, True); |
| Set_Field_Type (FA (2), Enum_Field); |
| Set_Background (FA (2), Normal_Video); |
| |
| Fh.Drive_Me (Frm, Lines - 3, 0); |
| Delete (Frm); |
| Update_Panels; Update_Screen; |
| end; |
| end if; |
| Free (FA, True); |
| In_Command := False; |
| return K; |
| end Command; |
| |
| begin |
| Set_Timeout_Mode (Win, Delayed, 30000); |
| loop |
| K := Get_Keystroke (Win); |
| if K = Key_None then -- a timeout occured |
| Update_Header_Window; |
| elsif K = 3 and then not In_Command then -- CTRL-C |
| K := Command; |
| exit when K /= Key_None; |
| else |
| exit; |
| end if; |
| end loop; |
| return K; |
| end Get_Key; |
| |
| procedure Init_Keyboard_Handler is |
| begin |
| null; |
| end Init_Keyboard_Handler; |
| |
| end Sample.Keyboard_Handler; |
