1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000,2004 Free Software Foundation, Inc. --
12 -- Permission is hereby granted, free of charge, to any person obtaining a --
13 -- copy of this software and associated documentation files (the --
14 -- "Software"), to deal in the Software without restriction, including --
15 -- without limitation the rights to use, copy, modify, merge, publish, --
16 -- distribute, distribute with modifications, sublicense, and/or sell --
17 -- copies of the Software, and to permit persons to whom the Software is --
18 -- furnished to do so, subject to the following conditions: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31 -- Except as contained in this notice, the name(s) of the above copyright --
32 -- holders shall not be used in advertising or otherwise to promote the --
33 -- sale, use or other dealings in this Software without prior written --
35 ------------------------------------------------------------------------------
36 -- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
39 -- $Date: 2004/08/21 21:37:00 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 -- Character input test
43 -- test the keypad feature
45 with ncurses2.util; use ncurses2.util;
47 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
48 with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
49 with Ada.Characters.Handling;
50 with Ada.Strings.Bounded;
52 with ncurses2.genericPuts;
54 procedure ncurses2.getch_test is
57 function mouse_decode (ep : Mouse_Event) return String;
59 function mouse_decode (ep : Mouse_Event) return String is
62 Button : Mouse_Button;
64 package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200);
66 buf : Bounded_String := To_Bounded_String ("");
68 -- Note that these bindings do not allow
70 -- The C version can print {click-1, click-3} for example.
71 -- They also don't have the 'id' or z coordinate.
72 Get_Event (ep, Y, X, Button, State);
74 -- TODO Append (buf, "id "); from C version
76 Append (buf, Column_Position'Image (X));
78 Append (buf, Line_Position'Image (Y));
79 Append (buf, ") state");
80 Append (buf, Mouse_Button'Image (Button));
83 Append (buf, Button_State'Image (State));
84 return To_String (buf);
88 buf : String (1 .. 1024); -- TODO was BUFSIZE
91 blockflag : Timeout_Mode := Blocking;
92 firsttime : Boolean := True;
94 tmp6 : String (1 .. 6);
95 tmp20 : String (1 .. 20);
99 incount : Integer := 0;
103 tmp2 := Start_Mouse (All_Events);
104 Add (Str => "Delay in 10ths of a second (<CR> for blocking input)? ");
105 Set_Echo_Mode (SwitchOn => True);
108 Set_Echo_Mode (SwitchOn => False);
109 Set_NL_Mode (SwitchOn => False);
111 if Ada.Characters.Handling.Is_Digit (buf (1)) then
112 Get (Item => n, From => buf, Last => tmpx);
113 Set_Timeout_Mode (Mode => Delayed, Amount => n * 100);
114 blockflag := Delayed;
117 c := Character'Pos ('?');
118 Set_Raw_Mode (SwitchOn => True);
120 if not firsttime then
121 Add (Str => "Key pressed: ");
122 Put (tmp6, Integer (c), 8);
125 if c = Key_Mouse then declare
129 Add (Str => "KEY_MOUSE, ");
130 Add (Str => mouse_decode (event));
133 elsif c >= Key_Min then
136 -- I used tmp and got bitten by the length problem:->
138 elsif c > 16#80# then -- TODO fix, use constant if possible
140 c2 : constant Character := Character'Val (c mod 16#80#);
142 if Ada.Characters.Handling.Is_Graphic (c2) then
147 Add (Str => Un_Control ((Ch => c2,
148 Color => Color_Pair'First,
149 Attr => Normal_Video)));
151 Add (Str => " (high-half character)");
155 c2 : constant Character := Character'Val (c mod 16#80#);
157 if Ada.Characters.Handling.Is_Graphic (c2) then
159 Add (Str => " (ASCII printable character)");
162 Add (Str => Un_Control ((Ch => c2,
163 Color => Color_Pair'First,
164 Attr => Normal_Video)));
165 Add (Str => " (ASCII control character)");
170 -- TODO I am not sure why this was in the C version
171 -- the delay statement scroll anyway.
172 Get_Cursor_Position (Line => y, Column => x);
173 if y >= Lines - 1 then
174 Move_Cursor (Line => 0, Column => 0);
176 Clear_To_End_Of_Line;
180 if c = Character'Pos ('g') then
182 package p is new ncurses2.genericPuts (1024);
185 timedout : Boolean := False;
186 boundedbuf : Bounded_String;
188 Add (Str => "getstr test: ");
189 Set_Echo_Mode (SwitchOn => True);
190 -- Note that if delay mode is set
191 -- Get can raise an exception.
192 -- The C version would print the string it had so far
193 -- also TODO get longer length string, like the C version
195 myGet (Str => boundedbuf);
196 exception when Curses_Exception =>
197 Add (Str => "Timed out.");
201 -- note that the Ada Get will stop reading at 1024.
203 Set_Echo_Mode (SwitchOn => False);
204 Add (Str => " I saw '");
205 myAdd (Str => boundedbuf);
210 elsif c = Character'Pos ('s') then
212 elsif c = Character'Pos ('x') or c = Character'Pos ('q') or
213 (c = Key_None and blockflag = Blocking) then
215 elsif c = Character'Pos ('?') then
216 Add (Str => "Type any key to see its keypad value. Also:");
218 Add (Str => "g -- triggers a getstr test");
220 Add (Str => "s -- shell out");
222 Add (Str => "q -- quit");
224 Add (Str => "? -- repeats this help message");
230 exit when c /= Key_None;
231 if blockflag /= Blocking then
232 Put (tmp6, incount); -- argh string length!
234 Add (Str => ": input timed out");
239 Add (Str => ": input error");
243 incount := incount + 1;
248 Set_Timeout_Mode (Mode => Blocking, Amount => 0); -- amount is ignored
249 Set_Raw_Mode (SwitchOn => False);
250 Set_NL_Mode (SwitchOn => True);
253 end ncurses2.getch_test;