freepascal.compiler/api/go32v2/mouse.inc

{
  System dependent mouse implementation for go32v2

  $Id$
}

uses
  video,go32;

var
  RealSeg : Word;                                    { Real mode segment }
  RealOfs : Word;                                    { Real mode offset }
  CurrentMask : word;
  MouseCallback : Pointer;                           { Mouse call back ptr }
{$ifdef DEBUG}
  EntryEDI,EntryESI : longint;
  EntryDS,EntryES : word;
{$endif DEBUG}
  { Real mode registers in text segment below $ffff limit
    for Windows NT
    NOTE this might cause problem if someone want to
    protect text section against writing (would be possible
    with CWSDPMI under raw dos, not implemented yet !) }
  ActionRegs    : TRealRegs;external name '___v2prt0_rmcb_regs';
  v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
const
  MousePresent : boolean = false;
{$ifdef DEBUG}
  MouseError   : longint = 0;
  CallCounter  : longint = 0;
{$endif DEBUG}
  drawmousecursor : boolean = false;
  mouseisvisible : boolean = false;
  { position where the mouse was drawn the last time }
  oldmousex : longint = -1;
  oldmousey : longint = -1;
  mouselock : boolean = false;

{ if the cursor is drawn by this the unit, we must be careful }
{ when drawing while the interrupt handler is called          }
procedure lockmouse;assembler;

  asm
  .Ltrylockagain:
     movb    $1,%al
     xchgb   mouselock,%al
     orb     %al,%al
     jne     .Ltrylockagain
  end;

procedure unlockmouse;

  begin
     mouselock:=false;
  end;


{$ASMMODE ATT}
procedure MouseInt;assembler;
asm
        movb    %bl,mousebuttons
        movw    %cx,mousewherex
        movw    %dx,mousewherey
        shrw    $3,%cx
        shrw    $3,%dx
        { should we draw the mouse cursor? }
        cmpb    $0,drawmousecursor
        je      .Lmouse_nocursor
        cmpb    $0,mouseisvisible
        je      .Lmouse_nocursor
        pushw   %fs
        pushl   %eax
        pushl   %edi
        { check lock }
        movb    $1,%al
        xchgb   mouselock,%al
        orb     %al,%al
        { don't update the cursor yet, because hide/showcursor is called }
        jne    .Ldont_draw

        { load start of video buffer }
        movzwl  videoseg,%edi
        shll    $4,%edi
        movw    dosmemselector,%fs

        { calculate address of old mouse cursor }
        movl    oldmousey,%eax
        imulw   screenwidth,%ax
        addl    oldmousex,%eax
        leal    1(%edi,%eax,2),%eax
        { remove old cursor }
        xorb    $0x7f,%fs:(%eax)

        { store position of old cursor }
        movzwl  %cx,%ecx
        movl    %ecx,oldmousex
        movzwl  %dx,%edx
        movl    %edx,oldmousey

        { calculate address of new cursor }
        movl    %edx,%eax
        imulw   screenwidth,%ax
        addl    %ecx,%eax
        leal    1(%edi,%eax,2),%eax
        { draw new cursor }
        xorb    $0x7f,%fs:(%eax)

        { unlock mouse }
        movb    $0,mouselock

.Ldont_draw:
        popl    %edi
        popl    %eax
        popw    %fs
.Lmouse_nocursor:
        cmpb    MouseEventBufSize,PendingMouseEvents
        je      .Lmouse_exit
        movl    PendingMouseTail,%edi
        movw    %bx,(%edi)
        movw    %cx,2(%edi)
        movw    %dx,4(%edi)
        movw    $0,6(%edi)
        addl    $8,%edi
        leal    PendingMouseEvent,%eax
        addl    MouseEventBufSize*8,%eax
        cmpl    %eax,%edi
        jne     .Lmouse_nowrap
        leal    PendingMouseEvent,%edi
.Lmouse_nowrap:
        movl    %edi,PendingMouseTail
        incb    PendingMouseEvents
.Lmouse_exit:
end;



PROCEDURE Mouse_Trap; ASSEMBLER;
ASM
   PUSH %ES;                                          { Save ES register }
   PUSH %DS;                                          { Save DS register }
   PUSHL %EDI;                                        { Save register }
   PUSHL %ESI;                                        { Save register }
   { ; caution : ds is not the selector for our data !! }
{$ifdef DEBUG}
   MOVL  %EDI,%ES:EntryEDI
   MOVL  %ESI,%ES:EntryESI
   MOVW  %DS,%AX
   MOVW  %AX,%ES:EntryDS
   MOVW  %ES,%AX
   MOVW  %AX,%ES:EntryES
{$endif DEBUG}
 {  movw  %cs:v2prt0_ds_alias,%ax v2prt0 is not locked !!
   movw  %ax,%ds
   movw  %ax,%es }
   PUSH %ES;                                          { Push data seg }
   POP %DS;                                           { Load data seg }
{$ifdef DEBUG}
   incl callcounter
   CMPL $ACTIONREGS,%edi
   JE  .L_ActionRegsOK
   INCL MouseError
   JMP  .L_NoCallBack
.L_ActionRegsOK:
{$endif DEBUG}
   MOVL MOUSECALLBACK, %EAX;                          { Fetch callback addr }
   CMPL $0, %EAX;                                     { Check for nil ptr }
   JZ .L_NoCallBack;                                  { Ignore if nil }
   MOVL %EDI,%EAX;                                    { %EAX = @actionregs }
   MOVL (%EAX), %EDI;                                 { EDI from actionregs }
   MOVL 4(%EAX), %ESI;                                { ESI from actionregs }
   MOVL 16(%EAX), %EBX;                               { EBX from actionregs }
   MOVL 20(%EAX), %EDX;                               { EDX from actionregs }
   MOVL 24(%EAX), %ECX;                               { ECX from actionregs }
   MOVL 28(%EAX), %EAX;                               { EAX from actionregs }
   CALL *MOUSECALLBACK;                               { Call callback proc }
.L_NoCallBack:
   POPL %ESI;                                         { Recover register }
   POPL %EDI;                                         { Recover register }
   POP %DS;                                           { Restore DS register }
   POP %ES;                                           { Restore ES register }
   {  This works for WinNT
   movzwl %si,%eax
   but CWSDPMI need this }
   movl %esi,%eax
   MOVL %ds:(%Eax), %EAX;
   MOVL %EAX, %ES:42(%EDI);                           { Set as return addr }
   ADDW $4, %ES:46(%EDI);                             { adjust stack }
   IRET;                                              { Interrupt return }
END;

Function Allocate_mouse_bridge : boolean;
var
  error : word;
begin
  ASM
    LEAL ACTIONREGS, %EDI;                       { Addr of actionregs }
    LEAL MOUSE_TRAP, %ESI;                       { Procedure address }
    PUSH %DS;                                    { Save DS segment }
    PUSH %ES;                                    { Save ES segment }
    MOVW v2prt0_ds_alias,%ES;                    { ES now has dataseg  alias that is never invalid }
    PUSH %CS;
    POP  %DS;                                    { DS now has codeseg }
    MOVW $0x303, %AX;                            { Function id }
    INT  $0x31;                                  { Call DPMI bridge }
    JNC .L_call_ok;                              { Branch if ok }
    POP  %ES;                                    { Restore ES segment }
    POP  %DS;                                    { Restore DS segment }
    MOVW $0,REALSEG;
    MOVW $0,REALOFS;
    JMP  .L_exit
  .L_call_ok:
    POP  %ES;                                    { Restore ES segment }
    POP  %DS;                                    { Restore DS segment }
    MOVW %CX,REALSEG;                            { Transfer real seg }
    MOVW %DX,REALOFS;                            { Transfer real ofs }
    MOVW $0, %AX;                                { Force error to zero }
  .L_exit:
    MOVW %AX, ERROR;                             { Return error state }
  END;
  Allocate_mouse_bridge:=error=0;
end;

Procedure Release_mouse_bridge;
begin
  ASM
     MOVW $0x304, %AX;                            { Set function id }
     MOVW REALSEG, %CX;                           { Bridged real seg }
     MOVW REALOFS, %DX;                           { Bridged real ofs }
     INT $0x31;                                   { Release bridge }
     MOVW $0,REALSEG;
     MOVW $0,REALOFS;
  END;
end;

PROCEDURE Mouse_Action (Mask : Word; P : Pointer);
VAR
  Error : Word;
  Rg    : TRealRegs;
BEGIN
  Error := 0;                                         { Preset no error }
  If (P <> MouseCallBack) or (Mask<>CurrentMask) Then                        { Check func different }
   Begin
   { Remove old calback }
     If (CurrentMask <> 0) Then
      Begin
        Rg.AX := 12;                                   { Function id }
        Rg.CX := 0;                                    { Zero mask register }
        Rg.ES := 0;                                    { Zero proc seg }
        Rg.DX := 0;                                    { Zero proc ofs }
        RealIntr($33, Rg);                             { Stop INT 33 callback }
      End;
     if RealSeg=0 then
       error:=1;
    { test addresses for Windows NT }
    if (longint(@actionregs)>$ffff) {or
       (longint(@mouse_trap)>$ffff)} then
      begin
         error:=1;
      end
    else If (P = Nil) Then
     Begin
       Mask := 0;                                    { Zero mask register }
     End;
    If (Error = 0) Then
     Begin
       MouseCallback := P;                            { Set call back addr }
       if Mask<>0 then
         begin
           Rg.AX := 12;                                   { Set function id }
           Rg.CX := Mask;                                 { Set mask register }
           If Mask<>0 then
             begin
               Rg.ES := RealSeg;                              { Real mode segment }
               Rg.DX := RealOfs;                              { Real mode offset }
             end
           else
             begin
               Rg.ES:=0;
               Rg.DX:=0;
             end;
           RealIntr($33, Rg);                             { Set interrupt 33 }
         end;
       CurrentMask:=Mask;
     End;
   End;
  If (Error <> 0) Then
   Begin
     Writeln('GO32V2 mouse handler set failed !!');
     ReadLn;                                          { Wait for user to see }
   End;
END;


{ We need to remove the mouse callback before exiting !! PM }

const StoredExit : Pointer = Nil;
      FirstMouseInitDone : boolean = false;

procedure MouseSafeExit;
begin
  ExitProc:=StoredExit;
  if MouseCallBack<>Nil then
    Mouse_Action(0, Nil);
  if not FirstMouseInitDone then
    exit;
  FirstMouseInitDone:=false;
  Unlock_Code(Pointer(@Mouse_Trap), 400);            { Release trap code }
  Unlock_Code(Pointer(@MouseInt), 400);               { Lock MouseInt code  }
  Unlock_Data(ActionRegs, SizeOf(TRealRegs));        { Release registers }
  UnLock_Data(MouseCallBack,SizeOf(Pointer));
  { unlock Mouse Queue and related stuff ! }
  Unlock_Data(PendingMouseEvent,
        MouseEventBufSize*Sizeof(TMouseEvent));
  Unlock_Data(PendingMouseTail,SizeOf(longint));
  Unlock_Data(PendingMouseEvents,sizeof(byte));
  Unlock_Data(MouseButtons,SizeOf(byte));
  Unlock_Data(MouseWhereX,SizeOf(word));
  Unlock_Data(MouseWhereY,SizeOf(word));
  Unlock_Data(drawmousecursor,SizeOf(boolean));
  Unlock_Data(mouseisvisible,SizeOf(boolean));
  Unlock_Data(mouselock,SizeOf(boolean));
  Unlock_Data(videoseg,SizeOf(word));
  Unlock_Data(dosmemselector,SizeOf(word));
  Unlock_Data(screenwidth,SizeOf(word));
  Unlock_Data(OldMouseX,SizeOf(longint));
  Unlock_Data(OldMouseY,SizeOf(longint));
{$ifdef DEBUG}
  Unlock_Data(EntryEDI, SizeOf(longint));
  Unlock_Data(EntryESI, SizeOf(longint));
  Unlock_Data(EntryDS, SizeOf(word));
  Unlock_Data(EntryES, SizeOf(word));
  Unlock_Data(MouseError, SizeOf(longint));
  Unlock_Data(callcounter, SizeOf(longint));
{$endif DEBUG}
  Release_mouse_bridge;
end;


procedure InitMouse;
begin
  if not MousePresent then
    begin
      if DetectMouse=0 then
        begin
          Writeln('No mouse driver found ');
          exit;
        end
      else
        MousePresent:=true;
    end;
  PendingMouseHead:=@PendingMouseEvent;
  PendingMouseTail:=@PendingMouseEvent;
  PendingMouseEvents:=0;
  FillChar(LastMouseEvent,sizeof(TMouseEvent),0);

  { don't do this twice !! PM }

  If not FirstMouseInitDone then
    begin
      StoredExit:=ExitProc;
      ExitProc:=@MouseSafeExit;
      Lock_Code(Pointer(@Mouse_Trap), 400);              { Lock trap code }
      Lock_Code(Pointer(@MouseInt), 400);               { Lock MouseInt code  }
      Lock_Data(ActionRegs, SizeOf(TRealRegs));          { Lock registers }
      Lock_Data(MouseCallBack, SizeOf(pointer));
      { lock Mouse Queue and related stuff ! }
      Lock_Data(PendingMouseEvent,
        MouseEventBufSize*Sizeof(TMouseEvent));
      Lock_Data(PendingMouseTail,SizeOf(longint));
      Lock_Data(PendingMouseEvents,sizeof(byte));
      Lock_Data(MouseButtons,SizeOf(byte));
      Lock_Data(MouseWhereX,SizeOf(word));
      Lock_Data(MouseWhereY,SizeOf(word));
      Lock_Data(drawmousecursor,SizeOf(boolean));
      Lock_Data(mouseisvisible,SizeOf(boolean));
      Lock_Data(mouselock,SizeOf(boolean));
      Lock_Data(videoseg,SizeOf(word));
      Lock_Data(dosmemselector,SizeOf(word));
      Lock_Data(screenwidth,SizeOf(word));
      Lock_Data(OldMouseX,SizeOf(longint));
      Lock_Data(OldMouseY,SizeOf(longint));
{$ifdef DEBUG}
      Lock_Data(EntryEDI, SizeOf(longint));
      Lock_Data(EntryESI, SizeOf(longint));
      Lock_Data(EntryDS, SizeOf(word));
      Lock_Data(EntryES, SizeOf(word));
      Lock_Data(MouseError, SizeOf(longint));
      Lock_Data(callcounter, SizeOf(longint));
{$endif DEBUG}
      Allocate_mouse_bridge;
      FirstMouseInitDone:=true;
    end;
  If MouseCallBack=Nil then
    Mouse_Action($ffff, @MouseInt);                    { Set masks/interrupt }
  drawmousecursor:=false;
  mouseisvisible:=false;
  if (screenwidth>80) or (screenheight>50) then
    DoCustomMouse(true);
  ShowMouse;
end;


procedure DoneMouse;
begin
  HideMouse;
  If (MouseCallBack <> Nil) Then
    Mouse_Action(0, Nil);                            { Clear mask/interrupt }
end;


function DetectMouse:byte;assembler;
asm
        movl    $0x200,%eax
        movl    $0x33,%ebx
        int     $0x31
        movw    %cx,%ax
        orw     %ax,%dx
        jz      .Lno_mouse
        xorl    %eax,%eax
        pushl   %ebp
        int     $0x33
        popl    %ebp
        orw     %ax,%ax
        jz      .Lno_mouse
        movl    %ebx,%eax
.Lno_mouse:
end;


procedure ShowMouse;

begin
   if drawmousecursor then
     begin
        lockmouse;
        if not(mouseisvisible) then
          begin
             oldmousex:=getmousex-1;
             oldmousey:=getmousey-1;
             mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
               mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
             mouseisvisible:=true;
          end;
        unlockmouse;
     end
   else
     asm
             cmpb    $1,MousePresent
             jne     .LShowMouseExit
             movl    $1,%eax
             pushl   %ebp
             int     $0x33
             popl    %ebp
     .LShowMouseExit:
     end;
end;


procedure HideMouse;

begin
   if drawmousecursor then
     begin
        lockmouse;
        if mouseisvisible then
          begin
             mouseisvisible:=false;
             mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
               mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
             oldmousex:=-1;
             oldmousey:=-1;
          end;
        unlockmouse;
     end
   else
     asm
             cmpb    $1,MousePresent
             jne     .LHideMouseExit
             movl    $2,%eax
             pushl   %ebp
             int     $0x33
             popl    %ebp
     .LHideMouseExit:
     end;
end;


function GetMouseX:word;assembler;
asm
        cmpb    $1,MousePresent
        jne     .LGetMouseXError
        movl    $3,%eax
        pushl   %ebp
        int     $0x33
        popl    %ebp
        movzwl  %cx,%eax
        shrl    $3,%eax
        incl    %eax
        ret
.LGetMouseXError:
        xorl    %eax,%eax
end;


function GetMouseY:word;assembler;
asm
        cmpb    $1,MousePresent
        jne     .LGetMouseYError
        movl    $3,%eax
        pushl   %ebp
        int     $0x33
        popl    %ebp
        movzwl  %dx,%eax
        shrl    $3,%eax
        incl    %eax
        ret
.LGetMouseYError:
        xorl    %eax,%eax
end;


function GetMouseButtons:word;assembler;
asm
        cmpb    $1,MousePresent
        jne     .LGetMouseButtonsError
        movl    $3,%eax
        pushl   %ebp
        int     $0x33
        popl    %ebp
        movw    %bx,%ax
        ret
.LGetMouseButtonsError:
        xorl    %eax,%eax
end;


procedure SetMouseXY(x,y:word);assembler;
asm
        cmpb    $1,MousePresent
        jne     .LSetMouseXYExit
        movw    x,%cx
        movw    y,%dx
        movl    $4,%eax
        pushl   %ebp
        int     $0x33
        popl    %ebp
.LSetMouseXYExit:
end;

Procedure SetMouseXRange (Min,Max:Longint);
begin
  If Not(MousePresent) Then Exit;
  asm
        movl    $7,%eax
        movl    min,%ecx
        movl    max,%edx
        pushl   %ebp
        int     $0x33
        popl    %ebp
  end;
end;

Procedure SetMouseYRange (min,max:Longint);
begin
  If Not(MousePresent) Then Exit;
  asm
        movl    $8,%eax
        movl    min,%ecx
        movl    max,%edx
        pushl   %ebp
        int     $0x33
        popl    %ebp
  end;
end;

procedure DoCustomMouse(b : boolean);

  begin
     HideMouse;
     lockmouse;
     oldmousex:=-1;
     oldmousey:=-1;
     SetMouseXRange(0,(screenwidth-1)*8);
     SetMouseYRange(0,(screenheight-1)*8);
     if b then
       begin
          mouseisvisible:=false;
          drawmousecursor:=true;
       end
     else
       drawmousecursor:=false;
     unlockmouse;
  end;

const
  LastCallcounter : longint = 0;

procedure GetMouseEvent(var MouseEvent: TMouseEvent);
begin
  if not MousePresent then
    begin
      Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
    end;
{$ifdef DEBUG}
  if mouseError>0 then
    Writeln('Errors in mouse Handler ',MouseError);
{$ifdef EXTMOUSEDEBUG}
  if callcounter>LastCallcounter then
    Writeln('Number of calls in mouse Handler ',Callcounter);
{$endif EXTMOUSEDEBUG}
  LastCallcounter:=Callcounter;
{$endif DEBUG}
  repeat until PendingMouseEvents>0;
  MouseEvent:=PendingMouseHead^;
  inc(PendingMouseHead);
  if longint(PendingMouseHead)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
   PendingMouseHead:=@PendingMouseEvent;
  dec(PendingMouseEvents);
  if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
   MouseEvent.Action:=MouseActionMove;
  if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
   begin
     if (LastMouseEvent.Buttons=0) then
      MouseEvent.Action:=MouseActionDown
     else
      MouseEvent.Action:=MouseActionUp;
   end;
  LastMouseEvent:=MouseEvent;
end;


function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
begin
  if PendingMouseEvents>0 then
   begin
     MouseEvent:=PendingMouseHead^;
     PollMouseEvent:=true;
   end
  else
   PollMouseEvent:=false;
end;

{
  $Log$
  Revision 1.2  2000-07-13 11:32:24  michael
  + removed logs
 
}