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