'===========================================================================
' Subject: MOUSE FUNCTIONS FOR QBASIC         Date: Year of 1995           
'  Author: Glen Blankenship                   Code: QB, QBasic, PDS        
'  Origin: comp.lang.basic.misc             Packet: MOUSE.ABC
'===========================================================================
'There are two core functions, InitMouse and CallMouse.  InitMouse
'establishes that a mouse driver is present and active and initializes the
'mouse to its default state.  CallMouse performs the actual function calls.

'In addition, I've included subroutines for several standard mouse function
'calls.  The only one that's at all complex is the cursor-setting routine.
'Most of the others are simple "wrappers" that pass the caller's parameters
'on to CallMouse, after setting any unused parameters to zero.

'It's easy enough to builds wrappers for any mouse functions I haven't
'included - just look at any list of Int 33h mouse calls, and place the
'register parameters in the correspondingly-named CallMouse parameters.

'Here's the program:
'------------------------------------------------------------
'MOUS4QB.BAS - Mouse functions for QBasic
'By Glen Blankenship, 1995
'This code is hereby dedicated to the public domain.

DEFINT A-Z

'The two core functions:
DECLARE SUB CallMouse (regAX%, regBX%, regCX%, regDX%)
DECLARE FUNCTION InitMouse% ()
                  
'Wrappers for assorted mouse-driver function calls:
DECLARE SUB MouseHardReset ()
DECLARE SUB MouseShow ()
DECLARE SUB MouseHide ()
DECLARE SUB MouseGetStatus (LButton%, RButton%, WhereX%, WhereY%)
DECLARE SUB MousePut (XCoord%, YCoord%)
DECLARE SUB MouseHorizLimits (Left%, Right%)
DECLARE SUB MouseVertLimits (Upper%, Lower%)
DECLARE SUB MouseSetGraphCursor ()

CONST FALSE = 0
CONST TRUE = NOT FALSE

'=-=-=-=-=-=-= Test Program  =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
CONST LimitLeft = 100
CONST LimitRight = 400
CONST LimitTop = 50
CONST LimitBottom = 200

CLS
SCREEN 9
IF InitMouse THEN
   MouseHorizLimits LimitLeft, LimitRight
   MouseVertLimits LimitTop, LimitBottom
  
   'Draw box to show Mouse Motion Limits
   LINE (LimitRight, LimitTop)-(LimitLeft, LimitBottom), 3, BF
  
   'Create a hand-shaped mouse cursor
   RESTORE Hand
   MouseSetGraphCursor
  
   'Place the cursor in the middle of the box
   BoxCenterX = LimitLeft + ((LimitRight - LimitLeft) \ 2)
   BoxCenterY = LimitTop + ((LimitBottom - LimitTop) \ 2)
   MousePut BoxCenterX, BoxCenterY

   LOCATE 1, 1
   PRINT "Press either mouse button to quit"
  
   MouseShow                     'Make the cursor visible
  
   DO
      MouseGetStatus LeftButton, RightButton, XCoord, YCoord
     
      LOCATE 2, 1
      PRINT "X Coordinate:"; XCoord
      PRINT "Y Coordinate:"; YCoord       'Print Cursor Location
   LOOP UNTIL LeftButton OR RightButton   'Loop until either button pressed
  
   MouseHide                     'Hide the cursor
   MouseHardReset                'Reset mouse to default state

ELSE                             '(If InitMouse returned 0)
  PRINT "No mouse active";
  SLEEP 1
END IF
  
SCREEN 0: WIDTH 80: CLS          'Reset to text mode
SYSTEM                           'Exit to DOS


Hand:          'Data for graphics cursor, used by MouseSetGraphCursor

'First, the Hot Spot cordinates:
DATA  4        :  'X coordinate
DATA  0        :  'Y coordinate

'Next, the two cursor masks.  The data is shown here as hexadecimal
'numbers.  Each hex digit corresponds to 4 bits in the mask.  The
'bits are shown graphically in the comment lines.

'Screen mask - Clear bits black out the corresponding pixel:
DATA  &HF3FF   : ';X,X,X,X;_,_,X,X;X,X,X,X;X,X,X,X;
DATA  &HE1FF   : ';X,X,X,_;_,_,_,X;X,X,X,X;X,X,X,X;
DATA  &HE1FF   : ';X,X,X,_;_,_,_,X;X,X,X,X;X,X,X,X;
DATA  &HE1FF   : ';X,X,X,_;_,_,_,X;X,X,X,X;X,X,X,X;
DATA  &HE049   : ';X,X,X,_;_,_,_,_;_,X,_,_;X,_,_,X;
DATA  &HE000   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H8000   : ';X,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H8000   : ';X,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &HC001   : ';X,X,_,_;_,_,_,_;_,_,_,_;_,_,_,X;
DATA  &HE001   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,X;
DATA  &HE001   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,X;
DATA  &HE001   : ';X,X,X,_;_,_,_,_;_,_,_,_;_,_,_,X;

'Cursor Mask - Set bits invert the color of the corresponding pixel:
DATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;
DATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;
DATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;
DATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;
DATA  &H0C00   : ';_,_,_,_;X,X,_,_;_,_,_,_;_,_,_,_;
DATA  &H0DB6   : ';_,_,_,_;X,X,_,X;X,_,X,X;_,X,X,_;
DATA  &H0DB6   : ';_,_,_,_;X,X,_,X;X,_,X,X;_,X,X,_;
DATA  &H6DB6   : ';_,X,X,_;X,X,_,X;X,_,X,X;_,X,X,_;
DATA  &H6FFE   : ';_,X,X,_;X,X,X,X;X,X,X,X;X,X,X,_;
DATA  &H6FFE   : ';_,X,X,_;X,X,X,X;X,X,X,X;X,X,X,_;
DATA  &H7FFE   : ';_,X,X,X;X,X,X,X;X,X,X,X;X,X,X,_;
DATA  &H3FFE   : ';_,_,X,X;X,X,X,X;X,X,X,X;X,X,X,_;
DATA  &H1FFC   : ';_,_,_,X;X,X,X,X;X,X,X,X;X,X,_,_;
DATA  &H0FFC   : ';_,_,_,_;X,X,X,X;X,X,X,X;X,X,_,_;
DATA  &H0FFC   : ';_,_,_,_;X,X,X,X;X,X,X,X;X,X,_,_;
DATA  &H0000   : ';_,_,_,_;_,_,_,_;_,_,_,_;_,_,_,_;

'End Test Program =-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

'--------------END MOUS4QB.BAS------------------------------------

SUB CallMouse (regAX, regBX, regCX, regDX)
   SHARED Mseg, Mofs, MousePresent  'shared w/InitMouse
  
   IF MousePresent THEN
      DEF SEG = Mseg
      CALL ABSOLUTE(regAX, regBX, regCX, regDX, Mofs)
      DEF SEG
   END IF
END SUB

FUNCTION InitMouse STATIC
   SHARED Mseg, Mofs, MousePresent     'Shared  w/CallMouse

   CONST IRET = &HCF          'OpCode of IRET instruction
   CONST MVector = &H33 * 4   'Mouse interrupt vector address  - Int 33h

   MousePresent = FALSE       'Assume no mouse
   InitMouse = FALSE

   DEF SEG = 0                'Get mouse driver interrupt vector
   mv0 = PEEK(MVector)
   mv1 = PEEK(MVector + 1)
   mv2 = PEEK(MVector + 2)
   mv3 = PEEK(MVector + 3)

   DEF SEG
   POKE VARPTR(Mofs), mv0
   POKE VARPTR(Mofs) + 1, mv1
   POKE VARPTR(Mseg), mv2
   POKE VARPTR(Mseg) + 1, mv3

   'Check to see if driver is installed.
   'First, make sure vector is non-zero:
   IF Mseg OR Mofs THEN
      'Next, make sure byte at interrupt entry is not an IRET:
      DEF SEG = Mseg
      IF PEEK(Mofs) <> IRET THEN
         Mofs = Mofs + 2            'BASIC entry is at int entry + 2
         MousePresent = TRUE        'It's present.  Is it active?
         ax = 0
         CallMouse ax, 0, 0, 0      'Mouse Function 0 - H'ware reset
         MousePresent = ax          'Set MousePresent and InitMouse
         InitMouse = MousePresent   '  to returned value.
      END IF
      DEF SEG
   END IF
END FUNCTION

SUB MouseGetStatus (LButton, RButton, X, Y) STATIC
   CallMouse 3, Buttons, X, Y          'Function 3: Get Mouse Status
   LButton = ((Buttons AND 1) = 1)     'Set Buttons to true/false
   RButton = ((Buttons AND 2) = 2)
END SUB

SUB MouseHardReset STATIC
   CallMouse 0, 0, 0, 0                'Function 0:  Reset Mouse
END SUB

SUB MouseHide STATIC
   CallMouse 2, 0, 0, 0                'Function 2:  Hide Cursor
END SUB

SUB MouseHorizLimits (Left, Right) STATIC
   CallMouse 7, 0, Left, Right         'Function 7:  Limit Horizontal Motion
END SUB

SUB MousePut (XCoord, YCoord) STATIC
   CallMouse 4, 0, XCoord, YCoord      'Function 4 - Set mouse position
END SUB

SUB MouseSetGraphCursor STATIC
   '--- NOTE -------------------------------
   'Caller must RESTORE to cursor DATA block
   'before calling this routine
   '----------------------------------------
   READ HotSpotX
   READ HotSpotY

   FOR i = 1 TO 32
      READ HexVal
      cursor$ = cursor$ + MKI$(HexVal)
   NEXT

   'Function 9 - Set Graphics Cursor
   CallMouse 9, HotSpotX, HotSpotY, SADD(cursor$)
END SUB

SUB MouseShow STATIC
   CallMouse 1, 0, 0, 0                'Function 1:  Show Cursor
END SUB

SUB MouseVertLimits (Upper, Lower) STATIC
   CallMouse 8, 0, Upper, Lower        'Function 8:  Limit Vertical Motion
END SUB