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 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) (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 - 2 loop
155 for x in 1 .. maxx - 2 loop
156 Move_Cursor (win, y, x);
162 modstr : constant array (0 .. 5) of String (1 .. 5) :=
171 package p is new ncurses2.genericPuts (1024);
174 -- the C version said register int y, x;
175 tmpb : BS.Bounded_String;
180 for y in 0 .. Integer (Lines - 2) loop
181 for x in 0 .. Integer (Columns - 1) loop
182 myPut (tmpb, (y + x) mod 10);
188 p1, p2, p3, p4, p5 : Panel;
189 U1 : constant User_Data_Access := new User_Data'("p1");
190 U2 : constant User_Data_Access := new User_Data'("p2");
191 U3 : constant User_Data_Access := new User_Data'("p3");
192 U4 : constant User_Data_Access := new User_Data'("p4");
193 U5 : constant User_Data_Access := new User_Data'("p5");
196 p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
197 Set_User_Data (p1, U1);
198 p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
200 Set_User_Data (p2, U2);
201 p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
203 Set_User_Data (p3, U3);
204 p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
206 Set_User_Data (p4, U4);
207 p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
209 Set_User_Data (p5, U5);
219 saywhat ("press any key to continue");
220 wait_a_while (nap_msec);
222 saywhat ("h3 s1 s2 s4 s5; press any key to continue");
230 wait_a_while (nap_msec);
232 saywhat ("s1; press any key to continue");
235 wait_a_while (nap_msec);
237 saywhat ("s2; press any key to continue");
240 wait_a_while (nap_msec);
242 saywhat ("m2; press any key to continue");
243 Move (p2, Lines / 3 + 1, Columns / 8);
245 wait_a_while (nap_msec);
250 wait_a_while (nap_msec);
252 saywhat ("m3; press any key to continue");
253 Move (p3, Lines / 4 + 1, Columns / 15);
255 wait_a_while (nap_msec);
257 saywhat ("b3; press any key to continue");
260 wait_a_while (nap_msec);
262 saywhat ("s4; press any key to continue");
265 wait_a_while (nap_msec);
267 saywhat ("s5; press any key to continue");
270 wait_a_while (nap_msec);
272 saywhat ("t3; press any key to continue");
275 wait_a_while (nap_msec);
277 saywhat ("t1; press any key to continue");
280 wait_a_while (nap_msec);
282 saywhat ("t2; press any key to continue");
285 wait_a_while (nap_msec);
287 saywhat ("t3; press any key to continue");
290 wait_a_while (nap_msec);
292 saywhat ("t4; press any key to continue");
295 wait_a_while (nap_msec);
297 for itmp in 0 .. 5 loop
299 w4 : constant Window := Panel_Window (p4);
300 w5 : constant Window := Panel_Window (p5);
303 saywhat ("m4; press any key to continue");
304 Move_Cursor (w4, Lines / 8, 1);
305 Add (w4, modstr (itmp));
306 Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
307 Move_Cursor (w5, Lines / 6, 1);
308 Add (w5, modstr (itmp));
310 wait_a_while (nap_msec);
312 saywhat ("m5; press any key to continue");
313 Move_Cursor (w4, Lines / 6, 1);
314 Add (w4, modstr (itmp));
315 Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
316 Move_Cursor (w5, Lines / 8, 1);
317 Add (w5, modstr (itmp));
319 wait_a_while (nap_msec);
323 saywhat ("m4; press any key to continue");
324 Move (p4, Lines / 6, 6 * (Columns / 8));
325 -- Move(p4, Lines / 6, itmp * (Columns / 8));
327 wait_a_while (nap_msec);
329 saywhat ("t5; press any key to continue");
332 wait_a_while (nap_msec);
334 saywhat ("t2; press any key to continue");
337 wait_a_while (nap_msec);
339 saywhat ("t1; press any key to continue");
342 wait_a_while (nap_msec);
344 saywhat ("d2; press any key to continue");
347 wait_a_while (nap_msec);
349 saywhat ("h3; press any key to continue");
352 wait_a_while (nap_msec);
354 saywhat ("d1; press any key to continue");
357 wait_a_while (nap_msec);
359 saywhat ("d4; press any key to continue");
362 wait_a_while (nap_msec);
364 saywhat ("d5; press any key to continue");
367 wait_a_while (nap_msec);
380 end ncurses2.demo_panels;