mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 15:39:24 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			796 lines
		
	
	
		
			23 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			796 lines
		
	
	
		
			23 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    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 Go32v2
 | 
						|
 | 
						|
    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
 | 
						|
 | 
						|
{$i mouseh.inc}
 | 
						|
 | 
						|
{ tells the mouse unit to draw the mouse cursor itself }
 | 
						|
procedure DoCustomMouse(b : boolean);
 | 
						|
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
uses
 | 
						|
  video,go32;
 | 
						|
 | 
						|
{$i mouse.inc}
 | 
						|
 | 
						|
 | 
						|
var
 | 
						|
  RealSeg : Word;                                    { Real mode segment }
 | 
						|
  RealOfs : Word;                                    { Real mode offset }
 | 
						|
  CurrentMask : word;
 | 
						|
  MouseCallback : Pointer;                           { Mouse call back ptr }
 | 
						|
  UnderNT: boolean;
 | 
						|
{$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;
 | 
						|
  First_try    : boolean = true;
 | 
						|
{$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
 | 
						|
        pushl   %edi
 | 
						|
        pushl   %ebx
 | 
						|
        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:
 | 
						|
        popl   %ebx
 | 
						|
        popl   %edi
 | 
						|
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;
 | 
						|
 | 
						|
PROCEDURE Mouse_Trap_NT; ASSEMBLER;
 | 
						|
ASM
 | 
						|
   pushl %eax;
 | 
						|
   PUSH %ES;                                          { Save ES register }
 | 
						|
   PUSH %DS;                                          { Save DS register }
 | 
						|
   PUSH %FS;                                          { Save FS register }
 | 
						|
   PUSHL %EDI;                                        { Save register }
 | 
						|
   PUSHL %ESI;                                        { Save register }
 | 
						|
   pushl %ebx;
 | 
						|
   pushl %ecx;
 | 
						|
   pushl %edx;
 | 
						|
   { ; caution : ds is not the selector for our data !! }
 | 
						|
   MOVW %cs:v2prt0_ds_alias,%ax
 | 
						|
   movw %ax,%es
 | 
						|
   { ES now has dataseg  alias that is never invalid }
 | 
						|
{$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 %edx;
 | 
						|
   popl %ecx;
 | 
						|
   popl %ebx;
 | 
						|
   POPL %ESI;                                         { Recover register }
 | 
						|
   POPL %EDI;                                         { Recover register }
 | 
						|
   POP %FS;                                           { Restore FS register }
 | 
						|
   POP %DS;                                           { Restore DS register }
 | 
						|
   POP %ES;                                           { Restore ES register }
 | 
						|
   movw %es,%ax
 | 
						|
   cmpw $0,%ax
 | 
						|
   jne .Lesisok
 | 
						|
   { ; caution : ds is not the selector for our data !! }
 | 
						|
   MOVW %cs:v2prt0_ds_alias,%ax
 | 
						|
   movw %ax,%es
 | 
						|
.Lesisok:
 | 
						|
   lsl  %eax,%eax
 | 
						|
   cmpl %edi,%eax
 | 
						|
   ja   .Ldontzeroedi
 | 
						|
   movzwl %di,%edi
 | 
						|
.Ldontzeroedi:
 | 
						|
   movw %ds,%ax
 | 
						|
   lsl  %eax,%eax
 | 
						|
   cmpl %esi,%eax
 | 
						|
   ja   .Lsimplecopy
 | 
						|
   movzwl %si,%eax
 | 
						|
   jmp  .Lcopyend
 | 
						|
.Lsimplecopy:
 | 
						|
   movl %esi,%eax
 | 
						|
.Lcopyend:
 | 
						|
   MOVL %ds:(%Eax), %EAX
 | 
						|
   MOVL %EAX, %ES:42(%EDI)                           { Set as return addr }
 | 
						|
   ADDW $4, %ES:46(%EDI)                             { adjust stack }
 | 
						|
   popl %eax
 | 
						|
   IRET                                              { Interrupt return }
 | 
						|
END;
 | 
						|
 | 
						|
Function Allocate_mouse_bridge : boolean;
 | 
						|
var
 | 
						|
  error : word;
 | 
						|
begin
 | 
						|
  ASM
 | 
						|
    pushl %edi
 | 
						|
    pushl %esi
 | 
						|
    LEAL ACTIONREGS, %EDI;                       { Addr of actionregs }
 | 
						|
    LEAL MOUSE_TRAP, %ESI;                       { Procedure address }
 | 
						|
    CMPB $0, UnderNT
 | 
						|
    JZ  .LGo32
 | 
						|
    LEAL MOUSE_TRAP_NT, %ESI;                       { Procedure address }
 | 
						|
  .LGo32:
 | 
						|
    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 }
 | 
						|
    popl %esi
 | 
						|
    popl %edi
 | 
						|
  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(@Mouse_Trap_NT), 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;
 | 
						|
 | 
						|
function RunningUnderWINNT: boolean;
 | 
						|
var r: trealregs;
 | 
						|
begin
 | 
						|
  fillchar(r,sizeof(r),0);
 | 
						|
  r.ax:=$3306;
 | 
						|
  realintr($21,r);
 | 
						|
  RunningUnderWINNT:=(r.bx=$3205);
 | 
						|
end;
 | 
						|
 | 
						|
procedure SysInitMouse;
 | 
						|
begin
 | 
						|
  UnderNT:=RunningUnderWINNT;
 | 
						|
  if not MousePresent then
 | 
						|
    begin
 | 
						|
      if DetectMouse=0 then
 | 
						|
        begin
 | 
						|
          if First_try then
 | 
						|
            begin
 | 
						|
              Writeln('No mouse driver found ');
 | 
						|
              First_try:=false;
 | 
						|
            end;
 | 
						|
          exit;
 | 
						|
        end
 | 
						|
      else
 | 
						|
        MousePresent:=true;
 | 
						|
    end;
 | 
						|
  { 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(@Mouse_Trap_NT), 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 SysDoneMouse;
 | 
						|
begin
 | 
						|
  HideMouse;
 | 
						|
  If (MouseCallBack <> Nil) Then
 | 
						|
    Mouse_Action(0, Nil);                            { Clear mask/interrupt }
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function SysDetectMouse:byte;assembler;
 | 
						|
asm
 | 
						|
        pushl   %ebx
 | 
						|
        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:
 | 
						|
        popl    %ebx
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
procedure SysShowMouse;
 | 
						|
 | 
						|
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 SysHideMouse;
 | 
						|
 | 
						|
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 SysGetMouseX:word;assembler;
 | 
						|
asm
 | 
						|
        pushl   %ebx
 | 
						|
        cmpb    $1,MousePresent
 | 
						|
        jne     .LGetMouseXError
 | 
						|
        movl    $3,%eax
 | 
						|
        pushl   %ebp
 | 
						|
        int     $0x33
 | 
						|
        popl    %ebp
 | 
						|
        movzwl  %cx,%eax
 | 
						|
        shrl    $3,%eax
 | 
						|
        incl    %eax
 | 
						|
        jmp .Lexit
 | 
						|
.LGetMouseXError:
 | 
						|
        xorl    %eax,%eax
 | 
						|
.Lexit:
 | 
						|
        popl    %ebx
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function SysGetMouseY:word;assembler;
 | 
						|
asm
 | 
						|
        pushl   %ebx
 | 
						|
        cmpb    $1,MousePresent
 | 
						|
        jne     .LGetMouseYError
 | 
						|
        movl    $3,%eax
 | 
						|
        pushl   %ebp
 | 
						|
        int     $0x33
 | 
						|
        popl    %ebp
 | 
						|
        movzwl  %dx,%eax
 | 
						|
        shrl    $3,%eax
 | 
						|
        incl    %eax
 | 
						|
        jmp .Lexit
 | 
						|
.LGetMouseYError:
 | 
						|
        xorl    %eax,%eax
 | 
						|
.Lexit:
 | 
						|
        popl    %ebx
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function SysGetMouseButtons:word;assembler;
 | 
						|
asm
 | 
						|
        pushl   %ebx
 | 
						|
        cmpb    $1,MousePresent
 | 
						|
        jne     .LGetMouseButtonsError
 | 
						|
        movl    $3,%eax
 | 
						|
        pushl   %ebp
 | 
						|
        int     $0x33
 | 
						|
        popl    %ebp
 | 
						|
        movw    %bx,%ax
 | 
						|
        jmp     .Lexit
 | 
						|
.LGetMouseButtonsError:
 | 
						|
        xorl    %eax,%eax
 | 
						|
.Lexit:
 | 
						|
        popl    %ebx
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
procedure SysSetMouseXY(x,y:word);assembler;
 | 
						|
asm
 | 
						|
        pushl   %ebx
 | 
						|
        cmpb    $1,MousePresent
 | 
						|
        jne     .LSetMouseXYExit
 | 
						|
        movw    x,%cx
 | 
						|
        movw    y,%dx
 | 
						|
        movl    $4,%eax
 | 
						|
        pushl   %ebp
 | 
						|
        int     $0x33
 | 
						|
        popl    %ebp
 | 
						|
.LSetMouseXYExit:
 | 
						|
        popl    %ebx
 | 
						|
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 SysGetMouseEvent(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 and MouseEvent.buttons<>LastMouseEvent.Buttons) then
 | 
						|
       MouseEvent.Action:=MouseActionUp
 | 
						|
     else
 | 
						|
       MouseEvent.Action:=MouseActionDown;
 | 
						|
   end;
 | 
						|
  LastMouseEvent:=MouseEvent;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
Const
 | 
						|
  SysMouseDriver : TMouseDriver = (
 | 
						|
    useDefaultQueue : true;
 | 
						|
    InitDriver      : @SysInitMouse;
 | 
						|
    DoneDriver      : @SysDoneMouse;
 | 
						|
    DetectMouse     : @SysDetectMouse;
 | 
						|
    ShowMouse       : @SysShowMouse;
 | 
						|
    HideMouse       : @SysHideMouse;
 | 
						|
    GetMouseX       : @SysGetMouseX;
 | 
						|
    GetMouseY       : @SysGetMouseY;
 | 
						|
    GetMouseButtons : @SysGetMouseButtons;
 | 
						|
    SetMouseXY      : @SysSetMouseXY;
 | 
						|
    GetMouseEvent   : @SysGetMouseEvent;
 | 
						|
    PollMouseEvent  : Nil;
 | 
						|
    PutMouseEvent  : Nil;
 | 
						|
  );
 | 
						|
 | 
						|
Begin
 | 
						|
  SetMouseDriver(SysMouseDriver);
 | 
						|
end.
 |