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