Wand

I decided to post this here, but you might have already seen it. It's simple, but fun.

Controls: move the mouse and hold one of the mouse buttons down | [Q] - Quit

'\ITECH\GAMES\WAND\WAND
' Wand! Version 1.0
' (C) 2006 i-TECHand King Kristopher

'Mouse Subs, Variables, and Data
DECLARE SUB MouseDriver (ax AS INTEGER, bx AS INTEGER, cx AS INTEGER, dx AS INTEGER)
DECLARE FUNCTION MouseExists% ()
DECLARE SUB MouseShow ()
DECLARE SUB MouseHide ()
DECLARE SUB MouseStatus (mouseX, mouseY, leftB, rightB, middleB)
DECLARE SUB MousePosition (newX, newY)
DECLARE SUB MouseSetArea (x1, y1, x2, y2)
DECLARE SUB MouseLastPress (button, x, y)
CONST TRUE = -1: CONST FALSE = 0: CONST LEFT = 0: CONST RIGHT = 1: CONST CENTER = 2
MouseData:
DATA 55,89,E5,8B,76,06,8B,14,8B,76,08,8B,0C,8B,76,0A
DATA 8B,1C,8B,76,0C,8B,04,1E,07,CD,33,8B,76,06,89,14
DATA 8B,76,08,89,0C,8B,76,0A,89,1C,8B,76,0C,89,04,5D
DATA CA,08,00
MouseSetArea 15, 15, 624, 464

'main setup
SCREEN 12: CLS : RANDOMIZE TIMER: time = TIMER
MouseStatus x, y, lb, rb, 0: MouseHide
l = x: w = y: fps = 30: bcount = 400
framecount = 0: lv = 0: wv = 0: whichb = 1: pi = 3.1415926535898#

'arrays
DIM b(1 TO bcount, 1 TO 5)'x, y, angle, distance, color
FOR a = 1 TO bcount
b(a, 1) = 0: b(a, 2) = 0: b(a, 3) = 0: b(a, 4) = 0: b(a, 5) = INT(RND * 6) + 1
NEXT a

WHILE key$ <> CHR$(27) AND key$ <> "q"

'make new bullet
IF INT(framecount / 2) = framecount / 2 THEN
CIRCLE (b(whichb, 1) + b(whichb, 4) * COS(b(whichb, 3) * pi), b(whichb, 2) + b(whichb, 4) * SIN(b(whichb, 3) * pi)), 2, 0
b(whichb, 1) = l
b(whichb, 2) = w
b(whichb, 3) = radian
b(whichb, 4) = 1
whichb = whichb + 1: IF whichb > bcount THEN whichb = 1
END IF

'move wand
CIRCLE (x, y), 10, 0: LINE (x, y)-(l, w), 0
MouseStatus x, y, lb, rb, 0
IF x > l THEN lv = lv + 2
IF x < l THEN lv = lv - 2
IF y > w THEN wv = wv + 2
IF y < w THEN wv = wv - 2
IF ABS(l - x) < ABS(l + lv - x) THEN l = l + lv / 5
IF ABS(l - x) > ABS(l + lv - x) THEN l = l + lv
IF ABS(w - y) < ABS(w + wv - y) THEN w = w + wv / 5
IF ABS(w - y) > ABS(w + wv - y) THEN w = w + wv
CIRCLE (x, y), 10, 8: LINE (x, y)-(l, w), 2

'move bullets
FOR a = INT(RND * 4) + 1 TO bcount STEP 4
CIRCLE (b(a, 1) + b(a, 4) * COS(b(a, 3) * pi), b(a, 2) + b(a, 4) * SIN(b(a, 3) * pi)), 2, 0
b(a, 4) = b(a, 4) + 1
CIRCLE (b(a, 1) + b(a, 4) * COS(b(a, 3) * pi), b(a, 2) + b(a, 4) * SIN(b(a, 3) * pi)), 2, b(a, 5)
NEXT a

IF lb = TRUE THEN radian = radian + .03
IF rb = TRUE THEN radian = radian - .03
framecount = framecount + 1': WHILE time + framecount / fps > TIMER: WEND

key$ = INKEY$
WEND

SUB MouseDriver (ax AS INTEGER, bx AS INTEGER, cx AS INTEGER, dx AS INTEGER)
STATIC called AS INTEGER, mouseDrv AS STRING
DIM mCount AS INTEGER, mData AS STRING

IF NOT called THEN 'the first time this sub is called, there is some
called = TRUE 'initialization that needs to be done
RESTORE MouseData

FOR mCount = 1 TO 51
READ mData
mouseDrv = mouseDrv + CHR$(VAL("&H" + mData))
NEXT mCount

'checks for mouse driver
IF NOT MouseExists THEN PRINT "No Mouse Driver": END
END IF

DEF SEG = VARSEG(mouseDrv)
CALL ABSOLUTE(ax, bx, cx, dx, SADD(mouseDrv))
DEF SEG
END SUB

FUNCTION MouseExists%
DIM ax AS INTEGER
ax = 0
MouseDriver ax, 0, 0, 0

MouseExists% = ax
END FUNCTION

SUB MouseHide
MouseDriver 2, 0, 0, 0
END SUB

SUB MouseLastPress (button, x, y)
DIM bx AS INTEGER, cx AS INTEGER, dx AS INTEGER

IF button <> LEFT AND button <> RIGHT AND button <> MIDDLE THEN
x = -1
y = -1 'if you passed an invalid parameter
EXIT SUB
END IF

bx = button
MouseDriver 5, bx, cx, dx

IF bx = 0 THEN 'if the button hasn't been pressed
x = -1
y = -1
ELSE
x = cx
y = dx
END IF

END SUB

SUB MousePosition (newX, newY)
DIM cx AS INTEGER, dx AS INTEGER

cx = newX
dx = newY
MouseDriver 4, 0, cx, dx
END SUB

SUB MouseSetArea (x1, y1, x2, y2)
DIM cx AS INTEGER, dx AS INTEGER

cx = x1 'set horizontal range
dx = x2
MouseDriver 7, 0, cx, dx

cx = y1 'set vertical range
dx = y2
MouseDriver 8, 0, cx, dx
END SUB

SUB MouseShow
MouseDriver 1, 0, 0, 0
END SUB

SUB MouseStatus (mouseX, mouseY, leftB, rightB, middleB)
DIM bx AS INTEGER, cx AS INTEGER, dx AS INTEGER

MouseDriver 3, bx, cx, dx

'the bits in bx contain the button status
'bit 0 = left; bit 1 = right; bit 2 = middle
IF (bx AND 1) THEN leftB = TRUE ELSE leftB = FALSE
IF (bx AND 2) THEN rightB = TRUE ELSE rightB = FALSE
IF (bx AND 4) THEN middleB = TRUE ELSE middleB = FALSE

mouseX = cx
mouseY = dx
END SUB