[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]
{ Rodent unit v1.3 OooO } { << isn't he cute? } { 09/01/93 \/ }
{ Interrupt-style interface for Microsoft mouse, Turbo Pascal 6.0+}
{ by Sean L. Palmer }
{ Released to the Public Domain }
{ Please credit me if your program uses these routines! }
unit Rodent;
{$A-,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X+}
{make sure you alloc enough stack space in main program!} {as written, requires a 286+ and that the mouse exists}
interface
const
x :integer=0; y :integer=0; {current mouse pos}
xs:integer=0; ys:integer=0; {mickey counts}
left=1; center=2; right=4; {button masks- (btn and left)<>0 if left button
down}
b:boolean=false; {button status, true if any button down} var
btn:byte absolute b; {button status, mask with (btn and mask)<>0 to
get a specific button}
hidden:boolean;
type
pMouseHook=^tMouseHook;
tMouseHook=procedure;
{avoid calling dos, bios, and mouse routines from these if possible}
function erasHook(h:tMouseHook):pMouseHook;
function moveHook(h:tMouseHook):pMouseHook;
function drawHook(h:tMouseHook):pMouseHook; {change out handlers}
function clikHook(h:tMouseHook):pMouseHook;
function liftHook(h:tMouseHook):pMouseHook;
procedure show(f:boolean); {true=show}
procedure confine(l,t,r,b:integer); {set min,max bounds}
procedure moveTo(h,v:integer);
procedure setSpeed(xs,ys,thr:word); {set x,y pix per 16 mickeys, double speed threshold}
implementation
{This unit should work in any mode, but you need to provide the routines
to draw and erase the cursor.}
{note: reason coords are scaled *8 throughout is because mouse driver}
{stupidly messes with the values differently in different modes.}
{This is just a work-around so it won't be limited to every eighth column
or row in text modes.}
{PS: be very careful using mickey counts in DI & SI in event handler.}
var
hideCount:byte absolute hidden;
{this procedure does nothing, used to disable an event} procedure defaultMouseHook;far;assembler;asm end;
{must save previous setting of I-flag}
procedure clearInts;inline($9C/$FA); {pushF;cli} procedure restoreInts;inline($9D); {popF}
const
vDrawHook:tMouseHook=defaultMouseHook; {pre-set all hooks to do nothing}
vErasHook:tMouseHook=defaultMouseHook;
vMoveHook:tMouseHook=defaultMouseHook;
vClikHook:tMouseHook=defaultMouseHook;
vLiftHook:tMouseHook=defaultMouseHook;
{these all both set a hook to a procedure you provide, and also return
the old hook so you can later restore it} {Use something like:}
{var savedClikHook:tMouseHook;}
{...}
{@savedClikHook:=clikHook(myClikHook);}
{...}
{clikHook(savedClikHook)}
function drawHook(h:tMouseHook):pMouseHook;begin
drawHook:=@vDrawHook; clearInts; vDrawHook:=h; restoreInts;
end;
function erasHook(h:tMouseHook):pMouseHook;begin
erasHook:=@vErasHook; clearInts; vErasHook:=h; restoreInts;
end;
function moveHook(h:tMouseHook):pMouseHook;begin
moveHook:=@vMoveHook; clearInts; vMoveHook:=h; restoreInts;
end;
function clikHook(h:tMouseHook):pMouseHook;begin
clikHook:=@vclikHook; clearInts; vClikHook:=h; restoreInts;
end;
function liftHook(h:tMouseHook):pMouseHook;begin
liftHook:=@vLiftHook; clearInts; vLiftHook:=h; restoreInts;
end;
{here is the callback function for the mouse driver}
{calling regs:}
{ax:triggering event bit mask}
{bx:button status bit mask (bit 0=left,1=center,2=right)}
{cx:mouse X/bit 7 is sign for di,bit 0 always=0}
{dx:mouse Y/bit 7 is sign for si}
{di:abs mouse Delta X}
{si:abs mouse Delta Y}
{bits in event mask:}
{0:move}
{1:left btn down}
{2:left btn up}
{3,4:center btn}
{5,6:right btn}
{This code is real easy to break, be careful!} procedure doMouseHook;far;assembler;asm
push ax; mov ax,seg @DATA; mov ds,ax; pop ax;
mov xs,si; mov ys,di; {disregard di,si mickey counts}
mov btn,bl;
and cx,$3FFF; shr cx,3; and dx,$3FFF; shr dx,3; {strip hi bits}
push ax; push cx; push dx; {save event status}
test hidden,$FF; jnz @NOERAS; call vErasHook; @NOERAS:
pop dx; mov y,dx; pop cx; mov x,cx;
call vMoveHook; {always assume mouse has moved, disregard bit 0 of ax}
test hidden,$FF; jnz @NODRAW; call vDrawHook; @NODRAW:
pop ax; {restore event status}
@CLIK: test al,00101010b; jz @LIFT; {check any button clik flag}
push ax; call vClikHook; pop ax;
@LIFT: test al,01010100b; jz @EXIT; {check any button lift flag}
call vLiftHook;
@EXIT:
end;
procedure show(f:boolean);begin
clearInts;
if f then begin
if hidden then begin dec(hideCount); if not hidden then vDrawHook; end;
end
else begin if not hidden then vErasHook; inc(hideCount); end;
restoreInts;
end;
Procedure confine(l,t,r,b:integer);assembler;asm
mov ax,7; mov cx,l; shl cx,3; mov dx,r; shl dx,3; int $33;
mov ax,8; mov cx,t; shl cx,3; mov dx,b; shl dx,3; int $33;
end;
procedure moveTo(h,v:integer);begin
if not hidden then vErasHook;
asm mov cx,h; mov x,cx; shl cx,3;
mov dx,v; mov y,dx; shl dx,3;
mov ax,4; int $33; end;
if not hidden then vDrawHook;
end;
procedure setSpeed(xs,ys,thr:word);assembler;asm
mov ax,$1A; mov bx,xs; shl bx,3; mov cx,ys; shl cx,3; mov dx,thr; int $33;
end;
var
oldMouseHook:pointer;
oldEventMask:word;
procedure removeMouse;begin
if not hidden then show(false);
asm les dx,oldMouseHook; mov cx,oldEventMask; mov ax,$C; int $33;end;
end;
var
mouseHook:pointer absolute 0:$33*4;
const
eventMask=$7F; {all events}
function exists:boolean;assembler;asm
xor ax,ax; mov es,ax; {get ready to check interrupt vector for nil}
mov bx,es:[$33*4]; or bx,es:[$33*4+2]; jz @X; {no}
{ax still 0} int $33; @X: {result in al}
end;
begin
if exists then begin
setSpeed(32,64,4); {set up a natural-feeling speed for 640x480}
moveTo(0,0); confine(0,0,0,0); {trap the little sucker}
hideCount:=1;
asm
push cs; pop es; mov dx,offset doMouseHook; {loc of callback function}
mov cx,eventMask; mov ax,$14; int $33; {enable event callbacks}
mov oldEventMask,cx;
mov word ptr oldMouseHook,dx; mov word ptr oldMouseHook+2,es;
end;
end
else begin writeln('Need mouse.'); halt(1);end;
end.
[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]