' Mouse routine for QuickBasic

DEFINT A-Z
DECLARE SUB Mouse (mx, my, butt)
DECLARE SUB MousePointer (SW)

'======================
'   Init mouse code
'======================
DIM SHARED A(9)                 'Set up array for code
DEF SEG = VARSEG(A(0))          'Get array segment (nnnn:    )
                                '    (two 8 bit)
FOR i = 0 TO 17                 'length of DATA to read
  READ r
  POKE VARPTR(A(0)) + i, r     'into array/2 (nnnn:iiii) (one 8 bit)
NEXT i                          'until 17

DATA &HB8,&H00,&H00   :   ' mov  AX,[n]       [Swap code-(L),(H)] in AX
DATA &H55             :   ' push BP           Save BP
DATA &H8B,&HEC        :   ' mov  BP,SP        Get BP to c Seg
DATA &HCD,&H33        :   ' int  33           Interrupt 33
DATA &H92             :   ' xchg AX,[reg]     [Swap code-reg] in AX
DATA &H8B,&H5E,&H06   :   ' mov  BX,[BP+6]    Point to (variable)
DATA &H89,&H07        :   ' mov  [BX],AX      Put AX in (variable)
DATA &H5D             :   ' pop  BP           Restore BP
DATA &HCA,&H02,&H00   :   ' ret  2            Far return

'======================
'  648x480 display
'======================
SCREEN 12

'============================
'  Put Mouse Arrow on screen
'============================
CALL MousePointer(0)      'Reset mouse
CALL MousePointer(1)      'turn pointer on
CALL MousePointer(3)      'Get coordinates

'======================
'     Main Loop
'======================
DO WHILE INKEY$ <> CHR$(27)
  ox = mx: oy = my              'store current mouse x/y pos for smoothing
  CALL Mouse(mx, my, butt)      'get mouse x/y pos & button status
  WAIT &H3DA, 8
  LOCATE 1, 1
  PRINT "Mouse Values: X="; mx; " Y="; my; "Button="; butt; "      "
  PRINT : PRINT "Press mousebuttons to draw"
  mx = (mx - ox) / 4 + ox       'smooth out the x movement
  my = (my - oy) / 4 + oy       'smooth out the y movement
  IF butt <> 0 THEN
    CALL MousePointer(2)        'mouse pointer OFF
    SELECT CASE butt
      CASE 1: CIRCLE (mx, my), 9, 6
      CASE 2: CIRCLE (mx, my), 7, 13
      CASE 3: LINE (mx - 10, my - 10)-(mx + 10, my + 10), 0, BF
      CASE 4: CIRCLE (mx, my), 4, 11
    END SELECT
    CALL MousePointer(1)        'turn mouse pointer ON
    CALL MousePointer(3)        'update mouse coords
    WAIT &H3DA, 8
  END IF
LOOP
END

SUB Mouse (mx, my, butt)
POKE VARPTR(A(4)), &H92               'Swap code,Get MouseY setup
CALL absolute(my, VARPTR(A(0)))       'Run Code
POKE VARPTR(A(4)), &H91               'Swap code,Get MouseX setup
CALL absolute(mx, VARPTR(A(0)))       'Run Code
POKE VARPTR(A(4)), &H93               'Swap code,Get Button setup
CALL absolute(butt, VARPTR(A(0)))     'Run Code
END SUB

SUB MousePointer (SW)
POKE VARPTR(A(0)) + 1, SW         'Swap code,Set AX = (SW)
CALL absolute(c, VARPTR(A(0)))    'Run Code
'
'  SW Value     Mouse Effect
' =============================
'       0       Reset
'       1       Pointer On
'       2       Pointer Off
'       3       Coordinates
END SUB