ncurses 6.1 - patch 20190720
[ncurses.git] / Ada95 / samples / ncurses2-demo_panels.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                                 ncurses                                  --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2011,2018 Free Software Foundation, Inc.              --
11 --                                                                          --
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:                 --
19 --                                                                          --
20 -- The above copyright notice and this permission notice shall be included  --
21 -- in all copies or substantial portions of the Software.                   --
22 --                                                                          --
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.                               --
30 --                                                                          --
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       --
34 -- authorization.                                                           --
35 ------------------------------------------------------------------------------
36 --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
37 --  Version Control
38 --  $Revision: 1.8 $
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;
46
47 with ncurses2.genericPuts;
48
49 procedure ncurses2.demo_panels (nap_mseci : Integer) is
50
51    function  mkpanel (color : Color_Number;
52                       rows  : Line_Count;
53                       cols  : Column_Count;
54                       tly   : Line_Position;
55                       tlx   : Column_Position) return Panel;
56    procedure rmpanel (pan : in out Panel);
57    procedure pflush;
58    procedure wait_a_while (msec : Integer);
59    procedure saywhat (text : String);
60    procedure fill_panel (pan : Panel);
61
62    nap_msec : Integer := nap_mseci;
63
64    function mkpanel (color : Color_Number;
65                      rows  : Line_Count;
66                      cols  : Column_Count;
67                      tly   : Line_Position;
68                      tlx   : Column_Position) return Panel is
69       win : Window;
70       pan : Panel := Null_Panel;
71    begin
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
76             Delete (win);
77          elsif Has_Colors then
78             declare
79                fg, bg : Color_Number;
80             begin
81                if color = Blue then
82                   fg := White;
83                else
84                   fg := Black;
85                end if;
86                bg := color;
87                Init_Pair (Color_Pair (color), fg, bg);
88                Set_Background (win, (Ch => ' ',
89                                      Attr => Normal_Video,
90                                      Color => Color_Pair (color)));
91             end;
92          else
93             Set_Background (win, (Ch => ' ',
94                                   Attr => (Bold_Character => True,
95                                            others => False),
96                                   Color => Color_Pair (color)));
97          end if;
98       end if;
99       return pan;
100    end mkpanel;
101
102    procedure rmpanel (pan : in out Panel) is
103       win : Window := Panel_Window (pan);
104    begin
105       Delete (pan);
106       Delete (win);
107    end rmpanel;
108
109    procedure pflush is
110    begin
111       Update_Panels;
112       Update_Screen;
113    end pflush;
114
115    procedure wait_a_while (msec : Integer) is
116    begin
117       --  The C version had some #ifdef blocks here
118       if msec = 1 then
119          Getchar;
120       else
121          Nap_Milli_Seconds (msec);
122       end if;
123    end wait_a_while;
124
125    procedure saywhat (text : String) is
126    begin
127       Move_Cursor (Line => Lines - 1, Column => 0);
128       Clear_To_End_Of_Line;
129       Add (Str => text);
130    end saywhat;
131
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);
136
137    use PUD;
138
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-";
143       maxy : Line_Count;
144       maxx : Column_Count;
145
146    begin
147       Move_Cursor (win, 1, 1);
148       tmp6 (5) := num;
149       Add (win, Str => tmp6);
150       Clear_To_End_Of_Line (win);
151       Box (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);
156             Add (win, num);
157          end loop;
158       end loop;
159    exception
160    when Curses_Exception => null;
161    end fill_panel;
162
163    modstr : constant array (0 .. 5) of String (1 .. 5) :=
164      ("test ",
165       "TEST ",
166       "(**) ",
167       "*()* ",
168       "<--> ",
169       "LAST "
170       );
171
172    package p is new ncurses2.genericPuts (1024);
173    use p;
174    use p.BS;
175    --  the C version said register int y, x;
176    tmpb : BS.Bounded_String;
177
178 begin
179    Refresh;
180
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);
184          myAdd (Str => tmpb);
185       end loop;
186    end loop;
187    for y in 0 .. 4 loop
188       declare
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");
195
196       begin
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,
200                         Columns / 10);
201          Set_User_Data (p2, U2);
202          p3 := mkpanel (Yellow, Lines / 4, Columns / 10, Lines / 2,
203                         Columns / 9);
204          Set_User_Data (p3, U3);
205          p4 := mkpanel (Blue, Lines / 2 - 2, Columns / 8,  Lines / 2 - 2,
206                         Columns / 3);
207          Set_User_Data (p4, U4);
208          p5 := mkpanel (Magenta, Lines / 2 - 2, Columns / 8,  Lines / 2,
209                         Columns / 2 - 2);
210          Set_User_Data (p5, U5);
211
212          fill_panel (p1);
213          fill_panel (p2);
214          fill_panel (p3);
215          fill_panel (p4);
216          fill_panel (p5);
217          Hide (p4);
218          Hide (p5);
219          pflush;
220          saywhat ("press any key to continue");
221          wait_a_while (nap_msec);
222
223          saywhat ("h3 s1 s2 s4 s5; press any key to continue");
224          Move (p1, 0, 0);
225          Hide (p3);
226          Show (p1);
227          Show (p2);
228          Show (p4);
229          Show (p5);
230          pflush;
231          wait_a_while (nap_msec);
232
233          saywhat ("s1; press any key to continue");
234          Show (p1);
235          pflush;
236          wait_a_while (nap_msec);
237
238          saywhat ("s2; press any key to continue");
239          Show (p2);
240          pflush;
241          wait_a_while (nap_msec);
242
243          saywhat ("m2; press any key to continue");
244          Move (p2, Lines / 3 + 1, Columns / 8);
245          pflush;
246          wait_a_while (nap_msec);
247
248          saywhat ("s3;");
249          Show (p3);
250          pflush;
251          wait_a_while (nap_msec);
252
253          saywhat ("m3; press any key to continue");
254          Move (p3, Lines / 4 + 1, Columns / 15);
255          pflush;
256          wait_a_while (nap_msec);
257
258          saywhat ("b3; press any key to continue");
259          Bottom (p3);
260          pflush;
261          wait_a_while (nap_msec);
262
263          saywhat ("s4; press any key to continue");
264          Show (p4);
265          pflush;
266          wait_a_while (nap_msec);
267
268          saywhat ("s5; press any key to continue");
269          Show (p5);
270          pflush;
271          wait_a_while (nap_msec);
272
273          saywhat ("t3; press any key to continue");
274          Top (p3);
275          pflush;
276          wait_a_while (nap_msec);
277
278          saywhat ("t1; press any key to continue");
279          Top (p1);
280          pflush;
281          wait_a_while (nap_msec);
282
283          saywhat ("t2; press any key to continue");
284          Top (p2);
285          pflush;
286          wait_a_while (nap_msec);
287
288          saywhat ("t3; press any key to continue");
289          Top (p3);
290          pflush;
291          wait_a_while (nap_msec);
292
293          saywhat ("t4; press any key to continue");
294          Top (p4);
295          pflush;
296          wait_a_while (nap_msec);
297
298          for itmp in  0 ..  5 loop
299             declare
300                w4 : constant Window := Panel_Window (p4);
301                w5 : constant Window := Panel_Window (p5);
302             begin
303
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));
310                pflush;
311                wait_a_while (nap_msec);
312
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));
319                pflush;
320                wait_a_while (nap_msec);
321             end;
322          end loop;
323
324          saywhat ("m4; press any key to continue");
325          Move (p4, Lines / 6, 6 * (Columns / 8));
326          --  Move(p4, Lines / 6, itmp * (Columns / 8));
327          pflush;
328          wait_a_while (nap_msec);
329
330          saywhat ("t5; press any key to continue");
331          Top (p5);
332          pflush;
333          wait_a_while (nap_msec);
334
335          saywhat ("t2; press any key to continue");
336          Top (p2);
337          pflush;
338          wait_a_while (nap_msec);
339
340          saywhat ("t1; press any key to continue");
341          Top (p1);
342          pflush;
343          wait_a_while (nap_msec);
344
345          saywhat ("d2; press any key to continue");
346          rmpanel (p2);
347          pflush;
348          wait_a_while (nap_msec);
349
350          saywhat ("h3; press any key to continue");
351          Hide (p3);
352          pflush;
353          wait_a_while (nap_msec);
354
355          saywhat ("d1; press any key to continue");
356          rmpanel (p1);
357          pflush;
358          wait_a_while (nap_msec);
359
360          saywhat ("d4; press any key to continue");
361          rmpanel (p4);
362          pflush;
363          wait_a_while (nap_msec);
364
365          saywhat ("d5; press any key to continue");
366          rmpanel (p5);
367          pflush;
368          wait_a_while (nap_msec);
369          if nap_msec = 1 then
370             exit;
371          else
372             nap_msec := 100;
373          end if;
374
375       end;
376    end loop;
377
378    Erase;
379    End_Windows;
380
381 end ncurses2.demo_panels;