freepascal.compiler/api/unix/mouse.inc

{
  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

}