1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2008,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/23 00:44:12 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with ncurses2
.util
; use ncurses2
.util
;
43 with Terminal_Interface
.Curses
; use Terminal_Interface
.Curses
;
44 with Terminal_Interface
.Curses
.Panels
; use Terminal_Interface
.Curses
.Panels
;
45 with Terminal_Interface
.Curses
.Panels
.User_Data
;
47 with ncurses2
.genericPuts
;
49 procedure ncurses2
.demo_panels
(nap_mseci
: Integer) is
52 function mkpanel
(color
: Color_Number
;
56 tlx
: Column_Position
) return Panel
;
57 procedure rmpanel
(pan
: in out Panel
);
59 procedure wait_a_while
(msec
: Integer);
60 procedure saywhat
(text
: String);
61 procedure fill_panel
(pan
: Panel
);
63 nap_msec
: Integer := nap_mseci
;
65 function mkpanel
(color
: Color_Number
;
69 tlx
: Column_Position
) return Panel
is
71 pan
: Panel
:= Null_Panel
;
73 win
:= New_Window
(rows
, cols
, tly
, tlx
);
74 if Null_Window
/= win
then
75 pan
:= New_Panel
(win
);
76 if pan
= Null_Panel
then
80 fg
, bg
: Color_Number
;
88 Init_Pair
(Color_Pair
(color
), fg
, bg
);
89 Set_Background
(win
, (Ch
=> ' ',
91 Color
=> Color_Pair
(color
)));
94 Set_Background
(win
, (Ch
=> ' ',
95 Attr
=> (Bold_Character
=> True,
97 Color
=> Color_Pair
(color
)));
103 procedure rmpanel
(pan
: in out Panel
) is
104 win
: Window
:= Panel_Window
(pan
);
116 procedure wait_a_while
(msec
: Integer) is
118 -- The C version had some #ifdef blocks here
122 Nap_Milli_Seconds
(msec
);
126 procedure saywhat
(text
: String) is
128 Move_Cursor
(Line
=> Lines
- 1, Column
=> 0);
129 Clear_To_End_Of_Line
;
133 -- from sample-curses_demo.adb
134 type User_Data
is new String (1 .. 2);
135 type User_Data_Access
is access all User_Data
;
136 package PUD
is new Panels
.User_Data
(User_Data
, User_Data_Access
);
140 procedure fill_panel
(pan
: Panel
) is
141 win
: constant Window
:= Panel_Window
(pan
);
142 num
: constant Character := Get_User_Data
(pan
).all (2);
143 tmp6
: String (1 .. 6) := "-panx-";
148 Move_Cursor
(win
, 1, 1);
150 Add
(win
, Str
=> tmp6
);
151 Clear_To_End_Of_Line
(win
);
153 Get_Size
(win
, maxy
, maxx
);
154 for y
in 2 .. maxy
- 3 loop
155 for x
in 1 .. maxx
- 3 loop
156 Move_Cursor
(win
, y
, x
);
161 when Curses_Exception
=> null;
164 modstr
: constant array (0 .. 5) of String (1 .. 5) :=
173 package p
is new ncurses2
.genericPuts
(1024);
176 -- the C version said register int y, x;
177 tmpb
: BS
.Bounded_String
;
182 for y
in 0 .. Integer (Lines
- 2) loop
183 for x
in 0 .. Integer (Columns
- 1) loop
184 myPut
(tmpb
, (y
+ x
) mod 10);
190 p1
, p2
, p3
, p4
, p5
: Panel
;
191 U1
: constant User_Data_Access
:= new User_Data
'("p1");
192 U2 : constant User_Data_Access := new User_Data'("p2");
193 U3
: constant User_Data_Access
:= new User_Data
'("p3");
194 U4 : constant User_Data_Access := new User_Data'("p4");
195 U5
: constant User_Data_Access
:= new User_Data
'("p5");
198 p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
199 Set_User_Data (p1, U1);
200 p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
202 Set_User_Data (p2, U2);
203 p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
205 Set_User_Data (p3, U3);
206 p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
208 Set_User_Data (p4, U4);
209 p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
211 Set_User_Data (p5, U5);
221 saywhat ("press any key to continue");
222 wait_a_while (nap_msec);
224 saywhat ("h3 s1 s2 s4 s5; press any key to continue");
232 wait_a_while (nap_msec);
234 saywhat ("s1; press any key to continue");
237 wait_a_while (nap_msec);
239 saywhat ("s2; press any key to continue");
242 wait_a_while (nap_msec);
244 saywhat ("m2; press any key to continue");
245 Move (p2, Lines / 3 + 1, Columns / 8);
247 wait_a_while (nap_msec);
252 wait_a_while (nap_msec);
254 saywhat ("m3; press any key to continue");
255 Move (p3, Lines / 4 + 1, Columns / 15);
257 wait_a_while (nap_msec);
259 saywhat ("b3; press any key to continue");
262 wait_a_while (nap_msec);
264 saywhat ("s4; press any key to continue");
267 wait_a_while (nap_msec);
269 saywhat ("s5; press any key to continue");
272 wait_a_while (nap_msec);
274 saywhat ("t3; press any key to continue");
277 wait_a_while (nap_msec);
279 saywhat ("t1; press any key to continue");
282 wait_a_while (nap_msec);
284 saywhat ("t2; press any key to continue");
287 wait_a_while (nap_msec);
289 saywhat ("t3; press any key to continue");
292 wait_a_while (nap_msec);
294 saywhat ("t4; press any key to continue");
297 wait_a_while (nap_msec);
299 for itmp in 0 .. 5 loop
301 w4 : constant Window := Panel_Window (p4);
302 w5 : constant Window := Panel_Window (p5);
305 saywhat ("m4; press any key to continue");
306 Move_Cursor (w4, Lines / 8, 1);
307 Add (w4, modstr (itmp));
308 Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
309 Move_Cursor (w5, Lines / 6, 1);
310 Add (w5, modstr (itmp));
312 wait_a_while (nap_msec);
314 saywhat ("m5; press any key to continue");
315 Move_Cursor (w4, Lines / 6, 1);
316 Add (w4, modstr (itmp));
317 Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
318 Move_Cursor (w5, Lines / 8, 1);
319 Add (w5, modstr (itmp));
321 wait_a_while (nap_msec);
325 saywhat ("m4; press any key to continue");
326 Move (p4, Lines / 6, 6 * (Columns / 8));
327 -- Move(p4, Lines / 6, itmp * (Columns / 8));
329 wait_a_while (nap_msec);
331 saywhat ("t5; press any key to continue");
334 wait_a_while (nap_msec);
336 saywhat ("t2; press any key to continue");
339 wait_a_while (nap_msec);
341 saywhat ("t1; press any key to continue");
344 wait_a_while (nap_msec);
346 saywhat ("d2; press any key to continue");
349 wait_a_while (nap_msec);
351 saywhat ("h3; press any key to continue");
354 wait_a_while (nap_msec);
356 saywhat ("d1; press any key to continue");
359 wait_a_while (nap_msec);
361 saywhat ("d4; press any key to continue");
364 wait_a_while (nap_msec);
366 saywhat ("d5; press any key to continue");
369 wait_a_while (nap_msec);
382 end ncurses2.demo_panels;