mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-05 22:32:30 +02:00
371 lines
7.3 KiB
ObjectPascal
371 lines
7.3 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Florian Klaempfl
|
|
member of the Free Pascal development team
|
|
|
|
Mouse unit for linux
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
unit Mouse;
|
|
interface
|
|
|
|
{$ifdef NOMOUSE}
|
|
{$DEFINE NOGPM}
|
|
{$ENDIF}
|
|
|
|
{$i mouseh.inc}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Unix,Video
|
|
{$ifndef NOGPM}
|
|
,gpm
|
|
{$endif ndef NOGPM}
|
|
;
|
|
|
|
{$i mouse.inc}
|
|
|
|
{$ifndef NOMOUSE}
|
|
|
|
const
|
|
mousecur : boolean = false;
|
|
mousecurofs : longint = -1;
|
|
|
|
var
|
|
mousecurcell : TVideoCell;
|
|
|
|
const
|
|
gpm_fs : longint = -1;
|
|
|
|
procedure PlaceMouseCur(ofs:longint);
|
|
|
|
var
|
|
upd : boolean;
|
|
|
|
begin
|
|
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);
|
|
end;
|
|
|
|
procedure SysInitMouse;
|
|
{$ifndef NOGPM}
|
|
var
|
|
connect : TGPMConnect;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
{$ifndef NOGPM}
|
|
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;
|
|
{$else ifdef NOGPM}
|
|
if (getenv('TERM')='xterm') then
|
|
begin
|
|
gpm_fs:=-2;
|
|
Write(#27'[?1001s'); { save old hilit tracking }
|
|
Write(#27'[?1000h'); { enable mouse tracking }
|
|
end;
|
|
{$endif NOGPM}
|
|
end;
|
|
|
|
|
|
procedure SysDoneMouse;
|
|
begin
|
|
If gpm_fs<>-1 then
|
|
begin
|
|
HideMouse;
|
|
{$ifndef NOGPM}
|
|
Gpm_Close;
|
|
{$else ifdef NOGPM}
|
|
Write(#27'[?1000l'); { disable mouse tracking }
|
|
Write(#27'[?1001r'); { Restore old hilit tracking }
|
|
{$endif ifdef NOGPM}
|
|
gpm_fs:=-1;
|
|
end;
|
|
end;
|
|
|
|
|
|
function SysDetectMouse:byte;
|
|
{$ifndef NOGPM}
|
|
var
|
|
x : longint;
|
|
e : TGPMEvent;
|
|
connect : TGPMConnect;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
{$ifndef NOGPM}
|
|
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
|
|
SysDetectMouse:=x
|
|
else
|
|
SysDetectMouse:=2;
|
|
end
|
|
else
|
|
SysDetectMouse:=0;
|
|
{$else ifdef NOGPM}
|
|
if (getenv('TERM')='xterm') then
|
|
SysDetectMouse:=2;
|
|
{$endif NOGPM}
|
|
end;
|
|
|
|
|
|
procedure SysShowMouse;
|
|
begin
|
|
PlaceMouseCur(MouseCurOfs);
|
|
mousecur:=true;
|
|
end;
|
|
|
|
|
|
procedure SysHideMouse;
|
|
begin
|
|
PlaceMouseCur(-1);
|
|
mousecur:=false;
|
|
end;
|
|
|
|
|
|
function SysGetMouseX:word;
|
|
{$ifndef NOGPM}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
if gpm_fs<0 then
|
|
exit(0);
|
|
{$ifndef NOGPM}
|
|
Gpm_GetSnapshot(e);
|
|
SysGetMouseX:=e.x-1;
|
|
{$endif ndef NOGPM}
|
|
end;
|
|
|
|
|
|
function SysGetMouseY:word;
|
|
{$ifndef NOGPM}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
if gpm_fs<0 then
|
|
exit(0);
|
|
{$ifndef NOGPM}
|
|
Gpm_GetSnapshot(e);
|
|
if e.y>0 then
|
|
SysGetMouseY:=e.y-1
|
|
else
|
|
SysGetMouseY:=0;
|
|
{$endif ndef NOGPM}
|
|
end;
|
|
|
|
|
|
function SysGetMouseButtons:word;
|
|
{$ifndef NOGPM}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
if gpm_fs<0 then
|
|
exit(0);
|
|
{$ifndef NOGPM}
|
|
Gpm_GetSnapshot(e);
|
|
SysGetMouseButtons:=e.buttons;
|
|
{$endif ndef NOGPM}
|
|
end;
|
|
|
|
|
|
procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
|
|
{$ifndef NOGPM}
|
|
var
|
|
e : TGPMEvent;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
|
if gpm_fs<0 then
|
|
exit;
|
|
{$ifndef NOGPM}
|
|
Gpm_GetEvent(e);
|
|
if e.x>0 then
|
|
MouseEvent.x:=e.x-1
|
|
else
|
|
MouseEvent.x:=0;
|
|
if e.y>0 then
|
|
MouseEvent.y:=e.y-1
|
|
else
|
|
MouseEvent.y:=0;
|
|
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;
|
|
{ update mouse cursor }
|
|
if mousecur then
|
|
PlaceMouseCur(MouseEvent.y*ScreenWidth+MouseEvent.x);
|
|
{$endif ndef NOGPM}
|
|
end;
|
|
|
|
|
|
|
|
function SysPollMouseEvent(var MouseEvent: TMouseEvent):boolean;
|
|
|
|
{$ifndef NOGPM}
|
|
var
|
|
e : TGPMEvent;
|
|
fds : FDSet;
|
|
{$endif ndef NOGPM}
|
|
begin
|
|
fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
|
|
{$ifndef NOGPM}
|
|
if gpm_fs<0 then
|
|
exit(false);
|
|
if gpm_fs>0 then
|
|
begin
|
|
FD_Zero(fds);
|
|
FD_Set(gpm_fd,fds);
|
|
end;
|
|
if (gpm_fs=-2) or (Select(gpm_fs+1,@fds,nil,nil,1)>0) then
|
|
begin
|
|
FillChar(e,SizeOf(e),#0);
|
|
Gpm_GetSnapshot(e);
|
|
if e.x>0 then
|
|
MouseEvent.x:=e.x-1
|
|
else
|
|
MouseEvent.x:=0;
|
|
if e.y>0 then
|
|
MouseEvent.y:=e.y-1
|
|
else
|
|
MouseEvent.y:=0;
|
|
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_fs<>-2) or} (MouseEvent.Action<>0) then
|
|
SysPollMouseEvent:=true
|
|
else
|
|
SysPollMouseEvent:=false;
|
|
end
|
|
else
|
|
SysPollMouseEvent:=false;
|
|
{$endif ndef NOGPM}
|
|
end;
|
|
|
|
Const
|
|
SysMouseDriver : TMouseDriver = (
|
|
UseDefaultQueue : true;
|
|
InitDriver : @SysInitMouse;
|
|
DoneDriver : @SysDoneMouse;
|
|
DetectMouse : @SysDetectMouse;
|
|
ShowMouse : @SysShowMouse;
|
|
HideMouse : @SysHideMouse;
|
|
GetMouseX : @SysGetMouseX;
|
|
GetMouseY : @SysGetMouseY;
|
|
GetMouseButtons : @SysGetMouseButtons;
|
|
SetMouseXY : Nil;
|
|
GetMouseEvent : @SysGetMouseEvent;
|
|
PollMouseEvent : @SysPollMouseEvent;
|
|
PutMouseEvent : Nil;
|
|
);
|
|
|
|
{$else ifndef NOMOUSE}
|
|
|
|
Const
|
|
SysMouseDriver : TMouseDriver = (
|
|
UseDefaultQueue : true;
|
|
InitDriver : Nil;
|
|
DoneDriver : Nil;
|
|
DetectMouse : Nil;
|
|
ShowMouse : Nil;
|
|
HideMouse : Nil;
|
|
GetMouseX : Nil;
|
|
GetMouseY : Nil;
|
|
GetMouseButtons : Nil;
|
|
SetMouseXY : Nil;
|
|
GetMouseEvent : Nil;
|
|
PollMouseEvent : Nil;
|
|
PutMouseEvent : Nil;
|
|
);
|
|
|
|
{$endif}
|
|
|
|
Begin
|
|
SetMouseDriver(SysMouseDriver);
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.7 2002-09-07 16:01:27 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
}
|