------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding Samples -- -- -- -- Sample.Menu_Demo -- -- -- -- B O D Y -- -- -- -- Version 00.92 -- -- -- -- The ncurses Ada95 binding is copyrighted 1996 by -- -- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de -- -- -- -- Permission is hereby granted to reproduce and distribute this -- -- binding by any means and for any fee, whether alone or as part -- -- of a larger distribution, in source or in binary form, PROVIDED -- -- this notice is included with any such distribution, and is not -- -- removed from any of its header files. Mention of ncurses and the -- -- author of this binding in any applications linked with it is -- -- highly appreciated. -- -- -- -- This binding comes AS IS with no warranty, implied or expressed. -- ------------------------------------------------------------------------------ -- Version Control -- $Revision: 1.4 $ ------------------------------------------------------------------------------ with Terminal_Interface.Curses; use Terminal_Interface.Curses; with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus; with Terminal_Interface.Curses.Menus.Menu_User_Data; with Terminal_Interface.Curses.Menus.Item_User_Data; with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Sample.Manifest; use Sample.Manifest; with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; with Sample.Menu_Demo.Handler; with Sample.Helpers; use Sample.Helpers; with Sample.Explanation; use Sample.Explanation; package body Sample.Menu_Demo is package Spacing_Demo is procedure Spacing_Test; end Spacing_Demo; package body Spacing_Demo is procedure Spacing_Test is function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean; procedure Set_Option_Key; procedure Set_Select_Key; procedure Set_Description_Key; procedure Set_Hide_Key; package Mh is new Sample.Menu_Demo.Handler (My_Driver); I : constant Item_Array (1 .. 12) := (New_Item ("January", "31 Days"), New_Item ("February", "28/29 Days"), New_Item ("March", "31 Days"), New_Item ("April", "30 Days"), New_Item ("May", "31 Days"), New_Item ("June", "30 Days"), New_Item ("July", "31 Days"), New_Item ("August", "31 Days"), New_Item ("September", "30 Days"), New_Item ("October", "31 Days"), New_Item ("November", "30 Days"), New_Item ("December", "31 Days")); M : Menu := New_Menu (I); Flip_State : Boolean := True; Hide_Long : Boolean := False; type Format_Code is (Four_By_1, Four_By_2, Four_By_3); type Operations is (Flip, Reorder, Reformat, Reselect, Describe); type Change is array (Operations) of Boolean; pragma Pack (Change); No_Change : constant Change := Change'(others => False); Current_Format : Format_Code := Four_By_1; To_Change : Change := No_Change; function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean is begin To_Change := No_Change; if K in User_Key_Code'Range then if K = QUIT then return True; end if; end if; if K in Special_Key_Code'Range then case K is when Key_F4 => To_Change (Flip) := True; return True; when Key_F5 => To_Change (Reformat) := True; Current_Format := Four_By_1; return True; when Key_F6 => To_Change (Reformat) := True; Current_Format := Four_By_2; return True; when Key_F7 => To_Change (Reformat) := True; Current_Format := Four_By_3; return True; when Key_F8 => To_Change (Reorder) := True; return True; when Key_F9 => To_Change (Reselect) := True; return True; when Key_F10 => if Current_Format /= Four_By_3 then To_Change (Describe) := True; return True; else return False; end if; when Key_F11 => Hide_Long := not Hide_Long; declare O : Item_Option_Set; begin for J in I'Range loop Get_Options (I (J), O); O.Selectable := True; if Hide_Long then case J is when 1 | 3 | 5 | 7 | 8 | 10 | 12 => O.Selectable := False; when others => null; end case; end if; Set_Options (I (J), O); end loop; end; return False; when others => null; end case; end if; return False; end My_Driver; procedure Set_Option_Key is O : Menu_Option_Set; begin if Current_Format = Four_By_1 then Set_Soft_Label_Key (8, ""); else Get_Options (M, O); if O.Row_Major_Order then Set_Soft_Label_Key (8, "O-Col"); else Set_Soft_Label_Key (8, "O-Row"); end if; end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Option_Key; procedure Set_Select_Key is O : Menu_Option_Set; begin Get_Options (M, O); if O.One_Valued then Set_Soft_Label_Key (9, "Multi"); else Set_Soft_Label_Key (9, "Singl"); end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Select_Key; procedure Set_Description_Key is O : Menu_Option_Set; begin if Current_Format = Four_By_3 then Set_Soft_Label_Key (10, ""); else Get_Options (M, O); if O.Show_Descriptions then Set_Soft_Label_Key (10, "-Desc"); else Set_Soft_Label_Key (10, "+Desc"); end if; end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Description_Key; procedure Set_Hide_Key is begin if Hide_Long then Set_Soft_Label_Key (11, "Enab"); else Set_Soft_Label_Key (11, "Disab"); end if; Refresh_Soft_Label_Keys_Without_Update; end Set_Hide_Key; begin Push_Environment ("MENU01"); Notepad ("MENU-PAD01"); Default_Labels; Set_Soft_Label_Key (4, "Flip"); Set_Soft_Label_Key (5, "4x1"); Set_Soft_Label_Key (6, "4x2"); Set_Soft_Label_Key (7, "4x3"); Set_Option_Key; Set_Select_Key; Set_Description_Key; Set_Hide_Key; Set_Format (M, 4, 1); loop Mh.Drive_Me (M); exit when To_Change = No_Change; if To_Change (Flip) then if Flip_State then Flip_State := False; Set_Spacing (M, 3, 2, 0); else Flip_State := True; Set_Spacing (M); end if; elsif To_Change (Reformat) then case Current_Format is when Four_By_1 => Set_Format (M, 4, 1); when Four_By_2 => Set_Format (M, 4, 2); when Four_By_3 => declare O : Menu_Option_Set; begin Get_Options (M, O); O.Show_Descriptions := False; Set_Options (M, O); Set_Format (M, 4, 3); end; end case; Set_Option_Key; Set_Description_Key; elsif To_Change (Reorder) then declare O : Menu_Option_Set; begin Get_Options (M, O); O.Row_Major_Order := not O.Row_Major_Order; Set_Options (M, O); Set_Option_Key; end; elsif To_Change (Reselect) then declare O : Menu_Option_Set; begin Get_Options (M, O); O.One_Valued := not O.One_Valued; Set_Options (M, O); Set_Select_Key; end; elsif To_Change (Describe) then declare O : Menu_Option_Set; begin Get_Options (M, O); O.Show_Descriptions := not O.Show_Descriptions; Set_Options (M, O); Set_Description_Key; end; else null; end if; end loop; Set_Spacing (M); Flip_State := True; Pop_Environment; Delete (M); end Spacing_Test; end Spacing_Demo; procedure Demo is -- We use this datatype only to test the instantiation of -- the Menu_User_Data generic package. No functionality -- behind it. type User_Data is new Integer; type User_Data_Access is access User_Data; -- Those packages are only instantiated to test the usability. -- No real functionality is shown in the demo. package MUD is new Menu_User_Data (User_Data, User_Data_Access); package IUD is new Item_User_Data (User_Data, User_Data_Access); function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean; package Mh is new Sample.Menu_Demo.Handler (My_Driver); Itm : constant Item_Array (1 .. 2) := (New_Item ("Menu Layout Options"), New_Item ("Demo of Hook functions")); M : Menu := New_Menu (Itm); U1 : User_Data_Access := new User_Data'(4711); U2 : User_Data_Access; U3 : User_Data_Access := new User_Data'(4712); U4 : User_Data_Access; function My_Driver (M : Menu; K : Key_Code; P : Panel) return Boolean is Idx : constant Positive := Get_Index (Current (M)); begin if K in User_Key_Code'Range then if K = QUIT then return True; elsif K = SELECT_ITEM then if Idx in Itm'Range then Hide (P); Update_Panels; end if; case Idx is when 1 => Spacing_Demo.Spacing_Test; when others => Not_Implemented; end case; if Idx in Itm'Range then Top (P); Show (P); Update_Panels; Update_Screen; end if; end if; end if; return False; end My_Driver; begin Push_Environment ("MENU00"); Notepad ("MENU-PAD00"); Default_Labels; Refresh_Soft_Label_Keys_Without_Update; Set_Pad_Character (M, '|'); MUD.Set_User_Data (M, U1); IUD.Set_User_Data (Itm (1), U3); Mh.Drive_Me (M); MUD.Get_User_Data (M, U2); pragma Assert (U1 = U2 and U1.all = 4711); IUD.Get_User_Data (Itm (1), U4); pragma Assert (U3 = U4 and U3.all = 4712); Pop_Environment; Delete (M); end Demo; end Sample.Menu_Demo;