1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2009,2011 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: 2011/03/19 12:03:08 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with ncurses2
.util
; use ncurses2
.util
;
43 with Terminal_Interface
.Curses
; use Terminal_Interface
.Curses
;
45 with Ada
.Strings
.Unbounded
;
47 with Terminal_Interface
.Curses
.Aux
;
49 procedure ncurses2
.slk_test
is
50 procedure myGet
(Win
: Window
:= Standard_Window
;
51 Str
: out Ada
.Strings
.Unbounded
.Unbounded_String
;
54 procedure myGet
(Win
: Window
:= Standard_Window
;
55 Str
: out Ada
.Strings
.Unbounded
.Unbounded_String
;
58 use Ada
.Strings
.Unbounded
;
60 use Terminal_Interface
.Curses
.Aux
;
62 function Wgetnstr
(Win
: Window
;
64 Len
: int
) return int
;
65 pragma Import
(C
, Wgetnstr
, "wgetnstr");
67 -- FIXME: how to construct "(Len > 0) ? Len : 80"?
68 Ask
: constant Interfaces
.C
.size_t
:= Interfaces
.C
.size_t
'Val (Len
+ 80);
69 Txt
: char_array
(0 .. Ask
);
72 Txt
(0) := Interfaces
.C
.char
'First;
73 if Wgetnstr
(Win
, Txt
, Txt
'Length) = Curses_Err
then
74 raise Curses_Exception
;
76 Str
:= To_Unbounded_String
(To_Ada
(Txt
, True));
81 use Ada
.Strings
.Unbounded
;
84 buf
: Unbounded_String
;
86 fmt
: Label_Justification
:= Centered
;
92 Move_Cursor
(Line
=> 0, Column
=> 0);
93 c2
:= Code_To_Char
(c
);
95 when Character'Val (Character'Pos ('l') mod 16#
20#
) => -- CTRL('l')
97 Switch_Character_Attribute
(Attr
=> (Bold_Character
=> True,
99 Add
(Line
=> 0, Column
=> 20,
100 Str
=> "Soft Key Exerciser");
101 Switch_Character_Attribute
(On
=> False,
102 Attr
=> (Bold_Character
=> True,
105 Move_Cursor
(Line
=> 2, Column
=> 0);
106 P
("Available commands are:");
108 P
("^L -- refresh screen");
109 P
("a -- activate or restore soft keys");
110 P
("d -- disable soft keys");
111 P
("c -- set centered format for labels");
112 P
("l -- set left-justified format for labels");
113 P
("r -- set right-justified format for labels");
114 P
("[12345678] -- set label; labels are numbered 1 through 8");
115 P
("e -- erase stdscr (should not erase labels)");
116 P
("s -- test scrolling of shortened screen");
117 P
("x, q -- return to main menu");
119 P
("Note: if activating the soft keys causes your terminal to");
120 P
("scroll up one line, your terminal auto-scrolls when anything");
121 P
("is written to the last screen position. The ncurses code");
122 P
("does not yet handle this gracefully.");
124 Restore_Soft_Label_Keys
;
127 Restore_Soft_Label_Keys
;
131 Add
(Line
=> 20, Column
=> 0,
132 Str
=> "Press Q to stop the scrolling-test: ");
135 c2
:= Code_To_Char
(c
);
138 -- TODO when c is not a character (arrow key)
139 -- the behavior is different from the C version.
143 Clear_Soft_Label_Keys
;
150 when '1' |
'2' |
'3' |
'4' |
'5' |
'6' |
'7' |
'8' =>
151 Add
(Line
=> 20, Column
=> 0,
152 Str
=> "Please enter the label value: ");
153 Set_Echo_Mode
(SwitchOn
=> True);
155 Set_Echo_Mode
(SwitchOn
=> False);
157 Set_Soft_Label_Key
(Label_Number
(tmp
), To_String
(buf
), fmt
);
158 Refresh_Soft_Label_Keys
;
159 Move_Cursor
(Line
=> 20, Column
=> 0);
160 Clear_To_End_Of_Line
;
163 -- the C version needed a goto, ha ha
164 -- breaks exit the case not the loop because fall-through
170 -- TODO exit when c = EOF
174 end ncurses2
.slk_test
;