1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2011,2018 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: 2018/07/07 23:31:02 $
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
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 (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 : constant Window := Panel_Window (pan);
141 num : constant Character := Get_User_Data (pan).all (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 - 3 loop
154 for x in 1 .. maxx - 3 loop
155 Move_Cursor (win, y, x);
160 when Curses_Exception => null;
163 modstr : constant array (0 .. 5) of String (1 .. 5) :=
172 package p is new ncurses2.genericPuts (1024);
175 -- the C version said register int y, x;
176 tmpb : BS.Bounded_String;
181 for y in 0 .. Integer (Lines - 2) loop
182 for x in 0 .. Integer (Columns - 1) loop
183 myPut (tmpb, (y + x) mod 10);
189 p1, p2, p3, p4, p5 : Panel;
190 U1 : constant User_Data_Access := new User_Data'("p1");
191 U2 : constant User_Data_Access := new User_Data'("p2");
192 U3 : constant User_Data_Access := new User_Data'("p3");
193 U4 : constant User_Data_Access := new User_Data'("p4");
194 U5 : constant User_Data_Access := new User_Data'("p5");
197 p1 := mkpanel (Red, Lines / 2 - 2, Columns / 8 + 1, 0, 0);
198 Set_User_Data (p1, U1);
199 p2 := mkpanel (Green, Lines / 2 + 1, Columns / 7, Lines / 4,
201 Set_User_Data (p2, U2);
202 p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
204 Set_User_Data (p3, U3);
205 p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8, Lines / 2 - 2,
207 Set_User_Data (p4, U4);
208 p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8, Lines / 2,
210 Set_User_Data (p5, U5);
220 saywhat ("press any key to continue");
221 wait_a_while (nap_msec);
223 saywhat ("h3 s1 s2 s4 s5; press any key to continue");
231 wait_a_while (nap_msec);
233 saywhat ("s1; press any key to continue");
236 wait_a_while (nap_msec);
238 saywhat ("s2; press any key to continue");
241 wait_a_while (nap_msec);
243 saywhat ("m2; press any key to continue");
244 Move (p2, Lines / 3 + 1, Columns / 8);
246 wait_a_while (nap_msec);
251 wait_a_while (nap_msec);
253 saywhat ("m3; press any key to continue");
254 Move (p3, Lines / 4 + 1, Columns / 15);
256 wait_a_while (nap_msec);
258 saywhat ("b3; press any key to continue");
261 wait_a_while (nap_msec);
263 saywhat ("s4; press any key to continue");
266 wait_a_while (nap_msec);
268 saywhat ("s5; press any key to continue");
271 wait_a_while (nap_msec);
273 saywhat ("t3; press any key to continue");
276 wait_a_while (nap_msec);
278 saywhat ("t1; press any key to continue");
281 wait_a_while (nap_msec);
283 saywhat ("t2; press any key to continue");
286 wait_a_while (nap_msec);
288 saywhat ("t3; press any key to continue");
291 wait_a_while (nap_msec);
293 saywhat ("t4; press any key to continue");
296 wait_a_while (nap_msec);
298 for itmp in 0 .. 5 loop
300 w4 : constant Window := Panel_Window (p4);
301 w5 : constant Window := Panel_Window (p5);
304 saywhat ("m4; press any key to continue");
305 Move_Cursor (w4, Lines / 8, 1);
306 Add (w4, modstr (itmp));
307 Move (p4, Lines / 6, Column_Position (itmp) * (Columns / 8));
308 Move_Cursor (w5, Lines / 6, 1);
309 Add (w5, modstr (itmp));
311 wait_a_while (nap_msec);
313 saywhat ("m5; press any key to continue");
314 Move_Cursor (w4, Lines / 6, 1);
315 Add (w4, modstr (itmp));
316 Move (p5, Lines / 3 - 1, (Column_Position (itmp) * 10) + 6);
317 Move_Cursor (w5, Lines / 8, 1);
318 Add (w5, modstr (itmp));
320 wait_a_while (nap_msec);
324 saywhat ("m4; press any key to continue");
325 Move (p4, Lines / 6, 6 * (Columns / 8));
326 -- Move(p4, Lines / 6, itmp * (Columns / 8));
328 wait_a_while (nap_msec);
330 saywhat ("t5; press any key to continue");
333 wait_a_while (nap_msec);
335 saywhat ("t2; press any key to continue");
338 wait_a_while (nap_msec);
340 saywhat ("t1; press any key to continue");
343 wait_a_while (nap_msec);
345 saywhat ("d2; press any key to continue");
348 wait_a_while (nap_msec);
350 saywhat ("h3; press any key to continue");
353 wait_a_while (nap_msec);
355 saywhat ("d1; press any key to continue");
358 wait_a_while (nap_msec);
360 saywhat ("d4; press any key to continue");
363 wait_a_while (nap_msec);
365 saywhat ("d5; press any key to continue");
368 wait_a_while (nap_msec);
381 end ncurses2.demo_panels;