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