ncursesw-morphos/Ada95/samples/sample-keyboard_handler.adb

192 lines
8.0 KiB
Ada
Raw Normal View History

1997-05-15 12:00:00 +08:00
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding Samples --
-- --
-- Sample.Keyboard_Handler --
-- --
-- B O D Y --
-- --
1998-03-01 12:21:12 +08:00
------------------------------------------------------------------------------
-- Copyright (c) 1998 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: --
1997-05-15 12:00:00 +08:00
-- --
1998-03-01 12:21:12 +08:00
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
1997-05-15 12:00:00 +08:00
-- --
1998-03-01 12:21:12 +08:00
-- 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. --
1997-05-15 12:00:00 +08:00
-- --
1998-03-01 12:21:12 +08:00
-- 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. --
1997-05-15 12:00:00 +08:00
------------------------------------------------------------------------------
1999-10-24 12:32:42 +08:00
-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
1997-05-15 12:00:00 +08:00
-- Version Control
1999-10-24 12:32:42 +08:00
-- $Revision: 1.7 $
-- Binding Version 01.00
1997-05-15 12:00:00 +08: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;
1998-03-01 12:21:12 +08:00
with Ada.Characters.Handling; use Ada.Characters.Handling;
1997-05-15 12:00:00 +08:00
with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
1998-03-01 12:21:12 +08:00
with Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
use Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
1997-05-15 12:00:00 +08:00
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;
1998-03-01 12:21:12 +08:00
FA : Field_Array_Access := new Field_Array'
(Make (0, 0, "Command:"),
Make (Top => 0, Left => 9, Width => Columns - 11),
Null_Field);
1997-05-15 12:00:00 +08:00
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 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
1998-03-01 12:21:12 +08:00
Cmdc := To_Upper (Buffer (Cmdc'Range));
1997-05-15 12:00:00 +08:00
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);
1998-03-01 12:21:12 +08:00
Set_Field_Type (FA (2), Enum_Field);
1997-05-15 12:00:00 +08:00
Set_Background (FA (2), Normal_Video);
Fh.Drive_Me (Frm, Lines - 3, 0);
Delete (Frm);
Update_Panels; Update_Screen;
end;
end if;
1998-03-01 12:21:12 +08:00
Free (FA, True);
1997-05-15 12:00:00 +08:00
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;