diff options
Diffstat (limited to 'Ada95/samples/sample-keyboard_handler.adb')
| -rw-r--r-- | Ada95/samples/sample-keyboard_handler.adb | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/Ada95/samples/sample-keyboard_handler.adb b/Ada95/samples/sample-keyboard_handler.adb new file mode 100644 index 000000000000..1d3f20c74b4f --- /dev/null +++ b/Ada95/samples/sample-keyboard_handler.adb @@ -0,0 +1,194 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding Samples -- +-- -- +-- Sample.Keyboard_Handler -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2011 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.16 $ +-- $Date: 2011/03/23 00:34:24 $ +-- 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.all (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.all (2), Enum_Field); + Set_Background (FA.all (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 occurred + 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; |