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