X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fsample-curses_demo.adb;h=4dd96a721d2aa9465837958cd1885588f10f8c2b;hp=81ac9a5a6aaf91d43eb5235bbe38ee8d4cdb0f02;hb=88e7914acafc37f84af25b80f403eb4290e423d4;hpb=3a9b6a3bf0269231bef7de74757a910dedd04e0c diff --git a/Ada95/samples/sample-curses_demo.adb b/Ada95/samples/sample-curses_demo.adb index 81ac9a5a..4dd96a72 100644 --- a/Ada95/samples/sample-curses_demo.adb +++ b/Ada95/samples/sample-curses_demo.adb @@ -6,23 +6,38 @@ -- -- -- B O D Y -- -- -- --- Version 00.92 -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2004,2011 Free Software Foundation, Inc. -- +-- -- +-- Permission is hereby granted, free of charge, to any person obtaining a -- +-- copy of this software and associated documentation files (the -- +-- "Software"), to deal in the Software without restriction, including -- +-- without limitation the rights to use, copy, modify, merge, publish, -- +-- distribute, distribute with modifications, sublicense, and/or sell -- +-- copies of the Software, and to permit persons to whom the Software is -- +-- furnished to do so, subject to the following conditions: -- -- -- --- The ncurses Ada95 binding is copyrighted 1996 by -- --- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de -- +-- The above copyright notice and this permission notice shall be included -- +-- in all copies or substantial portions of the Software. -- -- -- --- 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. -- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- +-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- +-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- +-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- +-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- -- -- --- This binding comes AS IS with no warranty, implied or expressed. -- +-- Except as contained in this notice, the name(s) of the above copyright -- +-- holders shall not be used in advertising or otherwise to promote the -- +-- sale, use or other dealings in this Software without prior written -- +-- authorization. -- ------------------------------------------------------------------------------ +-- Author: Juergen Pfeifer, 1996 -- Version Control --- $Revision: 1.2 $ +-- $Revision: 1.17 $ +-- $Date: 2011/03/23 00:29:04 $ +-- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses; use Terminal_Interface.Curses; with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus; @@ -33,8 +48,7 @@ with Terminal_Interface.Curses.Panels.User_Data; with Sample.Manifest; use Sample.Manifest; with Sample.Helpers; use Sample.Helpers; with Sample.Function_Key_Setting; use Sample.Function_Key_Setting; -with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; -with Sample.Header_Handler; use Sample.Header_Handler; + with Sample.Explanation; use Sample.Explanation; with Sample.Menu_Demo.Handler; @@ -43,6 +57,12 @@ with Sample.Curses_Demo.Attributes; package body Sample.Curses_Demo is + type User_Data is new Integer; + type User_Data_Access is access all User_Data; + package PUD is new Panels.User_Data (User_Data, User_Data_Access); + -- We use above instantiation of the generic User_Data package to + -- demonstrate and test the use of the user data mechanism. + procedure Demo is function My_Driver (M : Menu; @@ -50,20 +70,25 @@ package body Sample.Curses_Demo is Pan : Panel) return Boolean; package Mh is new Sample.Menu_Demo.Handler (My_Driver); - Itm : constant Item_Array (1 .. 2) := + Itm : Item_Array_Access := new Item_Array' (New_Item ("Attributes Demo"), - New_Item ("Mouse Demo")); - M : Menu := New_Menu (Itm); + New_Item ("Mouse Demo"), + Null_Item); + M : Menu := New_Menu (Itm); + U1 : constant User_Data_Access := new User_Data'(4711); + U2 : User_Data_Access; function My_Driver (M : Menu; K : Key_Code; Pan : Panel) return Boolean is Idx : constant Positive := Get_Index (Current (M)); + Result : Boolean := False; begin + PUD.Set_User_Data (Pan, U1); -- set some user data, just for fun if K in User_Key_Code'Range then if K = QUIT then - return True; + Result := True; elsif K = SELECT_ITEM then if Idx in Itm'Range then Hide (Pan); @@ -82,22 +107,24 @@ package body Sample.Curses_Demo is end if; end if; end if; - return False; + PUD.Get_User_Data (Pan, U2); -- get the user data + pragma Assert (U1.all = U2.all and then U1 = U2); + return Result; end My_Driver; begin - if Item_Count (M) /= Itm'Length then + if (1 + Item_Count (M)) /= Itm'Length then raise Constraint_Error; end if; - if not Has_Key (Key_Mouse) then + if not Has_Mouse then declare O : Item_Option_Set; begin - Get_Options (Itm (2), O); + Get_Options (Itm.all (2), O); O.Selectable := False; - Set_Options (Itm (2), O); + Set_Options (Itm.all (2), O); end; end if; @@ -110,7 +137,7 @@ package body Sample.Curses_Demo is Pop_Environment; Delete (M); - + Free (Itm, True); end Demo; end Sample.Curses_Demo;