[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]