'===========================================================================
' Subject: MOUSE DEMO                         Date: 01-25-96 (00:00)       
'  Author: Hardin Brothers                    Code: QB, QBasic, PDS        
'  Origin: kwmelvin@nr.infi.net             Packet: MOUSE.ABC
'===========================================================================
'----------------------------------------------------------------------------
'    FileName:  MOUSEDEMO.BAS for QBasic 1.x
'      Author:  Hardin Brothers
' Publication:  _DOS World_ issue #25 January 1996 pp.51-57
' DW Internet:  75300.2361@compuserve.com
'      DW BBS:  603-924-3181 [8-N-1]
'  DW Address:  DOS World, 86 Elm St., Peterborough, NH 03458  USA
'    Comments:  To find out what the mouse is doing, your program must "talk"
'            :  to the mouse driver. A mouse and driver must be installed
'            :  for this program to work. Then your program must make requests
'            :  of the mouse driver by calling Interrupt 33 hexadecimal. (An
'            :  Interrupt is similar to a CALL or GOSUB in QBasic, but instead
'            :  of working within a program, it lets one program call another,
'            :  without worrying about where the second program is in memory.
'            :
' Essential Mouse Services
' Procedure  :  Purpose
'------------:---------------------------------------------------------------
'   MouseCall:  Calls mouse and passes it a command via CPU registers.
'            :
'    MouseInt:  Initializes mouse and reports number of buttons. Returns 0
'            :  if mouse driver unavailable or mouse not present.
'            :
'  MouseSetup:  Sets up mouse machine-language routine. You must call this
'            :  subprocedure before calling any other service!
' -----------:---------------------------------------------------------------
' Optional Mouse Services   
' Procedure  :  Purpose
' -----------:---------------------------------------------------------------
'   MouseShow:  Displays mouse cursor.
'            :
'   MouseHide:  Hides mouse cursor. To avoid appearance of "ghost" cursors,
'            :  use this service before printing or updating screen.
'            :
' MouseGetPr_:  Gets information about last mouse click. Shows which button
'essInfo     :  is down, number of clicks since last call, vertical and
'            :  horizontal position of cursor at last mouse click.
'            :
' MouseGetRe_:  Gets information about last release of mouse buttons. Use
'leaseInfo   :  MouseGetPressInfo and MouseGetReleaseInfo together to let
'            :  user drag objects around screen.
'            :
' MouseGetSt_:  Gets information on current status of mouse.
'atus        :
' MouseReadC_:  Returns horizontal and vertical position of mouse cursor,
'ounters     :  relative to its location last time function called.
'            :
' MouseSetHo_:  Restricts mouse movement by setting minimum and maximum
'rzRange     :  horizontal range of mouse cursor.
'            :
' MouseSetVe_:  Restricts mouse movement by setting minimum and maximum
'rtRange     :  vertical range of mouse cursor.
'            :
'MouseSetPosn:  Sets mouse cursor to correspond to values of HPosn% and VPosn%
'            :
'            :
'----------------------------------------------------------------------------
DECLARE SUB Demo3 ()
DECLARE SUB Demo2 ()
DECLARE SUB Demo1 ()
DECLARE FUNCTION MouseInit% ()
DECLARE SUB MouseCall ()
DECLARE SUB MouseGetPressInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)
DECLARE SUB MouseGetReleaseInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)
DECLARE SUB MouseGetStatus (LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseReadCounters (HCount%, VCount%)
DECLARE SUB MouseSetHorizRange (HMin%, HMax%)
DECLARE SUB MouseSetPosn (HPosn%, VPosn%)
DECLARE SUB MouseSetup ()
DECLARE SUB MouseSetVertRange (VMin%, VMax%)
DECLARE SUB MouseShow ()

MouseInt:
' Machine language routine 40 bytes long:
DATA 55          : 'PUSH BP
DATA 89, E5      : 'MOV  BP, SP
DATA 56          : 'PUSH SI
DATA 8B, 76, 06  : 'MOV  SI,[BP+6]
DATA 8B, 04      : 'MOV  AX,[SI]
DATA 8B, 5C, 02  : 'MOV  BX,[SI+2]
DATA 8B, 4C, 04  : 'MOV  CX,[SI+4]
DATA 8B, 54, 06  : 'MOV  DX,[SI+6]
DATA 8E, 44, 08  : 'MOV  ES,[SI+8]
DATA CD, 33      : 'INT  33h
DATA 8C, 44, 08  : 'MOV  [SI+8],ES
DATA 89, 54, 06  : 'MOV  [SI+6],DX
DATA 89, 4C, 04  : 'MOV  [SI+4],CX
DATA 89, 5C, 02  : 'MOV  [SI+2],BX
DATA 89, 04      : 'MOV  [SI],AX
DATA 5E          : 'POP     SI
DATA 5D          : 'POP  BP
DATA CB          : 'RETF

TYPE MouseRegs
  AX AS INTEGER
  BX AS INTEGER
  CX AS INTEGER
  DX AS INTEGER
  ES AS INTEGER
END TYPE

DIM SHARED MReg AS MouseRegs
REDIM SHARED MouseRoutine%(0 TO 19)
DIM SHARED MouseReady%
MouseReady% = 0
MouseSetup
MouseReady% = MouseInit

DEFINT A-Z

CLS
TYPE TextMask
  Bg AS INTEGER
  Fg AS INTEGER
  Char AS INTEGER
  Mask AS INTEGER
END TYPE

IF MouseReady% THEN
  Demo1
  Demo2
  Demo3
ELSE
  CLS
  PRINT "No Mouse available for demonstration"
END IF
END

SUB Demo1
'*
'* display the mouse
'* and its current status
'*
  CLS
  PRINT , , "Press Esc to end"
  PRINT "Mouse has"; MouseReady%; "buttons";
  MouseShow
  DO
    CALL MouseGetStatus(L%, R%, M%, Horiz%, Vert%)
    LOCATE 3, 1
    IF L% THEN PRINT "Left Dn";  ELSE PRINT "Left Up";
    IF MouseReady > 2 THEN
      IF M% THEN PRINT " -- Mid Dn";  ELSE PRINT " -- Mid Up";
    END IF
    IF R% THEN PRINT " -- Right Dn";  ELSE PRINT " -- Right Up";
    LOCATE 4, 1
    PRINT USING "Mouse at column ### and row ###"; Horiz%; Vert%
    Esc$ = INKEY$
  LOOP UNTIL Esc$ = CHR$(27)
  MouseHide
END SUB

SUB Demo2
  RANDOMIZE TIMER
  MouseShow
  DO
    CLS
    PRINT "Click left button for new window - right button to end. "
    Top = INT(RND * 15) + 2
    Vert = INT(RND * (22 - Top)) + 3
    Left = INT(RND * 60) + 1
    Horiz = INT(RND * (77 - Left)) + 3
    LOCATE Top, Left
    PRINT CHR$(201); STRING$(Horiz, 205); CHR$(187);
    FOR I = 1 TO Vert
      LOCATE Top + I, Left
      PRINT CHR$(186); STRING$(Horiz, 32); CHR$(186);
    NEXT I
    LOCATE Top + Vert, Left
    PRINT CHR$(200); STRING$(Horiz, 205); CHR$(188);
    CALL MouseSetHorizRange(Left * 8, (Left + Horiz - 1) * 8)
    CALL MouseSetVertRange(Top * 8, (Top + Vert - 2) * 8)
Demo2LP:
  L = 0: R = 1: M = 0
  CALL MouseGetPressInfo(L, R, M, CNT, H, V)
  IF R THEN
    MouseHide
    EXIT SUB
  END IF
  L = 1: R = 0: M = 0
  CALL MouseGetPressInfo(L, R, M, CNT, H, V)
  IF L = 0 THEN GOTO Demo2LP
  DO
    CALL MouseGetStatus(L, R, M, H, V)
  LOOP UNTIL (L OR R OR M) = 0
LOOP
END SUB

SUB Demo3
  CLS
  PRINT "Press Esc to end"
  PRINT "Use mouse and left button or arrow keys and Enter to select"
  DIM CH$(1 TO 4)
  FOR I = 1 TO 4
    CH$(I) = CHR$(64 + I)
    LOCATE 10 + I, 35
    PRINT "Select "; CH$(I);
  NEXT I
  COLOR 0, 7
  LOCATE 11, 35
  PRINT "Select "; CH$(1);
  OldSel = 1
  Hit = 0
  CALL MouseSetHorizRange(34 * 8, 34 * 8)
  CALL MouseSetVertRange(10 * 8, 13 * 8)
  CALL MouseSetPosn(34 * 8, 10 * 8)
  DO
    CALL MouseGetStatus(L, R, M, H, V)
    Sel = V \ 8 - 9
    Hit = L OR R OR M
    K$ = INKEY$
    IF LEN(K$) THEN
      SELECT CASE K$
        CASE CHR$(27)             'Esc
          EXIT SUB
        CASE CHR$(0) + CHR$(72)   'Up arrow
          IF Sel > 1 THEN Sel = Sel - 1
        CASE CHR$(0) + CHR$(80)   'Dn arrow
          IF Sel < 4 THEN Sel = Sel + 1
        CASE CHR$(13)
          Hit = -1
      END SELECT
    END IF
    IF Sel <> OldSel THEN
      COLOR 7, 0
      LOCATE 10 + OldSel, 35
      PRINT "Select "; CH$(OldSel);
      COLOR 0, 7
      LOCATE 10 + Sel, 35
      PRINT "Select "; CH$(Sel);
      OldSel = Sel
      IF Sel <> V \ 8 - 9 THEN
        CALL MouseSetPosn(34 * 8, (Sel + 9) * 8)
      END IF
    END IF
    IF Hit THEN
    COLOR 7, 0
    LOCATE 25, 1
    PRINT USING "Selected &"; CH$(Sel);
    Hit = 0
  END IF
LOOP
END SUB

SUB MouseCall
'*
'* Call mouse using current values in MReg registers
'*
  DEF SEG = VARSEG(MouseRoutine%(0))
  Addr% = VARPTR(MouseRoutine%(0))
  CALL Absolute(MReg, Addr%)
  DEF SEG
END SUB

SUB MouseGetPressInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)
'*
'* Gets info about last mouse click
'* Set LBtn%, RBtn%, or MBtn% <> 0 for button to query
'* LBtn%, RBtn%, or MBtn% return 1 to show which
'* button is currently down or 0 to show which button
'* is currently up
'* Count% has count of clicks since last call
'* HPosn% and VPosn% are horizontal and vertical position
'* of cursor at last click
'*
  IF MouseReady% THEN
    IF (LBtn% OR RBtn% OR MBtn%) <> 0 THEN
      MReg.AX = 5
      IF LBtn% THEN MReg.BX = 0
      IF RBtn% THEN MReg.BX = 1
      IF MBtn% THEN MReg.BX = 2
      MouseCall
      LBtn% = MReg.AX AND 1
      RBtn% = (MReg.AX AND 2) \ 2
      MBtn% = (MReg.AX AND 4) \ 4
      Count% = MReg.BX
      HPosn% = MReg.CX
      VPosn% = MReg.DX
    ELSE
      CALL MouseGetStatus(LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)
      Count% = 0
    END IF
  ELSE
    LBtn% = 0: RBtn% = 0: MBtn% = 0
    Count% = 0
    HPosn% = -1: VPosn% = -1
  END IF
END SUB

SUB MouseGetReleaseInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)
'*
'* Gets info about last mouse release
'* Set LBtn%, RBtn%, or MBtn% <> 0 for button query
'* LBtn%, RBtn%, or MBtn% return 1 to show which
'* button is currently down or 0 to show which
'* button is currently up
'* Count% has count of releases since last call
'* HPosn% and VPosn% are horizontal and vertical position
'* of cursor at last release
'*
  IF MouseReady% THEN
    IF (LBtn% OR RBtn% OR MBtn%) <> 0 THEN
      MReg.AX = 6
      IF LBtn% THEN MReg.BX = 0
      IF RBtn% THEN MReg.BX = 1
      IF MBtn% THEN MReg.BX = 2
      MouseCall
      LBtn% = MReg.AX AND 1
      RBtn% = (MReg.AX AND 2) \ 2
      MBtn% = (MReg.AX AND 4) \ 4
      Count% = MReg.BX
      HPosn% = MReg.CX
      VPosn% = MReg.DX
    ELSE
      CALL MouseGetStatus(LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)
      Count% = 0
    END IF
  ELSE
    LBtn% = 0: RBtn% = 0: MBtn% = 0
    Count% = 0
    HPosn% = -1: VPosn% = -1
  END IF
END SUB

SUB MouseGetStatus (LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)
'*
'* Gets current mouse status
'* LBtn%, RBtn%, and MBtn% return
'* 1 if button is down or 0 if button is up
'* HPosn% returns horizontal position
'* VPosn% returns vertical position
'*
  IF MouseReady% THEN
    MReg.AX = 3
    MouseCall
    LBtn% = MReg.BX AND 1
    RBtn% = (MReg.BX AND 2) \ 2
    MBtn% = (MReg.BX AND 4) \ 4
    HPosn% = MReg.CX
    VPosn% = MReg.DX
  ELSE
    LBtn% = 0: RBtn% = 0: MBtn% = 0
    HPosn% = -1: VPosn% = -1
  END IF
END SUB

SUB MouseHide
'*
'* Hide the mouse cursor
'* Decrement the mouse cursor flag
'* Cursor hidden if flag <> 0
'* MouseInit sets flag to -1
'*
  IF MouseReady% THEN
    MReg.AX = 2
    MouseCall
  END IF
END SUB

FUNCTION MouseInit%
'*
'* Initialize mouse and return
'* number of buttons
'* Return 0 if mouse driver
'* unavailable or mouse not
'* present
'*
  DEF SEG = 0
  Sum% = 0
  FOR I% = &H33 * 4 TO &H33 * 4 + 3
    Sum% = Sum% + PEEK(I%)
  NEXT I%
  IF Sum% = 0 THEN
    MouseInit% = 0
    EXIT FUNCTION
  END IF
  MReg.AX = 0
  MouseCall
  IF MReg.AX = 0 THEN
    MouseInit% = 0
  ELSE
    MouseInit% = MReg.BX
  END IF
END FUNCTION

SUB MouseReadCounters (HCount%, VCount%)
'*
'* Returns mouse movement relative to
'* the last time this function was called
'* Measurements are in "mickeys". By default,
'* 1 mickey = 1 pixel horizontally and
'* 2 mickeys = 1 pixel vertically
'*
  IF MouseReady% THEN
    MReg.AX = 11
    MouseCall
    HCount% = MReg.CX
    VCount% = MReg.DX
  END IF
END SUB

SUB MouseSetHorizRange (HMin%, HMax%)
'*
'* Sets the minimum and maximum horizontal
'* range of the mouse cursor.
'* Moves the cursor inside the range if it's
'* outside.
'*
  IF MouseReady% THEN
    MReg.AX = 7
    MReg.CX = HMin%
    MReg.DX = HMax%
    MouseCall
  END IF
END SUB

SUB MouseSetPosn (HPosn%, VPosn%)
'*
'* Sets mouse cursor to HPosn and VPosn
'*
  IF MouseReady% THEN
    MReg.AX = 4
    MReg.CX = HPosn%
    MReg.DX = VPosn%
    MouseCall
  END IF
END SUB

SUB MouseSetup
'*
'* Setup to use mouse
'* MUST be called before
'* MouseInit or any other
'* mouse calls
'*
  RESTORE MouseInt
  DEF SEG = VARSEG(MouseRoutine%(0))
  Addr% = VARPTR(MouseRoutine%(0))
  FOR I = 0 TO 39
    READ A$
    POKE Addr% + I, VAL("&H" + A$)
  NEXT I
  IF A$ <> "CB" THEN ERROR 255
  DEF SEG
END SUB

SUB MouseSetVertRange (VMin%, VMax%)
'*
'* Sets the minimum and maximum vertical
'* range of the mouse cursor
'* Moves the cursor inside the range if it's
'* outside
  IF MouseReady% THEN
    MReg.AX = 8
    MReg.CX = VMin%
    MReg.DX = VMax%
    MouseCall
  END IF
END SUB

SUB MouseShow
'*
'* Display the mouse cursor
'* Increments mouse cursor flag
'* Cursor is displayed if flag is 0
'* MouseInit sets flag to -1
'*
  IF MouseReady% THEN
    MReg.AX = 1
    MouseCall
  END IF
END SUB