source: ncurses/vendor/current/Ada95/samples/ncurses2-demo_panels.adb@ 1910

Last change on this file since 1910 was 1910, checked in by Silvan Scherrer, 8 years ago

ncurses: import vendor version 5.9
File size: 12.4 KB
Line 
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------------------------------------------------------------------------------
42with ncurses2.util; use ncurses2.util;
43with Terminal_Interface.Curses; use Terminal_Interface.Curses;
44with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
45with Terminal_Interface.Curses.Panels.User_Data;
46
47with ncurses2.genericPuts;
48
49procedure 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
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;
Note: See TracBrowser for help on using the repository browser.