1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000 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 -- Binding Version 01.00
40 ------------------------------------------------------------------------------
41 with ncurses2.util; use ncurses2.util;
42 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
43 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
44 with Terminal_Interface.Curses.Panels.User_Data;
46 with ncurses2.genericPuts;
48 procedure ncurses2.demo_panels (nap_mseci : Integer) is
51 function mkpanel (color : Color_Number;
55 tlx : Column_Position) return Panel;
56 procedure rmpanel (pan : in out Panel);
58 procedure wait_a_while (msec : Integer);
59 procedure saywhat (text : String);
60 procedure fill_panel (pan : Panel);
62 nap_msec : Integer := nap_mseci;
64 function mkpanel (color : Color_Number;
68 tlx : Column_Position) return Panel is
70 pan : Panel := Null_Panel;
72 win := New_Window (rows, cols, tly, tlx);
73 if Null_Window /= win then
74 pan := New_Panel (win);
75 if pan = Null_Panel then
79 fg, bg : Color_Number;
87 Init_Pair (Color_Pair (color), fg, bg);
88 Set_Background (win, (Ch => ' ',
90 Color => Color_Pair (color)));
93 Set_Background (win, (Ch => ' ',
94 Attr => (Bold_Character => True,
96 Color => Color_Pair (color)));
102 procedure rmpanel (pan : in out Panel) is
103 win : Window := Panel_Window (pan);
115 procedure wait_a_while (msec : Integer) is
117 -- The C version had some #ifdef blocks here
121 Nap_Milli_Seconds (nap_msec);
125 procedure saywhat (text : String) is
127 Move_Cursor (Line => Lines - 1, Column => 0);
128 Clear_To_End_Of_Line;
132 -- from sample-curses_demo.adb
133 type User_Data is new String (1 .. 2);
134 type User_Data_Access is access all User_Data;
135 package PUD is new Panels.User_Data (User_Data, User_Data_Access);
139 procedure fill_panel (pan : Panel) is
140 win : Window := Panel_Window (pan);
141 num : Character := Get_User_Data (pan) (2);
142 tmp6 : String (1 .. 6) := "-panx-";
147 Move_Cursor (win, 1, 1);
149 Add (win, Str => tmp6);
150 Clear_To_End_Of_Line (win);
152 Get_Size (win, maxy, maxx);
153 for y in 2 .. maxy - 2 loop
154 for x in 1 .. maxx - 2 loop
155 Move_Cursor (win, y, x);
161 modstr : array (0 .. 5) of String (1 .. 5) :=
170 package p is new ncurses2.genericPuts (1024);
173 -- the C version said register int y, x;
174 tmpb : BS.Bounded_String;
179 for y in 0 .. Integer (Lines - 2) loop
180 for x in 0 .. Integer (Columns - 1) loop
181 myPut (tmpb, (y + x) mod 10);
187 p1, p2, p3, p4, p5 : Panel;
188 U1 : User_Data_Access := new User_Data'("p1");
189 U2 : User_Data_Access := new User_Data'("p2");
190 U3 : User_Data_Access := new User_Data'("p3");
191 U4 : User_Data_Access := new User_Data'("p4");
192 U5 : User_Data_Access := new User_Data'("p5");
195 p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
196 Set_User_Data (p1, U1);
197 p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
199 Set_User_Data (p2, U2);
200 p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
202 Set_User_Data (p3, U3);
203 p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
205 Set_User_Data (p4, U4);
206 p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
208 Set_User_Data (p5, U5);
218 saywhat ("press any key to continue");
219 wait_a_while (nap_msec);
221 saywhat ("h3 s1 s2 s4 s5; press any key to continue");
229 wait_a_while (nap_msec);
231 saywhat ("s1; press any key to continue");
234 wait_a_while (nap_msec);
236 saywhat ("s2; press any key to continue");
239 wait_a_while (nap_msec);
241 saywhat ("m2; press any key to continue");
242 Move (p2, Lines / 3 + 1, Columns / 8);
244 wait_a_while (nap_msec);
249 wait_a_while (nap_msec);
251 saywhat ("m3; press any key to continue");
252 Move (p3, Lines / 4 + 1, Columns / 15);
254 wait_a_while (nap_msec);
256 saywhat ("b3; press any key to continue");
259 wait_a_while (nap_msec);
261 saywhat ("s4; press any key to continue");
264 wait_a_while (nap_msec);
266 saywhat ("s5; press any key to continue");
269 wait_a_while (nap_msec);
271 saywhat ("t3; press any key to continue");
274 wait_a_while (nap_msec);
276 saywhat ("t1; press any key to continue");
279 wait_a_while (nap_msec);
281 saywhat ("t2; press any key to continue");
284 wait_a_while (nap_msec);
286 saywhat ("t3; press any key to continue");
289 wait_a_while (nap_msec);
291 saywhat ("t4; press any key to continue");
294 wait_a_while (nap_msec);
296 for itmp in 0 .. 5 loop
298 w4 : Window := Panel_Window (p4);
299 w5 : Window := Panel_Window (p5);
302 saywhat ("m4; press any key to continue");
303 Move_Cursor (w4, Lines / 8, 1);
304 Add (w4, modstr (itmp));
305 Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
306 Move_Cursor (w5, Lines / 6, 1);
307 Add (w5, modstr (itmp));
309 wait_a_while (nap_msec);
311 saywhat ("m5; press any key to continue");
312 Move_Cursor (w4, Lines / 6, 1);
313 Add (w4, modstr (itmp));
314 Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
315 Move_Cursor (w5, Lines / 8, 1);
316 Add (w5, modstr (itmp));
318 wait_a_while (nap_msec);
322 saywhat ("m4; press any key to continue");
323 Move (p4, Lines / 6, 6 * (Columns / 8));
324 -- Move(p4, Lines / 6, itmp * (Columns / 8));
326 wait_a_while (nap_msec);
328 saywhat ("t5; press any key to continue");
331 wait_a_while (nap_msec);
333 saywhat ("t2; press any key to continue");
336 wait_a_while (nap_msec);
338 saywhat ("t1; press any key to continue");
341 wait_a_while (nap_msec);
343 saywhat ("d2; press any key to continue");
346 wait_a_while (nap_msec);
348 saywhat ("h3; press any key to continue");
351 wait_a_while (nap_msec);
353 saywhat ("d1; press any key to continue");
356 wait_a_while (nap_msec);
358 saywhat ("d4; press any key to continue");
361 wait_a_while (nap_msec);
363 saywhat ("d5; press any key to continue");
366 wait_a_while (nap_msec);
367 if (nap_msec = 1) then
379 end ncurses2.demo_panels;