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;