mouse.pas

{   $Id$

    Copyright (C) 1991-2001 Peter Mandrella
    Copyright (C) 2000-2002 OpenXP team (www.openxp.de)

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    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.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}

unit mouse;

{$I xpdefine.inc }

interface

uses
  {$IFDEF Win32} windows, {$ENDIF}
  xpglobal,
  keys, //taste, IFDEF NCRT in interface!
  typeform;

const  mausLinks  = 0;     { linke Taste    }
       mausRechts = 1;     { rechte Taste   }
       mausMitte  = 2;     { mittlere Taste }

       mmLinks    = 1;     { Maske f. linke Taste  }
       mmRechts   = 2;     { Maske f. rechte Taste }
       mmMitte    = 4;     { Maske f. mittl. Taste }

       intMove    = 1;     { Interrupt bei 'Maus bewegt' }
       intLeft1   = 2;     { .. links gedrueckt           }
       intLeft0   = 4;     { .. links losgelassen        }
       intRight1  = 8;     { .. rechts gedrueckt          }
       intRight0  = 16;    { .. rechts losgelassen       }
       intMid1    = 32;    { .. Mitte gedrueckt           }
       intMid0    = 64;    { .. Mitte losgelassen        }

type   mausstat   = record
                      tasten : integer;
                      x,y    : integer;
                    end;
       mausintp   = procedure(intsource,tasten,x,y,mx,my:xpWord);


var    maus,mausda : boolean;
       mausswapped : boolean;            { Tasten vertauscht }

procedure mausinit;                      { Maustreiber zuruecksetzen }
procedure mausan;                        { Mauscursor einschalten   }
procedure mausaus;                       { Mauscursor ausschalten   }
procedure getmaus(var stat:mausstat);    { Mauszustand ermitteln    }
procedure setmaus(x,y: integer);         { neue Mausposition setzen }

function mausx:xpWord;      { Maus-X-Koordinate holen }
function mausy:xpWord;      { Maus-Y-Koordinate holen }
function maust:xpWord;      { Maustastenzustand holen }

{$IFDEF Win32}
function UpdateMouseStatus(const Event: MOUSE_EVENT_RECORD;var ScanCode:Char;var SpecialKey:boolean):boolean;
{$ELSE}
{$IFDEF NCRT}
function UpdateMouseStatus: Taste;
{$ENDIF}
{$ENDIF}

implementation

uses
  sysutils,
  {$IFDEF Win32} winxp,xpcrt, {$ENDIF}
  {$IFDEF NCRT}
    xpcurses,
    {$ifdef Kylix}ncursix,{$else}ncurses,{$endif}
  {$ENDIF}
  maus2,
  debug;

{$IFDEF Win32}
var LastEvent: MOUSE_EVENT_RECORD;
{$ELSE}
{$IFDEF NCRT}
{$IFDEF Kylix}
var MouseEvent: NCursix.MEVENT;
{$ELSE}
var MouseEvent: NCurses.MEVENT;
{$ENDIF}
    MouseButtons: Cardinal;
{$ENDIF}
{$ENDIF}

const
 intset  : boolean = false;

procedure mausinit;
begin
  mausda := false;
end;

procedure mausan;
begin
  // only neccessary under DOS
end;

procedure mausaus;
begin
  // only neccessary under DOS
end;

procedure getmaus(var stat:mausstat);
begin
{$IFDEF Debug}{$R-}{$ENDIF}
{$IFDEF Win32}
  if mausda then
  begin
    stat.x := LastEvent.dwMousePosition.X * 8;
    stat.Y := LastEvent.dwMousePosition.Y * 8;
    stat.tasten := LastEvent.dwButtonState;
  end else
{$ELSE}
{$IFDEF NCRT}
  if mausda then
  begin
    stat.x := MouseEvent.X * 8;
    stat.Y := MouseEvent.Y * 8;
    stat.tasten := MouseButtons;
  end else
{$ENDIF}
{$ENDIF}
{$IFDEF Debug}{$R+}{$ENDIF}
  begin
    stat.x := 0;
    stat.y := 0;
    stat.tasten := 0;
  end;
end;

function mausx:xpWord;
begin
{$IFDEF Debug}{$R-}{$ENDIF}
{$IFDEF Win32}
  if Mausda then
    Result := LastEvent.dwMousePosition.X * 8
  else
{$ELSE}
{$IFDEF NCRT}
  if mausda then
    Result := MouseEvent.X * 8
  else
{$ENDIF}
{$ENDIF}
{$IFDEF Debug}{$R+}{$ENDIF}
  Result := 0;
{$IFDEF Debug }
//  DebugLog('mouse',Format('MausX: %dpx',[Result]),dlTrace);
{$ENDIF }
end;

function mausy:xpWord;
begin
{$IFDEF Debug}{$R-}{$ENDIF}
{$IFDEF Win32}
  if Mausda then
    Result := LastEvent.dwMousePosition.Y * 8
  else
{$ELSE}
{$IFDEF NCRT}
  if mausda then
    Result := MouseEvent.Y * 8
  else
{$ENDIF}
{$ENDIF}
{$IFDEF Debug}{$R+}{$ENDIF}
    Result := 0;
{$IFDEF Debug }
//  DebugLog('mouse',Format('MausY: %dpx',[Result]),dlTrace);
{$ENDIF }
end;

function maust:xpWord;
begin
{$IFDEF Debug}{$R-}{$ENDIF}
{$IFDEF Win32}
  if Mausda then
    Result := LastEvent.dwButtonState
  else
{$IFDEF NCRT}
  if mausda then
    Result := MouseButtons
  else
{$ENDIF}
{$ENDIF}
{$IFDEF Debug}{$R+}{$ENDIF}
    Result := 0;
{$IFDEF Debug }
  DebugLog('mouse',Format('Maust: %s',[Hex(Result,2)]),dlTrace);
{$ENDIF }
end;

procedure setmaus(x,y: integer);
{$IFDEF Win32}
var c: TCoord;
{$ENDIF }
begin
{$IFDEF Win32}
  c.x:=x div 8;
  c.y:=y div 8;
  Windows.SetConsoleCursorPosition(OutHandle,c);
{$ENDIF }
end;

{$IFDEF Win32}
function UpdateMouseStatus(const Event: MOUSE_EVENT_RECORD;var ScanCode:Char;var SpecialKey:boolean):boolean;
begin
  Move(Event,LastEvent,Sizeof(LastEvent));
  MausDa:=True;

  if maus_tasten then
    Result := maus_set_keys(Event,Scancode,SpecialKey)
  else
    Result := false;
end;
{$ELSE}
{$IFDEF NCRT}
function UpdateMouseStatus: Taste;
begin
  mausda:=false;

{$IFDEF Kylix}
  if (ncursix.GetMouse(MouseEvent)<>0 {OK}) then
{$ELSE}
  if (NCurses.GetMouse(MouseEvent)<>0 {OK}) then
{$ENDIF}
  begin
    Debug.DebugLog('maus2', 'no valid mouse event', DLTrace);
    result:='';
    exit;
  end;

  Debug.DebugLog('maus2', Format('mouse event (id=%d,x=%d,y=%d,bstate=0x%s)',[MouseEvent.id,MouseEvent.x,MouseEvent.y,hex(MouseEvent.Bstate,8)]), DLTrace);

//  if NCurses.mouse_trafo(@(MouseEvent.X),@(MouseEvent.Y),0)=0 {FALSE} then
//  begin
//    DebugLog('maus2','could not convert coordinates',DLTrace);
//    result:='';
//    exit;
//  end;
//
//  Debug.DebugLog('maus2', Format('translated mouse event coordinates (x=%d,y=%d)',[MouseEvent.x,MouseEvent.y]), DLTrace);

  mausda:=true;

  Result := maus_set_keys(MouseEvent,MouseButtons);

  if not maus_tasten then
    Result := '';
end;
{$ENDIF}
{$ENDIF}

initialization
{$IFDEF Win32}
  // maus wird von xpcrt gesetzt
{$ELSE}
{$IFDEF NCRT}
  // maus wird von xpcurses gesetzt
{$ELSE}
  maus:=false;
{$ENDIF}
{$ENDIF}

  mausda:=false;
  mausswapped:=false;

{
  $Log: mouse.pas,v $
  Revision 1.40  2003/10/28 21:52:08  mk
  - disabled debug log for mausx and mausy because because of polling
    from the DOS32 version to this both functions; this caused heavy
    debug log activity in idle state

  Revision 1.39  2003/01/08 12:35:08  mk
  - call DebugLog in mausx, mausy, maust only if DEFINE DEBUG is on

  Revision 1.38  2002/12/21 05:37:51  dodi
  - removed questionable references to Word type

  Revision 1.37  2002/12/07 17:50:23  dodi
  updated uses for NCRT

  Revision 1.36  2002/12/04 16:57:00  dodi
  - updated uses, comments and todos

  Revision 1.35  2002/11/14 20:05:02  cl
  - fixed range check error

  Revision 1.34  2002/07/25 20:43:52  ma
  - updated copyright notices

  Revision 1.33  2002/01/30 22:22:49  mk
  - correct mouse coordinates before set cursor position

  Revision 1.32  2002/01/30 22:16:51  mk
  - fixed bug: setmouse tries to set CursorPosition on StdInputHandle instead
    of console handle

  Revision 1.31  2001/10/01 19:30:09  ma
  - compiles again (DOS32)

  Revision 1.30  2001/09/27 21:22:25  ml
  - Kylix compatibility stage IV

  Revision 1.29  2001/09/21 13:11:09  mk
  - made compilable with FPC

  Revision 1.28  2001/09/17 22:26:50  ml
  - compilable in linux (strutils doesn't exist there)

  Revision 1.27  2001/09/17 16:29:17  cl
  - mouse support for ncurses
  - fixes for xpcurses, esp. wrt forwardkeys handling

  - small changes to Win32 mouse support
  - function to write exceptions to debug log

  Revision 1.26  2001/09/15 19:54:56  cl
  - compiler-independent mouse support for Win32

  Revision 1.25  2001/09/10 15:58:01  ml
  - Kylix-compatibility (xpdefines written small)
  - removed div. hints and warnings

  Revision 1.24  2001/09/08 16:29:30  mk
  - use FirstChar/LastChar/DeleteFirstChar/DeleteLastChar when possible
  - some AnsiString fixes

  Revision 1.23  2001/03/13 19:24:56  ma
  - added GPL headers, PLEASE CHECK!
  - removed unnecessary comments

  Revision 1.22  2000/12/27 19:49:17  mk
  - disabled mousesupport completly

}
end.