1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
11 -- The ncurses Ada95 binding is copyrighted 1996 by --
12 -- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de --
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. --
22 -- This binding comes AS IS with no warranty, implied or expressed. --
23 ------------------------------------------------------------------------------
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;
33 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
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;
42 package body Sample.Menu_Demo is
44 package Spacing_Demo is
45 procedure Spacing_Test;
48 package body Spacing_Demo is
50 procedure Spacing_Test
52 function My_Driver (M : Menu;
54 P : Panel) return Boolean;
56 procedure Set_Option_Key;
57 procedure Set_Select_Key;
58 procedure Set_Description_Key;
59 procedure Set_Hide_Key;
61 package Mh is new Sample.Menu_Demo.Handler (My_Driver);
63 I : constant Item_Array (1 .. 12) := (New_Item ("January",
79 New_Item ("September",
88 M : Menu := New_Menu (I);
89 Flip_State : Boolean := True;
90 Hide_Long : Boolean := False;
92 type Format_Code is (Four_By_1, Four_By_2, Four_By_3);
93 type Operations is (Flip, Reorder, Reformat, Reselect, Describe);
95 type Change is array (Operations) of Boolean;
97 No_Change : constant Change := Change'(others => False);
99 Current_Format : Format_Code := Four_By_1;
100 To_Change : Change := No_Change;
102 function My_Driver (M : Menu;
104 P : Panel) return Boolean
107 To_Change := No_Change;
108 if K in User_Key_Code'Range then
113 if K in Special_Key_Code'Range then
116 To_Change (Flip) := True;
119 To_Change (Reformat) := True;
120 Current_Format := Four_By_1;
123 To_Change (Reformat) := True;
124 Current_Format := Four_By_2;
127 To_Change (Reformat) := True;
128 Current_Format := Four_By_3;
131 To_Change (Reorder) := True;
134 To_Change (Reselect) := True;
137 if Current_Format /= Four_By_3 then
138 To_Change (Describe) := True;
144 Hide_Long := not Hide_Long;
148 for J in I'Range loop
149 Get_Options (I (J), O);
150 O.Selectable := True;
153 when 1 | 3 | 5 | 7 | 8 | 10 | 12 =>
154 O.Selectable := False;
158 Set_Options (I (J), O);
168 procedure Set_Option_Key
172 if Current_Format = Four_By_1 then
173 Set_Soft_Label_Key (8, "");
176 if O.Row_Major_Order then
177 Set_Soft_Label_Key (8, "O-Col");
179 Set_Soft_Label_Key (8, "O-Row");
182 Refresh_Soft_Label_Keys_Without_Update;
185 procedure Set_Select_Key
191 Set_Soft_Label_Key (9, "Multi");
193 Set_Soft_Label_Key (9, "Singl");
195 Refresh_Soft_Label_Keys_Without_Update;
198 procedure Set_Description_Key
202 if Current_Format = Four_By_3 then
203 Set_Soft_Label_Key (10, "");
206 if O.Show_Descriptions then
207 Set_Soft_Label_Key (10, "-Desc");
209 Set_Soft_Label_Key (10, "+Desc");
212 Refresh_Soft_Label_Keys_Without_Update;
213 end Set_Description_Key;
215 procedure Set_Hide_Key
219 Set_Soft_Label_Key (11, "Enab");
221 Set_Soft_Label_Key (11, "Disab");
223 Refresh_Soft_Label_Keys_Without_Update;
227 Push_Environment ("MENU01");
228 Notepad ("MENU-PAD01");
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");
239 Set_Format (M, 4, 1);
242 exit when To_Change = No_Change;
243 if To_Change (Flip) then
246 Set_Spacing (M, 3, 2, 0);
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);
260 O.Show_Descriptions := False;
262 Set_Format (M, 4, 3);
267 elsif To_Change (Reorder) then
272 O.Row_Major_Order := not O.Row_Major_Order;
276 elsif To_Change (Reselect) then
281 O.One_Valued := not O.One_Valued;
285 elsif To_Change (Describe) then
290 O.Show_Descriptions := not O.Show_Descriptions;
309 -- We use this datatype only to test the instantiation of
310 -- the Menu_User_Data generic package. No functionality
312 type User_Data is new Integer;
313 type User_Data_Access is access User_Data;
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);
320 function My_Driver (M : Menu;
322 P : Panel) return Boolean;
324 package Mh is new Sample.Menu_Demo.Handler (My_Driver);
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);
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;
336 function My_Driver (M : Menu;
338 P : Panel) return Boolean
340 Idx : constant Positive := Get_Index (Current (M));
342 if K in User_Key_Code'Range then
345 elsif K = SELECT_ITEM then
346 if Idx in Itm'Range then
351 when 1 => Spacing_Demo.Spacing_Test;
352 when others => Not_Implemented;
354 if Idx in Itm'Range then
365 Push_Environment ("MENU00");
366 Notepad ("MENU-PAD00");
368 Refresh_Soft_Label_Keys_Without_Update;
369 Set_Pad_Character (M, '|');
371 MUD.Set_User_Data (M, U1);
372 IUD.Set_User_Data (Itm (1), U3);
376 MUD.Get_User_Data (M, U2);
377 pragma Assert (U1 = U2 and U1.all = 4711);
379 IUD.Get_User_Data (Itm (1), U4);
380 pragma Assert (U3 = U4 and U3.all = 4712);
386 end Sample.Menu_Demo;