1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Keyboard_Handler --
11 -- The ncurses Ada95 binding is copyrighted 1996 by --
12 -- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de --
14 -- Permission is hereby granted to reproduce and distribute this --
15 -- binding by any means and for any fee, whether alone or as part --
16 -- of a larger distribution, in source or in binary form, PROVIDED --
17 -- this notice is included with any such distribution, and is not --
18 -- removed from any of its header files. Mention of ncurses and the --
19 -- author of this binding in any applications linked with it is --
20 -- highly appreciated. --
22 -- This binding comes AS IS with no warranty, implied or expressed. --
23 ------------------------------------------------------------------------------
26 ------------------------------------------------------------------------------
27 with Ada.Strings; use Ada.Strings;
28 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
29 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
30 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
32 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
33 with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
35 with Sample.Header_Handler; use Sample.Header_Handler;
36 with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux;
37 with Sample.Manifest; use Sample.Manifest;
38 with Sample.Form_Demo.Handler;
40 -- This package contains a centralized keyboard handler used throughout
41 -- this example. The handler establishes a timeout mechanism that provides
42 -- periodical updates of the common header lines used in this example.
45 package body Sample.Keyboard_Handler is
47 In_Command : Boolean := False;
49 function Get_Key (Win : Window := Standard_Window) return Real_Key_Code
53 function Command return Real_Key_Code;
56 function Command return Real_Key_Code
58 function My_Driver (F : Form;
60 P : Panel) return Boolean;
61 package Fh is new Sample.Form_Demo.Handler (My_Driver);
63 type Label_Array is array (Label_Number) of String (1 .. 8);
67 FA : Field_Array (1 .. 2) := (Make (0, 0, "Command:"),
68 Make (Top => 0, Left => 9,
69 Width => Columns - 11));
71 K : Real_Key_Code := Key_None;
74 function My_Driver (F : Form;
76 P : Panel) return Boolean
80 if C in User_Key_Code'Range and then C = QUIT then
81 if Driver (F, F_Validate_Field) = Form_Ok then
85 elsif C in Normal_Key_Code'Range then
86 Ch := Character'Val (C);
87 if (Ch = LF or else Ch = CR) then
88 if Driver (F, F_Validate_Field) = Form_Ok then
90 Buffer : String (1 .. Positive (Columns - 11));
91 Cmdc : String (1 .. 8);
93 Get_Buffer (Fld => FA (2), Str => Buffer);
95 if Buffer (1) /= ' ' then
96 Cmdc := Buffer (Cmdc'Range);
97 for I in Labels'Range loop
98 if Cmdc = Labels (I) then
99 K := Function_Key_Code
100 (Function_Key_Number (I));
115 for I in Label_Number'Range loop
116 Get_Soft_Label_Key (I, Labels (I));
117 Trim (Labels (I), Left);
118 Translate (Labels (I), Upper_Case_Map);
119 if Labels (I) (1) /= ' ' then
123 if N > 0 then -- some labels were really set
125 Enum_Info : Enumeration_Info (N);
126 Enum_Field : Enumeration_Field;
127 J : Positive := Enum_Info.Names'First;
129 Frm : Form := Create (FA);
132 for I in Label_Number'Range loop
133 if Labels (I) (1) /= ' ' then
134 Enum_Info.Names (J) := new String'(Labels (I));
138 Enum_Field := Create (Enum_Info, True);
139 Set_Type (FA (2), Enum_Field);
140 Set_Background (FA (2), Normal_Video);
142 Fh.Drive_Me (Frm, Lines - 3, 0);
144 Update_Panels; Update_Screen;
147 for I in FA'Range loop
155 Set_Timeout_Mode (Win, Delayed, 30000);
157 K := Get_Keystroke (Win);
158 if K = Key_None then -- a timeout occured
159 Update_Header_Window;
160 elsif K = 3 and then not In_Command then -- CTRL-C
162 exit when K /= Key_None;
170 procedure Init_Keyboard_Handler is
173 end Init_Keyboard_Handler;
175 end Sample.Keyboard_Handler;