{ 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); const MouseIsVisible: boolean = false; 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; { 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; MouseIsVisible := true; 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; MouseIsVisible := false; 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); var RR: TRealRegs; 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} while PendingMouseEvents = 0 do begin (* Give up time slices while waiting for mouse events. *) RealIntr ($28, RR); end; MouseEvent:=PendingMouseHead^; inc(PendingMouseHead); if PendingMouseHead=@PendingMouseEvent[0]+MouseEventBufsize then PendingMouseHead:=@PendingMouseEvent[0]; 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.