1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Keyboard_Handler -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020 Thomas E. Dickey -- 11-- Copyright 1998-2006,2011 Free Software Foundation, Inc. -- 12-- -- 13-- Permission is hereby granted, free of charge, to any person obtaining a -- 14-- copy of this software and associated documentation files (the -- 15-- "Software"), to deal in the Software without restriction, including -- 16-- without limitation the rights to use, copy, modify, merge, publish, -- 17-- distribute, distribute with modifications, sublicense, and/or sell -- 18-- copies of the Software, and to permit persons to whom the Software is -- 19-- furnished to do so, subject to the following conditions: -- 20-- -- 21-- The above copyright notice and this permission notice shall be included -- 22-- in all copies or substantial portions of the Software. -- 23-- -- 24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- 25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- 26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- 27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- 28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- 29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- 30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- 31-- -- 32-- Except as contained in this notice, the name(s) of the above copyright -- 33-- holders shall not be used in advertising or otherwise to promote the -- 34-- sale, use or other dealings in this Software without prior written -- 35-- authorization. -- 36------------------------------------------------------------------------------ 37-- Author: Juergen Pfeifer, 1996 38-- Version Control 39-- $Revision: 1.17 $ 40-- $Date: 2020/02/02 23:34:34 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43with Ada.Strings; use Ada.Strings; 44with Ada.Strings.Fixed; use Ada.Strings.Fixed; 45with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; 46with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; 47with Ada.Characters.Handling; use Ada.Characters.Handling; 48 49with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; 50with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms; 51with Terminal_Interface.Curses.Forms.Field_Types.Enumeration; 52use Terminal_Interface.Curses.Forms.Field_Types.Enumeration; 53 54with Sample.Header_Handler; use Sample.Header_Handler; 55with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux; 56with Sample.Manifest; use Sample.Manifest; 57with Sample.Form_Demo.Handler; 58 59-- This package contains a centralized keyboard handler used throughout 60-- this example. The handler establishes a timeout mechanism that provides 61-- periodical updates of the common header lines used in this example. 62-- 63 64package body Sample.Keyboard_Handler is 65 66 In_Command : Boolean := False; 67 68 function Get_Key (Win : Window := Standard_Window) return Real_Key_Code 69 is 70 K : Real_Key_Code; 71 72 function Command return Real_Key_Code; 73 74 function Command return Real_Key_Code 75 is 76 function My_Driver (F : Form; 77 C : Key_Code; 78 P : Panel) return Boolean; 79 package Fh is new Sample.Form_Demo.Handler (My_Driver); 80 81 type Label_Array is array (Label_Number) of String (1 .. 8); 82 83 Labels : Label_Array; 84 85 FA : Field_Array_Access := new Field_Array' 86 (Make (0, 0, "Command:"), 87 Make (Top => 0, Left => 9, Width => Columns - 11), 88 Null_Field); 89 90 K : Real_Key_Code := Key_None; 91 N : Natural := 0; 92 93 function My_Driver (F : Form; 94 C : Key_Code; 95 P : Panel) return Boolean 96 is 97 Ch : Character; 98 begin 99 if P = Null_Panel then 100 raise Panel_Exception; 101 end if; 102 if C in User_Key_Code'Range and then C = QUIT then 103 if Driver (F, F_Validate_Field) = Form_Ok then 104 K := Key_None; 105 return True; 106 end if; 107 elsif C in Normal_Key_Code'Range then 108 Ch := Character'Val (C); 109 if Ch = LF or else Ch = CR then 110 if Driver (F, F_Validate_Field) = Form_Ok then 111 declare 112 Buffer : String (1 .. Positive (Columns - 11)); 113 Cmdc : String (1 .. 8); 114 begin 115 Get_Buffer (Fld => FA.all (2), Str => Buffer); 116 Trim (Buffer, Left); 117 if Buffer (1) /= ' ' then 118 Cmdc := To_Upper (Buffer (Cmdc'Range)); 119 for I in Labels'Range loop 120 if Cmdc = Labels (I) then 121 K := Function_Key_Code 122 (Function_Key_Number (I)); 123 exit; 124 end if; 125 end loop; 126 end if; 127 return True; 128 end; 129 end if; 130 end if; 131 end if; 132 return False; 133 end My_Driver; 134 135 begin 136 In_Command := True; 137 for I in Label_Number'Range loop 138 Get_Soft_Label_Key (I, Labels (I)); 139 Trim (Labels (I), Left); 140 Translate (Labels (I), Upper_Case_Map); 141 if Labels (I) (1) /= ' ' then 142 N := N + 1; 143 end if; 144 end loop; 145 if N > 0 then -- some labels were really set 146 declare 147 Enum_Info : Enumeration_Info (N); 148 Enum_Field : Enumeration_Field; 149 J : Positive := Enum_Info.Names'First; 150 151 Frm : Form := Create (FA); 152 153 begin 154 for I in Label_Number'Range loop 155 if Labels (I) (1) /= ' ' then 156 Enum_Info.Names (J) := new String'(Labels (I)); 157 J := J + 1; 158 end if; 159 end loop; 160 Enum_Field := Create (Enum_Info, True); 161 Set_Field_Type (FA.all (2), Enum_Field); 162 Set_Background (FA.all (2), Normal_Video); 163 164 Fh.Drive_Me (Frm, Lines - 3, 0); 165 Delete (Frm); 166 Update_Panels; Update_Screen; 167 end; 168 end if; 169 Free (FA, True); 170 In_Command := False; 171 return K; 172 end Command; 173 174 begin 175 Set_Timeout_Mode (Win, Delayed, 30000); 176 loop 177 K := Get_Keystroke (Win); 178 if K = Key_None then -- a timeout occurred 179 Update_Header_Window; 180 elsif K = 3 and then not In_Command then -- CTRL-C 181 K := Command; 182 exit when K /= Key_None; 183 else 184 exit; 185 end if; 186 end loop; 187 return K; 188 end Get_Key; 189 190 procedure Init_Keyboard_Handler is 191 begin 192 null; 193 end Init_Keyboard_Handler; 194 195end Sample.Keyboard_Handler; 196