' Mouse demo
' made by Svjatoslav Agejenko
' in 2004.01
' Homepage: http://svjatoslav.eu
 
DECLARE SUB mousedemo ()
DECLARE SUB putword (addr!, dat!)
DECLARE FUNCTION getword! (addr!)
DECLARE FUNCTION getbyte! (addr!)
DECLARE SUB start ()

DIM SHARED extSEG, extADDR

start


mousedemo

FUNCTION getbyte (addr)
getbyte = PEEK(extADDR + addr)
END FUNCTION

FUNCTION getword (addr)
a = PEEK(extADDR + addr)
b = PEEK(extADDR + addr + 1)


c$ = HEX$(a)
IF LEN(c$) = 1 THEN c$ = "0" + c$
IF LEN(c$) = 0 THEN c$ = "00"


c = VAL("&H" + HEX$(b) + c$)

getword = c
END FUNCTION

SUB mousedemo



cx = 150
cy = 100
maxmove = 50
1
frm = frm + 1


LOCATE 1, 1
PRINT cx, cy
PRINT frm

CIRCLE (cx, cy), 10, 0
xp = getword(2)
putword 2, 0
yp = getword(4)
putword 4, 0

butt = getword(6)
putword 6, 0

IF butt <> 0 THEN
LOCATE 5
PRINT butt
END IF

IF xp < -maxmove THEN xp = -maxmove
IF xp > maxmove THEN xp = maxmove
cx = cx + xp

IF yp < -maxmove THEN yp = -maxmove
IF yp > maxmove THEN yp = maxmove
cy = cy + yp


CIRCLE (cx, cy), 10, 10



SOUND 0, .05
GOTO 1


END SUB

SUB putword (addr, dat)

b$ = HEX$(dat)

2
IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2

n1 = VAL("&H" + LEFT$(b$, 2))
n2 = VAL("&H" + RIGHT$(b$, 2))


POKE (extADDR + addr), n2
POKE (extADDR + addr + 1), n1

END SUB

SUB start
SCREEN 13

DEF SEG = 0     ' read first from interrupt table

extSEG = PEEK(&H79 * 4 + 3) * 256
extSEG = extSEG + PEEK(&H79 * 4 + 2)

PRINT "Segment is: " + HEX$(extSEG)

extADDR = PEEK(&H79 * 4 + 1) * 256
extADDR = extADDR + PEEK(&H79 * 4 + 0)

PRINT "relative address is:"; extADDR

DEF SEG = extSEG

IF getword(0) <> 1983 THEN
  PRINT "FATAL ERROR:  you must load"
  PRINT "QBasic extension TSR first!"
  SYSTEM
END IF

END SUB