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;