1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Curses_Demo -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020 Thomas E. Dickey -- 11-- Copyright 1998-2004,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.18 $ 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.Menus; use Terminal_Interface.Curses.Menus; 45with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse; 46with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; 47with Terminal_Interface.Curses.Panels.User_Data; 48 49with Sample.Manifest; use Sample.Manifest; 50with Sample.Helpers; use Sample.Helpers; 51with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; 52 53with Sample.Explanation; use Sample.Explanation; 54 55with Sample.Menu_Demo.Handler; 56with Sample.Curses_Demo.Mouse; 57with Sample.Curses_Demo.Attributes; 58 59package body Sample.Curses_Demo is 60 61 type User_Data is new Integer; 62 type User_Data_Access is access all User_Data; 63 package PUD is new Panels.User_Data (User_Data, User_Data_Access); 64 -- We use above instantiation of the generic User_Data package to 65 -- demonstrate and test the use of the user data mechanism. 66 67 procedure Demo 68 is 69 function My_Driver (M : Menu; 70 K : Key_Code; 71 Pan : Panel) return Boolean; 72 package Mh is new Sample.Menu_Demo.Handler (My_Driver); 73 74 Itm : Item_Array_Access := new Item_Array' 75 (New_Item ("Attributes Demo"), 76 New_Item ("Mouse Demo"), 77 Null_Item); 78 M : Menu := New_Menu (Itm); 79 U1 : constant User_Data_Access := new User_Data'(4711); 80 U2 : User_Data_Access; 81 82 function My_Driver (M : Menu; 83 K : Key_Code; 84 Pan : Panel) return Boolean 85 is 86 Idx : constant Positive := Get_Index (Current (M)); 87 Result : Boolean := False; 88 begin 89 PUD.Set_User_Data (Pan, U1); -- set some user data, just for fun 90 if K in User_Key_Code'Range then 91 if K = QUIT then 92 Result := True; 93 elsif K = SELECT_ITEM then 94 if Idx in Itm'Range then 95 Hide (Pan); 96 Update_Panels; 97 end if; 98 case Idx is 99 when 1 => Sample.Curses_Demo.Attributes.Demo; 100 when 2 => Sample.Curses_Demo.Mouse.Demo; 101 when others => Not_Implemented; 102 end case; 103 if Idx in Itm'Range then 104 Top (Pan); 105 Show (Pan); 106 Update_Panels; 107 Update_Screen; 108 end if; 109 end if; 110 end if; 111 PUD.Get_User_Data (Pan, U2); -- get the user data 112 pragma Assert (U1.all = U2.all and then U1 = U2); 113 return Result; 114 end My_Driver; 115 116 begin 117 118 if (1 + Item_Count (M)) /= Itm'Length then 119 raise Constraint_Error; 120 end if; 121 122 if not Has_Mouse then 123 declare 124 O : Item_Option_Set; 125 begin 126 Get_Options (Itm.all (2), O); 127 O.Selectable := False; 128 Set_Options (Itm.all (2), O); 129 end; 130 end if; 131 132 Push_Environment ("CURSES00"); 133 Notepad ("CURSES-PAD00"); 134 Default_Labels; 135 Refresh_Soft_Label_Keys_Without_Update; 136 137 Mh.Drive_Me (M, " Demo "); 138 Pop_Environment; 139 140 Delete (M); 141 Free (Itm, True); 142 end Demo; 143 144end Sample.Curses_Demo; 145