--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding Samples --
+-- --
+-- ncurses --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000 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: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- 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. --
+-- --
+-- 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. --
+------------------------------------------------------------------------------
+-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
+-- Version Control
+-- $Revision: 1.1 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- Character input test
+-- test the keypad feature
+
+with ncurses2.util; use ncurses2.util;
+
+with Terminal_Interface.Curses; use Terminal_Interface.Curses;
+with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
+with Ada.Characters.Handling;
+with Ada.Strings.Bounded;
+
+with ncurses2.genericPuts;
+
+procedure ncurses2.getch_test is
+ use Int_IO;
+
+ function mouse_decode (ep : Mouse_Event) return String;
+
+ function mouse_decode (ep : Mouse_Event) return String is
+ Y : Line_Position;
+ X : Column_Position;
+ Button : Mouse_Button;
+ State : Button_State;
+ package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
+ use BS;
+ buf : Bounded_String := To_Bounded_String ("");
+ begin
+ -- Note that these bindings do not allow
+ -- two button states,
+ -- The C version can print {click-1, click-3} for example.
+ -- They also don't have the 'id' or z coordinate.
+ Get_Event (ep, Y, X, Button, State);
+
+ -- TODO Append (buf, "id "); from C version
+ Append (buf, "at (");
+ Append (buf, Column_Position'Image (X));
+ Append (buf, ", ");
+ Append (buf, Line_Position'Image (Y));
+ Append (buf, ") state");
+ Append (buf, Mouse_Button'Image (Button));
+
+ Append (buf, " = ");
+ Append (buf, Button_State'Image (State));
+ return To_String (buf);
+ end mouse_decode;
+
+
+ buf : String (1 .. 1024); -- TODO was BUFSIZE
+ n : Integer;
+ c : Key_Code;
+ blockflag : Timeout_Mode := Blocking;
+ firsttime : Boolean := True;
+ tmp2 : Event_Mask;
+ tmp6 : String (1 .. 6);
+ tmp20 : String (1 .. 20);
+ x : Column_Position;
+ y : Line_Position;
+ tmpx : Integer;
+ incount : Integer := 0;
+begin
+ Refresh;
+ tmp2 := Start_Mouse (All_Events);
+ Add (Str => "Delay in 10ths of a second (<CR> for blocking input)? ");
+ Set_Echo_Mode (SwitchOn => True);
+ Get (Str => buf);
+
+ Set_Echo_Mode (SwitchOn => False);
+ Set_NL_Mode (SwitchOn => False);
+
+ if Ada.Characters.Handling.Is_Digit (buf (1)) then
+ Get (Item => n, From => buf, Last => tmpx);
+ Set_Timeout_Mode (Mode => Delayed, Amount => n * 100);
+ blockflag := Delayed;
+ end if;
+
+ c := Character'Pos ('?');
+ Set_Raw_Mode (SwitchOn => True);
+ loop
+ if not firsttime then
+ Add (Str => "Key pressed: ");
+ Put (tmp6, Integer (c), 8);
+ Add (Str => tmp6);
+ Add (Ch => ' ');
+ if c = Key_Mouse then declare
+ event : Mouse_Event;
+ begin
+ event := Get_Mouse;
+ Add (Str => "KEY_MOUSE, ");
+ Add (Str => mouse_decode (event));
+ Add (Ch => newl);
+ end;
+ elsif c >= Key_Min then
+ Key_Name (c, tmp20);
+ Add (Str => tmp20);
+ -- I used tmp and got bitten by the length problem:->
+ Add (Ch => newl);
+ elsif c > 16#80# then -- TODO fix, use constant if possible
+ declare
+ c2 : Character := Character'Val (c mod 16#80#);
+ begin
+ if Ada.Characters.Handling.Is_Graphic (c2) then
+ Add (Str => "M-");
+ Add (Ch => c2);
+ else
+ Add (Str => "M-");
+ Add (Str => Un_Control ((Ch => c2,
+ Color => Color_Pair'First,
+ Attr => Normal_Video)));
+ end if;
+ Add (Str => " (high-half character)");
+ Add (Ch => newl);
+ end;
+ else declare
+ c2 : Character := Character'Val (c mod 16#80#);
+ begin
+ if Ada.Characters.Handling.Is_Graphic (c2) then
+ Add (Ch => c2);
+ Add (Str => " (ASCII printable character)");
+ Add (Ch => newl);
+ else
+ Add (Str => Un_Control ((Ch => c2,
+ Color => Color_Pair'First,
+ Attr => Normal_Video)));
+ Add (Str => " (ASCII control character)");
+ Add (Ch => newl);
+ end if;
+ end;
+ end if;
+ -- TODO I am not sure why this was in the C version
+ -- the delay statement scroll anyway.
+ Get_Cursor_Position (Line => y, Column => x);
+ if y >= Lines - 1 then
+ Move_Cursor (Line => 0, Column => 0);
+ end if;
+ Clear_To_End_Of_Line;
+ end if;
+
+ firsttime := False;
+ if c = Character'Pos ('g') then
+ declare
+ package p is new ncurses2.genericPuts (1024);
+ use p;
+ use p.BS;
+ timedout : Boolean := False;
+ boundedbuf : Bounded_String;
+ begin
+ Add (Str => "getstr test: ");
+ Set_Echo_Mode (SwitchOn => True);
+ -- Note that if delay mode is set
+ -- Get can raise an exception.
+ -- The C version would print the string it had so far
+ -- also TODO get longer length string, like the C version
+ declare begin
+ myGet (Str => boundedbuf);
+ exception when Curses_Exception =>
+ Add (Str => "Timed out.");
+ Add (Ch => newl);
+ timedout := True;
+ end;
+ -- note that the Ada Get will stop reading at 1024.
+ if not timedout then
+ Set_Echo_Mode (SwitchOn => False);
+ Add (Str => " I saw '");
+ myAdd (Str => boundedbuf);
+ Add (Str => "'.");
+ Add (ch => newl);
+ end if;
+ end;
+ elsif c = Character'Pos ('s') then
+ ShellOut (True);
+ elsif c = Character'Pos ('x') or c = Character'Pos ('q') or
+ (c = Key_None and blockflag = Blocking) then
+ exit;
+ elsif c = Character'Pos ('?') then
+ Add (Str => "Type any key to see its keypad value. Also:");
+ Add (Ch => newl);
+ Add (Str => "g -- triggers a getstr test");
+ Add (Ch => newl);
+ Add (Str => "s -- shell out");
+ Add (Ch => newl);
+ Add (Str => "q -- quit");
+ Add (Ch => newl);
+ Add (Str => "? -- repeats this help message");
+ Add (Ch => newl);
+ end if;
+
+ loop
+ c := Getchar;
+ exit when c /= Key_None;
+ if blockflag /= Blocking then
+ Put (tmp6, incount); -- argh string length!
+ Add (Str => tmp6);
+ Add (Str => ": input timed out");
+ Add (Ch => newl);
+ else
+ Put (tmp6, incount);
+ Add (Str => tmp6);
+ Add (Str => ": input error");
+ Add (Ch => newl);
+ exit;
+ end if;
+ incount := incount + 1;
+ end loop;
+ end loop;
+
+ tmp2 := Start_Mouse (No_Events);
+ Set_Timeout_Mode (Mode => Blocking, Amount => 0); -- amount is ignored
+ Set_Raw_Mode (SwitchOn => False);
+ Set_NL_Mode (SwitchOn => True);
+ Erase;
+ End_Windows;
+end ncurses2.getch_test;
projects / ncurses.git / blobdiff