ncurses 4.1
[ncurses.git] / Ada95 / samples / sample-keyboard_handler.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                            Sample.Keyboard_Handler                       --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 --  Version 00.92                                                           --
10 --                                                                          --
11 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
12 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
13 --                                                                          --
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.                                                     --
21 --                                                                          --
22 --  This binding comes AS IS with no warranty, implied or expressed.        --
23 ------------------------------------------------------------------------------
24 --  Version Control
25 --  $Revision: 1.2 $
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;
31
32 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
33 with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
34
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;
39
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.
43 --
44
45 package body Sample.Keyboard_Handler is
46
47    In_Command : Boolean := False;
48
49    function Get_Key (Win : Window := Standard_Window) return Real_Key_Code
50    is
51       K : Real_Key_Code;
52
53       function Command return Real_Key_Code;
54
55
56       function Command return Real_Key_Code
57       is
58          function My_Driver (F : Form;
59                              C : Key_Code;
60                              P : Panel) return Boolean;
61          package Fh is new Sample.Form_Demo.Handler (My_Driver);
62
63          type Label_Array is array (Label_Number) of String (1 .. 8);
64
65          Labels : Label_Array;
66
67          FA : Field_Array (1 .. 2) := (Make (0, 0, "Command:"),
68                                        Make (Top => 0, Left => 9,
69                                              Width => Columns - 11));
70
71          K  : Real_Key_Code := Key_None;
72          N  : Natural := 0;
73
74          function My_Driver (F : Form;
75                              C : Key_Code;
76                              P : Panel) return Boolean
77          is
78             Ch : Character;
79          begin
80             if C in User_Key_Code'Range and then C = QUIT then
81                if Driver (F, F_Validate_Field) = Form_Ok  then
82                   K := Key_None;
83                   return True;
84                end if;
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
89                      declare
90                         Buffer : String (1 .. Positive (Columns - 11));
91                         Cmdc : String (1 .. 8);
92                      begin
93                         Get_Buffer (Fld => FA (2), Str => Buffer);
94                         Trim (Buffer, Left);
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));
101                                  exit;
102                               end if;
103                            end loop;
104                         end if;
105                         return True;
106                      end;
107                   end if;
108                end if;
109             end if;
110             return False;
111          end My_Driver;
112
113       begin
114          In_Command := True;
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
120                N := N + 1;
121             end if;
122          end loop;
123          if N > 0 then --  some labels were really set
124             declare
125                Enum_Info    : Enumeration_Info (N);
126                Enum_Field   : Enumeration_Field;
127                J : Positive := Enum_Info.Names'First;
128
129                Frm : Form := Create (FA);
130
131             begin
132                for I in Label_Number'Range loop
133                   if Labels (I) (1) /= ' ' then
134                      Enum_Info.Names (J) := new String'(Labels (I));
135                      J := J + 1;
136                   end if;
137                end loop;
138                Enum_Field := Create (Enum_Info, True);
139                Set_Type (FA (2), Enum_Field);
140                Set_Background (FA (2), Normal_Video);
141
142                Fh.Drive_Me (Frm, Lines - 3, 0);
143                Delete (Frm);
144                Update_Panels; Update_Screen;
145             end;
146          end if;
147          for I in FA'Range loop
148             Delete (FA (I));
149          end loop;
150          In_Command := False;
151          return K;
152       end Command;
153
154    begin
155       Set_Timeout_Mode (Win, Delayed, 30000);
156       loop
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
161             K := Command;
162             exit when K /= Key_None;
163          else
164             exit;
165          end if;
166       end loop;
167       return K;
168    end Get_Key;
169
170    procedure Init_Keyboard_Handler is
171    begin
172       null;
173    end Init_Keyboard_Handler;
174
175 end Sample.Keyboard_Handler;