Gitiles
Code Review Sign In
gerrit.omnirom.org / android_external_libncurses / c1bcd6dd9af6865867a3d6716e4c1a45021a90e5 / . / Ada95 / samples / sample-menu_demo.adb
blob: 38646748713f60b2cce9d7d871950cfa56fe2def [file] [log] [blame]
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]1------------------------------------------------------------------------------
2-- --
3-- GNAT ncurses Binding Samples --
4-- --
5-- Sample.Menu_Demo --
6-- --
7-- B O D Y --
8-- --
9------------------------------------------------------------------------------
10-- Copyright (c) 1998-2004,2008 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: Juergen Pfeifer, 1996
37-- Version Control
38-- $Revision: 1.18 $
39-- $Date: 2008/07/26 18:48:30 $
40-- Binding Version 01.00
41------------------------------------------------------------------------------
42with Terminal_Interface.Curses; use Terminal_Interface.Curses;
43with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
44with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
45with Terminal_Interface.Curses.Menus.Menu_User_Data;
46with Terminal_Interface.Curses.Menus.Item_User_Data;
47
48with Sample.Manifest; use Sample.Manifest;
49with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
50with Sample.Menu_Demo.Handler;
51with Sample.Helpers; use Sample.Helpers;
52with Sample.Explanation; use Sample.Explanation;
53
54package body Sample.Menu_Demo is
55
56 package Spacing_Demo is
57 procedure Spacing_Test;
58 end Spacing_Demo;
59
60 package body Spacing_Demo is
61
62 procedure Spacing_Test
63 is
64 function My_Driver (M : Menu;
65 K : Key_Code;
66 P : Panel) return Boolean;
67
68 procedure Set_Option_Key;
69 procedure Set_Select_Key;
70 procedure Set_Description_Key;
71 procedure Set_Hide_Key;
72
73 package Mh is new Sample.Menu_Demo.Handler (My_Driver);
74
75 I : Item_Array_Access := new Item_Array'
76 (New_Item ("January", "31 Days"),
77 New_Item ("February", "28/29 Days"),
78 New_Item ("March", "31 Days"),
79 New_Item ("April", "30 Days"),
80 New_Item ("May", "31 Days"),
81 New_Item ("June", "30 Days"),
82 New_Item ("July", "31 Days"),
83 New_Item ("August", "31 Days"),
84 New_Item ("September", "30 Days"),
85 New_Item ("October", "31 Days"),
86 New_Item ("November", "30 Days"),
87 New_Item ("December", "31 Days"),
88 Null_Item);
89
90 M : Menu := New_Menu (I);
91 Flip_State : Boolean := True;
92 Hide_Long : Boolean := False;
93
94 type Format_Code is (Four_By_1, Four_By_2, Four_By_3);
95 type Operations is (Flip, Reorder, Reformat, Reselect, Describe);
96
97 type Change is array (Operations) of Boolean;
98 pragma Pack (Change);
99 No_Change : constant Change := Change'(others => False);
100
101 Current_Format : Format_Code := Four_By_1;
102 To_Change : Change := No_Change;
103
104 function My_Driver (M : Menu;
105 K : Key_Code;
106 P : Panel) return Boolean
107 is
108 begin
109 if M = Null_Menu then
110 raise Menu_Exception;
111 end if;
112 if P = Null_Panel then
113 raise Panel_Exception;
114 end if;
115 To_Change := No_Change;
116 if K in User_Key_Code'Range then
117 if K = QUIT then
118 return True;
119 end if;
120 end if;
121 if K in Special_Key_Code'Range then
122 case K is
123 when Key_F4 =>
124 To_Change (Flip) := True;
125 return True;
126 when Key_F5 =>
127 To_Change (Reformat) := True;
128 Current_Format := Four_By_1;
129 return True;
130 when Key_F6 =>
131 To_Change (Reformat) := True;
132 Current_Format := Four_By_2;
133 return True;
134 when Key_F7 =>
135 To_Change (Reformat) := True;
136 Current_Format := Four_By_3;
137 return True;
138 when Key_F8 =>
139 To_Change (Reorder) := True;
140 return True;
141 when Key_F9 =>
142 To_Change (Reselect) := True;
143 return True;
144 when Key_F10 =>
145 if Current_Format /= Four_By_3 then
146 To_Change (Describe) := True;
147 return True;
148 else
149 return False;
150 end if;
151 when Key_F11 =>
152 Hide_Long := not Hide_Long;
153 declare
154 O : Item_Option_Set;
155 begin
156 for J in I'Range loop
157 Get_Options (I (J), O);
158 O.Selectable := True;
159 if Hide_Long then
160 case J is
161 when 1 | 3 | 5 | 7 | 8 | 10 | 12 =>
162 O.Selectable := False;
163 when others => null;
164 end case;
165 end if;
166 Set_Options (I (J), O);
167 end loop;
168 end;
169 return False;
170 when others => null;
171 end case;
172 end if;
173 return False;
174 end My_Driver;
175
176 procedure Set_Option_Key
177 is
178 O : Menu_Option_Set;
179 begin
180 if Current_Format = Four_By_1 then
181 Set_Soft_Label_Key (8, "");
182 else
183 Get_Options (M, O);
184 if O.Row_Major_Order then
185 Set_Soft_Label_Key (8, "O-Col");
186 else
187 Set_Soft_Label_Key (8, "O-Row");
188 end if;
189 end if;
190 Refresh_Soft_Label_Keys_Without_Update;
191 end Set_Option_Key;
192
193 procedure Set_Select_Key
194 is
195 O : Menu_Option_Set;
196 begin
197 Get_Options (M, O);
198 if O.One_Valued then
199 Set_Soft_Label_Key (9, "Multi");
200 else
201 Set_Soft_Label_Key (9, "Singl");
202 end if;
203 Refresh_Soft_Label_Keys_Without_Update;
204 end Set_Select_Key;
205
206 procedure Set_Description_Key
207 is
208 O : Menu_Option_Set;
209 begin
210 if Current_Format = Four_By_3 then
211 Set_Soft_Label_Key (10, "");
212 else
213 Get_Options (M, O);
214 if O.Show_Descriptions then
215 Set_Soft_Label_Key (10, "-Desc");
216 else
217 Set_Soft_Label_Key (10, "+Desc");
218 end if;
219 end if;
220 Refresh_Soft_Label_Keys_Without_Update;
221 end Set_Description_Key;
222
223 procedure Set_Hide_Key
224 is
225 begin
226 if Hide_Long then
227 Set_Soft_Label_Key (11, "Enab");
228 else
229 Set_Soft_Label_Key (11, "Disab");
230 end if;
231 Refresh_Soft_Label_Keys_Without_Update;
232 end Set_Hide_Key;
233
234 begin
235 Push_Environment ("MENU01");
236 Notepad ("MENU-PAD01");
237 Default_Labels;
238 Set_Soft_Label_Key (4, "Flip");
239 Set_Soft_Label_Key (5, "4x1");
240 Set_Soft_Label_Key (6, "4x2");
241 Set_Soft_Label_Key (7, "4x3");
242 Set_Option_Key;
243 Set_Select_Key;
244 Set_Description_Key;
245 Set_Hide_Key;
246
247 Set_Format (M, 4, 1);
248 loop
249 Mh.Drive_Me (M);
250 exit when To_Change = No_Change;
251 if To_Change (Flip) then
252 if Flip_State then
253 Flip_State := False;
254 Set_Spacing (M, 3, 2, 0);
255 else
256 Flip_State := True;
257 Set_Spacing (M);
258 end if;
259 elsif To_Change (Reformat) then
260 case Current_Format is
261 when Four_By_1 => Set_Format (M, 4, 1);
262 when Four_By_2 => Set_Format (M, 4, 2);
263 when Four_By_3 =>
264 declare
265 O : Menu_Option_Set;
266 begin
267 Get_Options (M, O);
268 O.Show_Descriptions := False;
269 Set_Options (M, O);
270 Set_Format (M, 4, 3);
271 end;
272 end case;
273 Set_Option_Key;
274 Set_Description_Key;
275 elsif To_Change (Reorder) then
276 declare
277 O : Menu_Option_Set;
278 begin
279 Get_Options (M, O);
280 O.Row_Major_Order := not O.Row_Major_Order;
281 Set_Options (M, O);
282 Set_Option_Key;
283 end;
284 elsif To_Change (Reselect) then
285 declare
286 O : Menu_Option_Set;
287 begin
288 Get_Options (M, O);
289 O.One_Valued := not O.One_Valued;
290 Set_Options (M, O);
291 Set_Select_Key;
292 end;
293 elsif To_Change (Describe) then
294 declare
295 O : Menu_Option_Set;
296 begin
297 Get_Options (M, O);
298 O.Show_Descriptions := not O.Show_Descriptions;
299 Set_Options (M, O);
300 Set_Description_Key;
301 end;
302 else
303 null;
304 end if;
305 end loop;
306 Set_Spacing (M);
307
308 Pop_Environment;
309 pragma Assert (Get_Index (Items (M, 1)) = Get_Index (I (1)));
310 Delete (M);
311 Free (I, True);
312 end Spacing_Test;
313 end Spacing_Demo;
314
315 procedure Demo
316 is
317 -- We use this datatype only to test the instantiation of
318 -- the Menu_User_Data generic package. No functionality
319 -- behind it.
320 type User_Data is new Integer;
321 type User_Data_Access is access User_Data;
322
323 -- Those packages are only instantiated to test the usability.
324 -- No real functionality is shown in the demo.
325 package MUD is new Menu_User_Data (User_Data, User_Data_Access);
326 package IUD is new Item_User_Data (User_Data, User_Data_Access);
327
328 function My_Driver (M : Menu;
329 K : Key_Code;
330 P : Panel) return Boolean;
331
332 package Mh is new Sample.Menu_Demo.Handler (My_Driver);
333
334 Itm : Item_Array_Access := new Item_Array'
335 (New_Item ("Menu Layout Options"),
336 New_Item ("Demo of Hook functions"),
337 Null_Item);
338 M : Menu := New_Menu (Itm);
339
340 U1 : constant User_Data_Access := new User_Data'(4711);
341 U2 : User_Data_Access;
342 U3 : constant User_Data_Access := new User_Data'(4712);
343 U4 : User_Data_Access;
344
345 function My_Driver (M : Menu;
346 K : Key_Code;
347 P : Panel) return Boolean
348 is
349 Idx : constant Positive := Get_Index (Current (M));
350 begin
351 if K in User_Key_Code'Range then
352 if K = QUIT then
353 return True;
354 elsif K = SELECT_ITEM then
355 if Idx in Itm'Range then
356 Hide (P);
357 Update_Panels;
358 end if;
359 case Idx is
360 when 1 => Spacing_Demo.Spacing_Test;
361 when others => Not_Implemented;
362 end case;
363 if Idx in Itm'Range then
364 Top (P);
365 Show (P);
366 Update_Panels;
367 Update_Screen;
368 end if;
369 end if;
370 end if;
371 return False;
372 end My_Driver;
373 begin
374 Push_Environment ("MENU00");
375 Notepad ("MENU-PAD00");
376 Default_Labels;
377 Refresh_Soft_Label_Keys_Without_Update;
378 Set_Pad_Character (M, '|');
379
380 MUD.Set_User_Data (M, U1);
381 IUD.Set_User_Data (Itm (1), U3);
382
383 Mh.Drive_Me (M);
384
385 MUD.Get_User_Data (M, U2);
386 pragma Assert (U1 = U2 and U1.all = 4711);
387
388 IUD.Get_User_Data (Itm (1), U4);
389 pragma Assert (U3 = U4 and U3.all = 4712);
390
391 Pop_Environment;
392 Delete (M);
393 Free (Itm, True);
394 end Demo;
395
396end Sample.Menu_Demo;