• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1------------------------------------------------------------------------------
2--                                                                          --
3--                       GNAT ncurses Binding Samples                       --
4--                                                                          --
5--                                 ncurses                                  --
6--                                                                          --
7--                                 B O D Y                                  --
8--                                                                          --
9------------------------------------------------------------------------------
10-- Copyright 2018,2020 Thomas E. Dickey                                     --
11-- Copyright 2000-2008,2011 Free Software Foundation, Inc.                  --
12--                                                                          --
13-- Permission is hereby granted, free of charge, to any person obtaining a  --
14-- copy of this software and associated documentation files (the            --
15-- "Software"), to deal in the Software without restriction, including      --
16-- without limitation the rights to use, copy, modify, merge, publish,      --
17-- distribute, distribute with modifications, sublicense, and/or sell       --
18-- copies of the Software, and to permit persons to whom the Software is    --
19-- furnished to do so, subject to the following conditions:                 --
20--                                                                          --
21-- The above copyright notice and this permission notice shall be included  --
22-- in all copies or substantial portions of the Software.                   --
23--                                                                          --
24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
31--                                                                          --
32-- Except as contained in this notice, the name(s) of the above copyright   --
33-- holders shall not be used in advertising or otherwise to promote the     --
34-- sale, use or other dealings in this Software without prior written       --
35-- authorization.                                                           --
36------------------------------------------------------------------------------
37--  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
38--  Version Control
39--  $Revision: 1.9 $
40--  $Date: 2020/02/02 23:34:34 $
41--  Binding Version 01.00
42------------------------------------------------------------------------------
43with ncurses2.util; use ncurses2.util;
44with Terminal_Interface.Curses; use Terminal_Interface.Curses;
45with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
46with Terminal_Interface.Curses.Panels.User_Data;
47
48with ncurses2.genericPuts;
49
50procedure ncurses2.demo_panels (nap_mseci : Integer) is
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
179begin
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
382end ncurses2.demo_panels;
383