1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Curses_Demo.Mouse --
9 ------------------------------------------------------------------------------
10 -- Copyright 2020 Thomas E. Dickey --
11 -- Copyright 1998-2006,2008 Free Software Foundation, Inc. --
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: --
21 -- The above copyright notice and this permission notice shall be included --
22 -- in all copies or substantial portions of the Software. --
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. --
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 --
36 ------------------------------------------------------------------------------
37 -- Author: Juergen Pfeifer, 1996
40 -- $Date: 2020/02/02 23:34:34 $
41 -- Binding Version 01.00
42 ------------------------------------------------------------------------------
43 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
44 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
45 with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
46 with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO;
47 with Terminal_Interface.Curses.Text_IO.Integer_IO;
48 with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
50 with Sample.Helpers; use Sample.Helpers;
51 with Sample.Manifest; use Sample.Manifest;
52 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
53 with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
54 with Sample.Explanation; use Sample.Explanation;
56 package body Sample.Curses_Demo.Mouse is
59 Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
62 package Button_IO is new
63 Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button);
66 package State_IO is new
67 Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State);
72 type Controls is array (1 .. 3) of Panel;
79 V : Cursor_Visibility := Invisible;
82 Msg_L : constant Line_Count := 8;
83 Lins : Line_Position := Lines;
84 Cols : Column_Position;
86 procedure Show_Mouse_Event;
88 procedure Show_Mouse_Event
90 Evt : constant Mouse_Event := Get_Mouse;
93 Button : Mouse_Button;
97 Get_Event (Evt, Y, X, Button, State);
98 Put (Msg, "Event at");
99 Put (Msg, " X="); Put (Msg, Integer (X), 3);
100 Put (Msg, ", Y="); Put (Msg, Integer (Y), 3);
101 Put (Msg, ", Btn="); Put (Msg, Button, 10);
102 Put (Msg, ", Stat="); Put (Msg, State, 15);
103 for I in Ctl'Range loop
104 W := Get_Window (Ctl (I));
105 if Enclosed_In_Window (W, Evt) then
106 Transform_Coordinates (W, Y, X, From_Screen);
108 Put (Msg, (I), 1); Put (Msg, ",");
109 Put (Msg, Integer (Y), 1); Put (Msg, ",");
110 Put (Msg, Integer (X), 1); Put (Msg, ")");
115 Update_Panels; Update_Screen;
116 end Show_Mouse_Event;
119 Push_Environment ("MOUSE00");
120 Notepad ("MOUSE-PAD00");
122 Set_Cursor_Visibility (V);
124 Note := Notepad_Window;
125 if Note /= Null_Window then
126 Get_Window_Position (Note, Lins, Cols);
128 Frame := Create (Msg_L, Columns, Lins - Msg_L, 0);
130 Set_Background (Win => Frame,
131 Ch => (Color => Default_Colors,
132 Attr => Normal_Video,
134 Set_Character_Attributes (Win => Frame,
135 Attr => Normal_Video,
136 Color => Default_Colors);
139 Msg := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1);
140 Pan := Create (Frame);
147 Window_Title (Frame, "Mouse Protocol");
148 Refresh_Without_Update (Frame);
149 Allow_Scrolling (Msg, True);
152 Middle_Column : constant Integer := Integer (Columns) / 2;
153 Middle_Index : constant Natural := Ctl'First + (Ctl'Length / 2);
154 Width : constant Column_Count := 5;
155 Height : constant Line_Count := 3;
156 Half : constant Column_Count := Width / 2;
157 Space : constant Column_Count := 3;
161 for I in Ctl'Range loop
162 Position := ((I) - Integer (Middle_Index)) *
163 Integer (Half + Space + Width) + Middle_Column;
167 Column_Position (Position));
169 Set_Background (Win => W,
170 Ch => (Color => Menu_Back_Color,
171 Attr => Normal_Video,
173 Set_Character_Attributes (Win => W,
174 Attr => Normal_Video,
175 Color => Menu_Fore_Color);
178 Ctl (I) := Create (W);
180 Move_Cursor (W, 1, Half);
182 Refresh_Without_Update (W);
186 Update_Panels; Update_Screen;
190 if K in Special_Key_Code'Range then
192 when QUIT_CODE => exit;
193 when HELP_CODE => Explain_Context;
194 when EXPLAIN_CODE => Explain ("MOUSEKEYS");
195 when Key_Mouse => Show_Mouse_Event;
201 for I in Ctl'Range loop
202 W := Get_Window (Ctl (I));
213 Set_Cursor_Visibility (V);
217 Update_Panels; Update_Screen;
221 end Sample.Curses_Demo.Mouse;