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