mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-26 14:53:42 +02:00
348 lines
6.9 KiB
PHP
348 lines
6.9 KiB
PHP
{
|
|
System independent mouse interface for linux
|
|
|
|
$Id$
|
|
}
|
|
|
|
uses
|
|
Linux,Video
|
|
{$ifndef NOMOUSE}
|
|
{$ifdef OLDGPM}
|
|
,gpm114
|
|
{$else}
|
|
,gpm
|
|
{$endif}
|
|
{$endif ndef NOMOUSE}
|
|
;
|
|
|
|
const
|
|
mousecur : boolean = false;
|
|
mousecurofs : longint = -1;
|
|
|
|
var
|
|
mousecurcell : TVideoCell;
|
|
|
|
|
|
const
|
|
gpm_fs : longint = -1;
|
|
|
|
procedure PlaceMouseCur(ofs:longint);
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
upd : boolean;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifndef NOMOUSE}
|
|
if VideoBuf=nil then
|
|
exit;
|
|
upd:=false;
|
|
if (MouseCurOfs<>-1) and (VideoBuf^[MouseCurOfs]=MouseCurCell) then
|
|
begin
|
|
VideoBuf^[MouseCurOfs]:=MouseCurCell xor $7f00;
|
|
upd:=true;
|
|
end;
|
|
MouseCurOfs:=ofs;
|
|
if (MouseCurOfs<>-1) then
|
|
begin
|
|
MouseCurCell:=VideoBuf^[MouseCurOfs] xor $7f00;
|
|
VideoBuf^[MouseCurOfs]:=MouseCurCell;
|
|
upd:=true;
|
|
end;
|
|
if upd then
|
|
Updatescreen(false);
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
procedure InitMouse;
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
connect : TGPMConnect;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifndef NOMOUSE}
|
|
PendingMouseHead:=@PendingMouseEvent;
|
|
PendingMouseTail:=@PendingMouseEvent;
|
|
PendingMouseEvents:=0;
|
|
FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
|
|
if gpm_fs=-1 then
|
|
begin
|
|
{ open gpm }
|
|
connect.EventMask:=GPM_MOVE or GPM_DRAG or GPM_DOWN or GPM_UP;
|
|
connect.DefaultMask:=0;
|
|
connect.MinMod:=0;
|
|
connect.MaxMod:=0;
|
|
gpm_fs:=Gpm_Open(connect,0);
|
|
if (gpm_fs=-2) and (getenv('TERM')<>'xterm') then
|
|
begin
|
|
gpm_fs:=-1;
|
|
Gpm_Close;
|
|
end;
|
|
end;
|
|
{ show mousepointer }
|
|
if gpm_fs<>-1 then
|
|
ShowMouse;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
procedure DoneMouse;
|
|
begin
|
|
{$ifndef NOMOUSE}
|
|
If gpm_fs<>-1 then
|
|
begin
|
|
HideMouse;
|
|
Gpm_Close;
|
|
gpm_fs:=-1;
|
|
end;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
function DetectMouse:byte;
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
x : longint;
|
|
e : TGPMEvent;
|
|
connect : TGPMConnect;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifdef NOMOUSE}
|
|
DetectMouse:=0;
|
|
{$else ndef NOMOUSE}
|
|
if gpm_fs=-1 then
|
|
begin
|
|
connect.EventMask:=GPM_MOVE or GPM_DRAG or GPM_DOWN or GPM_UP;
|
|
connect.DefaultMask:=0;
|
|
connect.MinMod:=0;
|
|
connect.MaxMod:=0;
|
|
gpm_fs:=Gpm_Open(connect,0);
|
|
if (gpm_fs=-2) and (getenv('TERM')<>'xterm') then
|
|
begin
|
|
Gpm_Close;
|
|
gpm_fs:=-1;
|
|
end;
|
|
end;
|
|
{ always a mouse deamon present }
|
|
if gpm_fs<>-1 then
|
|
begin
|
|
x:=Gpm_GetSnapshot(e);
|
|
if x<>-1 then
|
|
DetectMouse:=x
|
|
else
|
|
DetectMouse:=2;
|
|
end
|
|
else
|
|
DetectMouse:=0;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
procedure ShowMouse;
|
|
begin
|
|
PlaceMouseCur(MouseCurOfs);
|
|
mousecur:=true;
|
|
end;
|
|
|
|
|
|
procedure HideMouse;
|
|
begin
|
|
PlaceMouseCur(-1);
|
|
mousecur:=false;
|
|
end;
|
|
|
|
|
|
function GetMouseX:word;
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifdef NOMOUSE}
|
|
GetMouseX:=0;
|
|
{$else ndef NOMOUSE}
|
|
if gpm_fd<0 then
|
|
exit(0);
|
|
Gpm_GetSnapshot(e);
|
|
GetMouseX:=e.x-1;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
function GetMouseY:word;
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifdef NOMOUSE}
|
|
GetMouseY:=0;
|
|
{$else ndef NOMOUSE}
|
|
if gpm_fd<0 then
|
|
exit(0);
|
|
Gpm_GetSnapshot(e);
|
|
GetMouseY:=e.y-1;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
function GetMouseButtons:word;
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifdef NOMOUSE}
|
|
GetMouseButtons:=0;
|
|
{$else ndef NOMOUSE}
|
|
if gpm_fd<0 then
|
|
exit(0);
|
|
Gpm_GetSnapshot(e);
|
|
GetMouseButtons:=e.buttons;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
procedure SetMouseXY(x,y:word);
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure GetMouseEvent(var MouseEvent: TMouseEvent);
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifdef NOMOUSE}
|
|
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
|
{$else ndef NOMOUSE}
|
|
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
|
if gpm_fd<0 then
|
|
exit;
|
|
Gpm_GetEvent(e);
|
|
MouseEvent.x:=e.x-1;
|
|
MouseEvent.y:=e.y-1;
|
|
MouseEvent.buttons:=0;
|
|
if e.buttons and Gpm_b_left<>0 then
|
|
inc(MouseEvent.buttons,1);
|
|
if e.buttons and Gpm_b_right<>0 then
|
|
inc(MouseEvent.buttons,2);
|
|
if e.buttons and Gpm_b_middle<>0 then
|
|
inc(MouseEvent.buttons,4);
|
|
case (e.EventType and $f) of
|
|
GPM_MOVE,
|
|
GPM_DRAG : MouseEvent.Action:=MouseActionMove;
|
|
GPM_DOWN : MouseEvent.Action:=MouseActionDown;
|
|
GPM_UP : MouseEvent.Action:=MouseActionUp;
|
|
else
|
|
MouseEvent.Action:=0;
|
|
end;
|
|
LastMouseEvent:=MouseEvent;
|
|
{ update mouse cursor }
|
|
if mousecur then
|
|
PlaceMouseCur(MouseEvent.y*ScreenWidth+MouseEvent.x);
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
|
|
function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
|
|
|
|
{$ifndef NOMOUSE}
|
|
var
|
|
e : TGPMEvent;
|
|
fds : FDSet;
|
|
{$endif ndef NOMOUSE}
|
|
begin
|
|
{$ifdef NOMOUSE}
|
|
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
|
exit(false);
|
|
{$else ndef NOMOUSE}
|
|
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
|
if gpm_fd<0 then
|
|
exit(false);
|
|
if gpm_fd>0 then
|
|
begin
|
|
FD_Zero(fds);
|
|
FD_Set(gpm_fd,fds);
|
|
end;
|
|
if (gpm_fd=-2) or (Select(gpm_fd+1,@fds,nil,nil,1)>0) then
|
|
begin
|
|
Gpm_GetSnapshot(e);
|
|
MouseEvent.x:=e.x-1;
|
|
MouseEvent.y:=e.y-1;
|
|
MouseEvent.buttons:=0;
|
|
if e.buttons and Gpm_b_left<>0 then
|
|
inc(MouseEvent.buttons,1);
|
|
if e.buttons and Gpm_b_right<>0 then
|
|
inc(MouseEvent.buttons,2);
|
|
if e.buttons and Gpm_b_middle<>0 then
|
|
inc(MouseEvent.buttons,4);
|
|
case (e.EventType and $f) of
|
|
GPM_MOVE,
|
|
GPM_DRAG : MouseEvent.Action:=MouseActionMove;
|
|
GPM_DOWN : MouseEvent.Action:=MouseActionDown;
|
|
GPM_UP : MouseEvent.Action:=MouseActionUp;
|
|
else
|
|
MouseEvent.Action:=0;
|
|
end;
|
|
if (gpm_fd<>-2) or (MouseEvent.Action<>0) then
|
|
PollMouseEvent:=true
|
|
else
|
|
PollMouseEvent:=false;
|
|
end
|
|
else
|
|
PollMouseEvent:=false;
|
|
{$endif ndef NOMOUSE}
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.2 2000-10-26 23:08:48 peter
|
|
* merged freebsd from fixes
|
|
|
|
Revision 1.1.2.1 2000/10/25 12:23:20 marco
|
|
* Linux dir split up
|
|
|
|
Revision 1.1.2.1 2000/10/24 07:58:49 pierre
|
|
* get mouse to not crash on xterm, its now completely disabled
|
|
|
|
Revision 1.1 2000/07/13 06:29:39 michael
|
|
+ Initial import
|
|
|
|
Revision 1.3 2000/06/30 09:00:33 jonas
|
|
* compiles again with -dnomouse
|
|
|
|
Revision 1.2 2000/04/17 08:51:38 pierre
|
|
+ set conditional NOMOUSE to get dummy mouse unit
|
|
|
|
Revision 1.1 2000/01/06 01:20:31 peter
|
|
* moved out of packages/ back to topdir
|
|
|
|
Revision 1.1 1999/11/24 23:36:38 peter
|
|
* moved to packages dir
|
|
|
|
Revision 1.5 1999/07/01 19:41:26 peter
|
|
* define OLDGPM to compile with old gpm (for v1.14) else the new
|
|
gpm unit from rtl will be used (v1.17)
|
|
|
|
Revision 1.4 1999/06/23 00:01:30 peter
|
|
* check for videobuf=nil
|
|
|
|
Revision 1.3 1999/03/31 20:20:18 michael
|
|
+ Fixed probmem preventing IDE to run in x-term.
|
|
|
|
Revision 1.2 1998/12/11 00:13:20 peter
|
|
+ SetMouseXY
|
|
* use far for exitproc procedure
|
|
|
|
Revision 1.1 1998/12/04 12:48:30 peter
|
|
* moved some dirs
|
|
|
|
Revision 1.3 1998/12/01 15:08:16 peter
|
|
* fixes for linux
|
|
|
|
Revision 1.2 1998/10/29 12:49:49 peter
|
|
* more fixes
|
|
|
|
} |