1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Menu_Demo -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- 11-- -- 12-- Permission is hereby granted, free of charge, to any person obtaining a -- 13-- copy of this software and associated documentation files (the -- 14-- "Software"), to deal in the Software without restriction, including -- 15-- without limitation the rights to use, copy, modify, merge, publish, -- 16-- distribute, distribute with modifications, sublicense, and/or sell -- 17-- copies of the Software, and to permit persons to whom the Software is -- 18-- furnished to do so, subject to the following conditions: -- 19-- -- 20-- The above copyright notice and this permission notice shall be included -- 21-- in all copies or substantial portions of the Software. -- 22-- -- 23-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- 24-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- 25-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- 26-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- 27-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- 28-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- 29-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- 30-- -- 31-- Except as contained in this notice, the name(s) of the above copyright -- 32-- holders shall not be used in advertising or otherwise to promote the -- 33-- sale, use or other dealings in this Software without prior written -- 34-- authorization. -- 35------------------------------------------------------------------------------ 36-- Author: Juergen Pfeifer, 1996 37-- Version Control 38-- $Revision: 1.19 $ 39-- $Date: 2011/03/23 00:44:12 $ 40-- Binding Version 01.00 41------------------------------------------------------------------------------ 42with Terminal_Interface.Curses; use Terminal_Interface.Curses; 43with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; 44with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus; 45with Terminal_Interface.Curses.Menus.Menu_User_Data; 46with Terminal_Interface.Curses.Menus.Item_User_Data; 47 48with Sample.Manifest; use Sample.Manifest; 49with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; 50with Sample.Menu_Demo.Handler; 51with Sample.Helpers; use Sample.Helpers; 52with Sample.Explanation; use Sample.Explanation; 53 54package body Sample.Menu_Demo is 55 56 package Spacing_Demo is 57 procedure Spacing_Test; 58 end Spacing_Demo; 59 60 package body Spacing_Demo is 61 62 procedure Spacing_Test 63 is 64 function My_Driver (M : Menu; 65 K : Key_Code; 66 P : Panel) return Boolean; 67 68 procedure Set_Option_Key; 69 procedure Set_Select_Key; 70 procedure Set_Description_Key; 71 procedure Set_Hide_Key; 72 73 package Mh is new Sample.Menu_Demo.Handler (My_Driver); 74 75 I : Item_Array_Access := new Item_Array' 76 (New_Item ("January", "31 Days"), 77 New_Item ("February", "28/29 Days"), 78 New_Item ("March", "31 Days"), 79 New_Item ("April", "30 Days"), 80 New_Item ("May", "31 Days"), 81 New_Item ("June", "30 Days"), 82 New_Item ("July", "31 Days"), 83 New_Item ("August", "31 Days"), 84 New_Item ("September", "30 Days"), 85 New_Item ("October", "31 Days"), 86 New_Item ("November", "30 Days"), 87 New_Item ("December", "31 Days"), 88 Null_Item); 89 90 M : Menu := New_Menu (I); 91 Flip_State : Boolean := True; 92 Hide_Long : Boolean := False; 93 94 type Format_Code is (Four_By_1, Four_By_2, Four_By_3); 95 type Operations is (Flip, Reorder, Reformat, Reselect, Describe); 96 97 type Change is array (Operations) of Boolean; 98 pragma Pack (Change); 99 No_Change : constant Change := Change'(others => False); 100 101 Current_Format : Format_Code := Four_By_1; 102 To_Change : Change := No_Change; 103 104 function My_Driver (M : Menu; 105 K : Key_Code; 106 P : Panel) return Boolean 107 is 108 begin 109 if M = Null_Menu then 110 raise Menu_Exception; 111 end if; 112 if P = Null_Panel then 113 raise Panel_Exception; 114 end if; 115 To_Change := No_Change; 116 if K in User_Key_Code'Range then 117 if K = QUIT then 118 return True; 119 end if; 120 end if; 121 if K in Special_Key_Code'Range then 122 case K is 123 when Key_F4 => 124 To_Change (Flip) := True; 125 return True; 126 when Key_F5 => 127 To_Change (Reformat) := True; 128 Current_Format := Four_By_1; 129 return True; 130 when Key_F6 => 131 To_Change (Reformat) := True; 132 Current_Format := Four_By_2; 133 return True; 134 when Key_F7 => 135 To_Change (Reformat) := True; 136 Current_Format := Four_By_3; 137 return True; 138 when Key_F8 => 139 To_Change (Reorder) := True; 140 return True; 141 when Key_F9 => 142 To_Change (Reselect) := True; 143 return True; 144 when Key_F10 => 145 if Current_Format /= Four_By_3 then 146 To_Change (Describe) := True; 147 return True; 148 else 149 return False; 150 end if; 151 when Key_F11 => 152 Hide_Long := not Hide_Long; 153 declare 154 O : Item_Option_Set; 155 begin 156 for J in I'Range loop 157 Get_Options (I.all (J), O); 158 O.Selectable := True; 159 if Hide_Long then 160 case J is 161 when 1 | 3 | 5 | 7 | 8 | 10 | 12 => 162 O.Selectable := False; 163 when others => null; 164 end case; 165 end if; 166 Set_Options (I.all (J), O); 167 end loop; 168 end; 169 return False; 170 when others => null; 171 end case; 172 end if; 173 return False; 174 end My_Driver; 175 176 procedure Set_Option_Key 177 is 178 O : Menu_Option_Set; 179 begin 180 if Current_Format = Four_By_1 then 181 Set_Soft_Label_Key (8, ""); 182 else 183 Get_Options (M, O); 184 if O.Row_Major_Order then 185 Set_Soft_Label_Key (8, "O-Col"); 186 else 187 Set_Soft_Label_Key (8, "O-Row"); 188 end if; 189 end if; 190 Refresh_Soft_Label_Keys_Without_Update; 191 end Set_Option_Key; 192 193 procedure Set_Select_Key 194 is 195 O : Menu_Option_Set; 196 begin 197 Get_Options (M, O); 198 if O.One_Valued then 199 Set_Soft_Label_Key (9, "Multi"); 200 else 201 Set_Soft_Label_Key (9, "Singl"); 202 end if; 203 Refresh_Soft_Label_Keys_Without_Update; 204 end Set_Select_Key; 205 206 procedure Set_Description_Key 207 is 208 O : Menu_Option_Set; 209 begin 210 if Current_Format = Four_By_3 then 211 Set_Soft_Label_Key (10, ""); 212 else 213 Get_Options (M, O); 214 if O.Show_Descriptions then 215 Set_Soft_Label_Key (10, "-Desc"); 216 else 217 Set_Soft_Label_Key (10, "+Desc"); 218 end if; 219 end if; 220 Refresh_Soft_Label_Keys_Without_Update; 221 end Set_Description_Key; 222 223 procedure Set_Hide_Key 224 is 225 begin 226 if Hide_Long then 227 Set_Soft_Label_Key (11, "Enab"); 228 else 229 Set_Soft_Label_Key (11, "Disab"); 230 end if; 231 Refresh_Soft_Label_Keys_Without_Update; 232 end Set_Hide_Key; 233 234 begin 235 Push_Environment ("MENU01"); 236 Notepad ("MENU-PAD01"); 237 Default_Labels; 238 Set_Soft_Label_Key (4, "Flip"); 239 Set_Soft_Label_Key (5, "4x1"); 240 Set_Soft_Label_Key (6, "4x2"); 241 Set_Soft_Label_Key (7, "4x3"); 242 Set_Option_Key; 243 Set_Select_Key; 244 Set_Description_Key; 245 Set_Hide_Key; 246 247 Set_Format (M, 4, 1); 248 loop 249 Mh.Drive_Me (M); 250 exit when To_Change = No_Change; 251 if To_Change (Flip) then 252 if Flip_State then 253 Flip_State := False; 254 Set_Spacing (M, 3, 2, 0); 255 else 256 Flip_State := True; 257 Set_Spacing (M); 258 end if; 259 elsif To_Change (Reformat) then 260 case Current_Format is 261 when Four_By_1 => Set_Format (M, 4, 1); 262 when Four_By_2 => Set_Format (M, 4, 2); 263 when Four_By_3 => 264 declare 265 O : Menu_Option_Set; 266 begin 267 Get_Options (M, O); 268 O.Show_Descriptions := False; 269 Set_Options (M, O); 270 Set_Format (M, 4, 3); 271 end; 272 end case; 273 Set_Option_Key; 274 Set_Description_Key; 275 elsif To_Change (Reorder) then 276 declare 277 O : Menu_Option_Set; 278 begin 279 Get_Options (M, O); 280 O.Row_Major_Order := not O.Row_Major_Order; 281 Set_Options (M, O); 282 Set_Option_Key; 283 end; 284 elsif To_Change (Reselect) then 285 declare 286 O : Menu_Option_Set; 287 begin 288 Get_Options (M, O); 289 O.One_Valued := not O.One_Valued; 290 Set_Options (M, O); 291 Set_Select_Key; 292 end; 293 elsif To_Change (Describe) then 294 declare 295 O : Menu_Option_Set; 296 begin 297 Get_Options (M, O); 298 O.Show_Descriptions := not O.Show_Descriptions; 299 Set_Options (M, O); 300 Set_Description_Key; 301 end; 302 else 303 null; 304 end if; 305 end loop; 306 Set_Spacing (M); 307 308 Pop_Environment; 309 pragma Assert (Get_Index (Items (M, 1)) = Get_Index (I (1))); 310 Delete (M); 311 Free (I, True); 312 end Spacing_Test; 313 end Spacing_Demo; 314 315 procedure Demo 316 is 317 -- We use this datatype only to test the instantiation of 318 -- the Menu_User_Data generic package. No functionality 319 -- behind it. 320 type User_Data is new Integer; 321 type User_Data_Access is access User_Data; 322 323 -- Those packages are only instantiated to test the usability. 324 -- No real functionality is shown in the demo. 325 package MUD is new Menu_User_Data (User_Data, User_Data_Access); 326 package IUD is new Item_User_Data (User_Data, User_Data_Access); 327 328 function My_Driver (M : Menu; 329 K : Key_Code; 330 P : Panel) return Boolean; 331 332 package Mh is new Sample.Menu_Demo.Handler (My_Driver); 333 334 Itm : Item_Array_Access := new Item_Array' 335 (New_Item ("Menu Layout Options"), 336 New_Item ("Demo of Hook functions"), 337 Null_Item); 338 M : Menu := New_Menu (Itm); 339 340 U1 : constant User_Data_Access := new User_Data'(4711); 341 U2 : User_Data_Access; 342 U3 : constant User_Data_Access := new User_Data'(4712); 343 U4 : User_Data_Access; 344 345 function My_Driver (M : Menu; 346 K : Key_Code; 347 P : Panel) return Boolean 348 is 349 Idx : constant Positive := Get_Index (Current (M)); 350 begin 351 if K in User_Key_Code'Range then 352 if K = QUIT then 353 return True; 354 elsif K = SELECT_ITEM then 355 if Idx in Itm'Range then 356 Hide (P); 357 Update_Panels; 358 end if; 359 case Idx is 360 when 1 => Spacing_Demo.Spacing_Test; 361 when others => Not_Implemented; 362 end case; 363 if Idx in Itm'Range then 364 Top (P); 365 Show (P); 366 Update_Panels; 367 Update_Screen; 368 end if; 369 end if; 370 end if; 371 return False; 372 end My_Driver; 373 begin 374 Push_Environment ("MENU00"); 375 Notepad ("MENU-PAD00"); 376 Default_Labels; 377 Refresh_Soft_Label_Keys_Without_Update; 378 Set_Pad_Character (M, '|'); 379 380 MUD.Set_User_Data (M, U1); 381 IUD.Set_User_Data (Itm.all (1), U3); 382 383 Mh.Drive_Me (M); 384 385 MUD.Get_User_Data (M, U2); 386 pragma Assert (U1 = U2 and U1.all = 4711); 387 388 IUD.Get_User_Data (Itm.all (1), U4); 389 pragma Assert (U3 = U4 and U3.all = 4712); 390 391 Pop_Environment; 392 Delete (M); 393 Free (Itm, True); 394 end Demo; 395 396end Sample.Menu_Demo; 397