1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Curses_Demo.Mouse --
11 -- The ncurses Ada95 binding is copyrighted 1996 by --
12 -- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de --
14 -- Permission is hereby granted to reproduce and distribute this --
15 -- binding by any means and for any fee, whether alone or as part --
16 -- of a larger distribution, in source or in binary form, PROVIDED --
17 -- this notice is included with any such distribution, and is not --
18 -- removed from any of its header files. Mention of ncurses and the --
19 -- author of this binding in any applications linked with it is --
20 -- highly appreciated. --
22 -- This binding comes AS IS with no warranty, implied or expressed. --
23 ------------------------------------------------------------------------------
26 ------------------------------------------------------------------------------
27 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
28 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
29 with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
30 with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO;
31 with Terminal_Interface.Curses.Text_IO.Integer_IO;
32 with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
34 with Sample.Helpers; use Sample.Helpers;
35 with Sample.Manifest; use Sample.Manifest;
36 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
37 with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
38 with Sample.Explanation; use Sample.Explanation;
40 package body Sample.Curses_Demo.Mouse is
43 Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
46 package Button_IO is new
47 Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button);
50 package State_IO is new
51 Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State);
56 type Controls is array (1 .. 3) of Panel;
62 N : constant Natural := Ctl'Length;
64 V : Cursor_Visibility := Invisible;
67 Msg_L : constant Line_Count := 8;
68 Lins : Line_Position := Lines;
69 Cols : Column_Position;
71 procedure Show_Mouse_Event;
73 procedure Show_Mouse_Event
75 Evt : constant Mouse_Event := Get_Mouse;
78 Button : Mouse_Button;
82 Get_Event (Evt, Y, X, Button, State);
83 Put (Msg, "Event at");
84 Put (Msg, " X="); Put (Msg, Integer (X), 3);
85 Put (Msg, ", Y="); Put (Msg, Integer (Y), 3);
86 Put (Msg, ", Btn="); Put (Msg, Button, 10);
87 Put (Msg, ", Stat="); Put (Msg, State, 15);
88 for I in Ctl'Range loop
89 W := Get_Window (Ctl (I));
90 if Enclosed_In_Window (W, Evt) then
91 Transform_Coordinates (W, Y, X, From_Screen);
93 Put (Msg, Integer (I), 1); Put (Msg, ",");
94 Put (Msg, Integer (Y), 1); Put (Msg, ",");
95 Put (Msg, Integer (X), 1); Put (Msg, ")");
100 Update_Panels; Update_Screen;
101 end Show_Mouse_Event;
104 Push_Environment ("MOUSE00");
105 Notepad ("MOUSE-PAD00");
107 Set_Cursor_Visibility (V);
109 Note := Notepad_Window;
110 if Note /= Null_Window then
111 Get_Window_Position (Note, Lins, Cols);
113 Frame := Create (Msg_L, Columns, Lins - Msg_L, 0);
115 Set_Background (Win => Frame,
116 Ch => (Color => Default_Colors,
117 Attr => Normal_Video,
119 Set_Character_Attributes (Win => Frame,
120 Attr => Normal_Video,
121 Color => Default_Colors);
124 Msg := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1);
125 Pan := Create (Frame);
132 Window_Title (Frame, "Mouse Protocol");
133 Refresh_Without_Update (Frame);
134 Allow_Scrolling (Msg, True);
137 Middle_Column : constant Integer := Integer (Columns) / 2;
138 Middle_Index : constant Natural := Ctl'First + (Ctl'Length / 2);
139 Width : constant Column_Count := 5;
140 Height : constant Line_Count := 3;
141 Half : constant Column_Count := Width / 2;
142 Space : constant Column_Count := 3;
146 for I in Ctl'Range loop
147 Position := (Integer (I) - Integer (Middle_Index)) *
148 Integer (Half + Space + Width) + Middle_Column;
152 Column_Position (Position));
154 Set_Background (Win => W,
155 Ch => (Color => Menu_Back_Color,
156 Attr => Normal_Video,
158 Set_Character_Attributes (Win => W,
159 Attr => Normal_Video,
160 Color => Menu_Fore_Color);
163 Ctl (I) := Create (W);
165 Move_Cursor (W, 1, Half);
166 Put (W, Integer (I), 1);
167 Refresh_Without_Update (W);
171 Update_Panels; Update_Screen;
175 if K in Special_Key_Code'Range then
177 when QUIT_CODE => exit;
178 when HELP_CODE => Explain_Context;
179 when EXPLAIN_CODE => Explain ("MOUSEKEYS");
180 when Key_Mouse => Show_Mouse_Event;
186 for I in Ctl'Range loop
187 W := Get_Window (Ctl (I));
198 Set_Cursor_Visibility (V);
202 Update_Panels; Update_Screen;
206 end Sample.Curses_Demo.Mouse;