1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2008,2009 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: 2009/12/26 17:38:58 $
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
);
87 buf
: String (1 .. 1024); -- TODO was BUFSIZE
90 blockflag
: Timeout_Mode
:= Blocking
;
91 firsttime
: Boolean := True;
93 tmp6
: String (1 .. 6);
94 tmp20
: String (1 .. 20);
98 incount
: Integer := 0;
102 tmp2
:= Start_Mouse
(All_Events
);
103 Add
(Str
=> "Delay in 10ths of a second (<CR> for blocking input)? ");
104 Set_Echo_Mode
(SwitchOn
=> True);
107 Set_Echo_Mode
(SwitchOn
=> False);
108 Set_NL_Mode
(SwitchOn
=> False);
110 if Ada
.Characters
.Handling
.Is_Digit
(buf
(1)) then
111 Get
(Item
=> n
, From
=> buf
, Last
=> tmpx
);
112 Set_Timeout_Mode
(Mode
=> Delayed
, Amount
=> n
* 100);
113 blockflag
:= Delayed
;
116 c
:= Character'Pos ('?');
117 Set_Raw_Mode
(SwitchOn
=> True);
119 if not firsttime
then
120 Add
(Str
=> "Key pressed: ");
121 Put
(tmp6
, Integer (c
), 8);
124 if c
= Key_Mouse
then
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)");
156 c2
: constant Character := Character'Val (c
mod 16#
80#
);
158 if Ada
.Characters
.Handling
.Is_Graphic
(c2
) then
160 Add
(Str
=> " (ASCII printable character)");
163 Add
(Str
=> Un_Control
((Ch
=> c2
,
164 Color
=> Color_Pair
'First,
165 Attr
=> Normal_Video
)));
166 Add
(Str
=> " (ASCII control character)");
171 -- TODO I am not sure why this was in the C version
172 -- the delay statement scroll anyway.
173 Get_Cursor_Position
(Line
=> y
, Column
=> x
);
174 if y
>= Lines
- 1 then
175 Move_Cursor
(Line
=> 0, Column
=> 0);
177 Clear_To_End_Of_Line
;
181 if c
= Character'Pos ('g') then
183 package p
is new ncurses2
.genericPuts
(1024);
186 timedout
: Boolean := False;
187 boundedbuf
: Bounded_String
;
189 Add
(Str
=> "getstr test: ");
190 Set_Echo_Mode
(SwitchOn
=> True);
191 -- Note that if delay mode is set
192 -- Get can raise an exception.
193 -- The C version would print the string it had so far
194 -- also TODO get longer length string, like the C version
196 myGet
(Str
=> boundedbuf
);
197 exception when Curses_Exception
=>
198 Add
(Str
=> "Timed out.");
202 -- note that the Ada Get will stop reading at 1024.
204 Set_Echo_Mode
(SwitchOn
=> False);
205 Add
(Str
=> " I saw '");
206 myAdd
(Str
=> boundedbuf
);
211 elsif c
= Character'Pos ('s') then
213 elsif c
= Character'Pos ('x') or c
= Character'Pos ('q') or
214 (c
= Key_None
and blockflag
= Blocking
) then
216 elsif c
= Character'Pos ('?') then
217 Add
(Str
=> "Type any key to see its keypad value. Also:");
219 Add
(Str
=> "g -- triggers a getstr test");
221 Add
(Str
=> "s -- shell out");
223 Add
(Str
=> "q -- quit");
225 Add
(Str
=> "? -- repeats this help message");
231 exit when c
/= Key_None
;
232 if blockflag
/= Blocking
then
233 Put
(tmp6
, incount
); -- argh string length!
235 Add
(Str
=> ": input timed out");
240 Add
(Str
=> ": input error");
244 incount
:= incount
+ 1;
249 Set_Timeout_Mode
(Mode
=> Blocking
, Amount
=> 0); -- amount is ignored
250 Set_Raw_Mode
(SwitchOn
=> False);
251 Set_NL_Mode
(SwitchOn
=> True);
254 end ncurses2
.getch_test
;