-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
--- Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1996
+-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
-- Version Control:
--- $Revision: 1.9 $
--- Binding Version 00.93
+-- $Revision: 1.16 $
+-- Binding Version 01.00
------------------------------------------------------------------------------
with System;
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
-with Interfaces;
-with Interfaces.C;
-with Unchecked_Conversion;
+with Interfaces.C; use Interfaces.C;
+use Interfaces;
package body Terminal_Interface.Curses.Mouse is
use type System.Bit_Order;
use type Interfaces.C.int;
- function CInt_To_Mask is new
- Unchecked_Conversion (Source => C_Int,
- Target => Event_Mask);
-
- function Mask_To_CInt is new
- Unchecked_Conversion (Source => Event_Mask,
- Target => C_Int);
-
function Has_Mouse return Boolean
is
function Mouse_Avail return C_Int;
return Event;
end Get_Mouse;
- procedure Register_Reportable_Event (B : in Mouse_Button;
- S : in Button_State;
- Mask : in out Event_Mask)
+ procedure Register_Reportable_Event (Button : in Mouse_Button;
+ State : in Button_State;
+ Mask : in out Event_Mask)
is
- type Evt_Access is access all Event_Mask;
- function Register (B : C_Int;
- S : C_Int;
- M : Evt_Access) return C_Int;
- pragma Import (C, Register, "_nc_ada_mouse_mask");
-
- T : aliased Event_Mask := Mask;
- M : Evt_Access := T'Access;
- R : constant C_Int := Register (C_Int (Mouse_Button'Pos (B)),
- C_Int (Button_State'Pos (S)),
- M);
+ Button_Nr : constant Natural := Mouse_Button'Pos (Button);
+ State_Nr : constant Natural := Button_State'Pos (State);
begin
- if R = Curses_Err then
+ if Button in Modifier_Keys and then State /= Pressed then
raise Curses_Exception;
+ else
+ if Button in Real_Buttons then
+ Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr);
+ else
+ Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4));
+ end if;
end if;
- Mask := T;
end Register_Reportable_Event;
+ procedure Register_Reportable_Events (Button : in Mouse_Button;
+ State : in Button_States;
+ Mask : in out Event_Mask)
+ is
+ begin
+ for S in Button_States'Range loop
+ if State (S) then
+ Register_Reportable_Event (Button, S, Mask);
+ end if;
+ end loop;
+ end Register_Reportable_Events;
+
function Start_Mouse (Mask : Event_Mask := All_Events)
return Event_Mask
is
- type Int_Access is access all C_Int;
- function MMask (M : C_Int; O : Int_Access := null) return C_Int;
+ function MMask (M : Event_Mask;
+ O : access Event_Mask) return Event_Mask;
pragma Import (C, MMask, "mousemask");
- R : C_Int;
+ R : Event_Mask;
+ Old : aliased Event_Mask;
begin
- R := MMask (Mask_To_CInt (Mask));
- return CInt_To_Mask (R);
+ R := MMask (Mask, Old'Access);
+ return Old;
end Start_Mouse;
- procedure End_Mouse
+ procedure End_Mouse (Mask : in Event_Mask := No_Events)
is
- Old : constant Event_Mask := Start_Mouse (No_Events);
begin
null;
end End_Mouse;
+ procedure Dispatch_Event (Mask : in Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State);
+
+ procedure Dispatch_Event (Mask : in Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State) is
+ L : Event_Mask;
+ begin
+ Button := Alt; -- preset to non real button;
+ if (Mask and BUTTON1_EVENTS) /= 0 then
+ Button := Left;
+ elsif (Mask and BUTTON2_EVENTS) /= 0 then
+ Button := Middle;
+ elsif (Mask and BUTTON3_EVENTS) /= 0 then
+ Button := Right;
+ elsif (Mask and BUTTON4_EVENTS) /= 0 then
+ Button := Button4;
+ end if;
+ if Button in Real_Buttons then
+ L := 2 ** (6 * Mouse_Button'Pos (Button));
+ for I in Button_State'Range loop
+ if (Mask and L) /= 0 then
+ State := I;
+ exit;
+ end if;
+ L := 2 * L;
+ end loop;
+ else
+ State := Pressed;
+ if (Mask and BUTTON_CTRL) /= 0 then
+ Button := Control;
+ elsif (Mask and BUTTON_SHIFT) /= 0 then
+ Button := Shift;
+ elsif (Mask and BUTTON_ALT) /= 0 then
+ Button := Alt;
+ end if;
+ end if;
+ end Dispatch_Event;
+
procedure Get_Event (Event : in Mouse_Event;
Y : out Line_Position;
X : out Column_Position;
Button : out Mouse_Button;
State : out Button_State)
is
- procedure Dispatch_Event (M : in C_Int;
- B : out C_Int;
- S : out C_Int);
- pragma Import (C, Dispatch_Event, "_nc_ada_mouse_event");
-
- Mask : constant Interfaces.C.int := Mask_To_CInt (Event.Bstate);
- B, S : C_Int;
+ Mask : constant Event_Mask := Event.Bstate;
begin
X := Column_Position (Event.X);
Y := Line_Position (Event.Y);
- Dispatch_Event (Mask, B, S);
- Button := Mouse_Button'Val (B);
- State := Button_State'Val (S);
+ Dispatch_Event (Mask, Button, State);
end Get_Event;
procedure Unget_Mouse (Event : in Mouse_Event)
function Enclosed_In_Window (Win : Window := Standard_Window;
Event : Mouse_Event) return Boolean
is
- function Wenclose (Win : Window; Y : C_Int; X : C_Int) return C_Int;
+ function Wenclose (Win : Window; Y : C_Int; X : C_Int)
+ return Curses_Bool;
pragma Import (C, Wenclose, "wenclose");
begin
- if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) = Curses_False then
+ if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X))
+ = Curses_Bool_False then
return False;
else
return True;
projects / ncurses.git / blobdiff