'(C) 1997 BriTech International / Hamster Republic Productions
'$DYNAMIC
DEFINT A-Z
'Basic Sub
DECLARE SUB drawkey (i, p, x(), which(), pag)
'General Mode-X Stuff
DECLARE SUB setmodex ()
DECLARE SUB copypage (BYVAL page1, BYVAL page2)
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB clearpage (BYVAL page)
'Page stuff
DECLARE SUB setdiskpages (buf(), BYVAL l, BYVAL b)
DECLARE SUB storepage (fil$, BYVAL i, BYVAL p)
DECLARE SUB loadpage (fil$, BYVAL i, BYVAL p)
DECLARE SUB bitmap2page (temp(), bmp$, BYVAL p)
'Mode-X Boxes N Pixels
DECLARE SUB rectangle (BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL c, BYVAL p)
DECLARE SUB putpixel (BYVAL x, BYVAL y, BYVAL c, BYVAL p)
DECLARE FUNCTION readpixel (BYVAL x, BYVAL y, BYVAL p)
'Palette stuff
DECLARE SUB fadeto (palbuff(), BYVAL red, BYVAL green, BYVAL blue)
DECLARE SUB fadetopal (pal(), palbuff())
DECLARE SUB setpal (pal())
'Mode-X Text
DECLARE SUB setfont (f())
DECLARE SUB printstr (s$, BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB textcolor (BYVAL f, BYVAL b)
DIM font(1024), master(767), buf(16384), timing(1), mouse(4), song(8000)
DIM inst$(127), note(8), value(9), x(12), which(12)
DIM keymap(127), keyson(127), skey$(55)

setdiskpages buf(), 200, 0
setmodex
DEF SEG = VARSEG(font(0)): BLOAD "bobtext.fnt", VARPTR(font(0))
setfont font()
DEF SEG = VARSEG(master(0)): BLOAD "palette.sto", VARPTR(master(0))
setpal master()

rectangle 6, 3, 12, 8, 15, 0
FOR i = 0 TO 15: FOR j = 0 TO 15
rectangle i * 20 + 8, j * 12 + 4, 8, 6, i + j * 16, 0
NEXT: NEXT
x = 0: y = 0
a$ = ""
WHILE a$ <> CHR$(27)
a$ = INKEY$
IF a$ = " " THEN FOR i = 0 TO 2: master((x + y * 16) * 3 + i) = 0: NEXT i: setpal master()
IF a$ = "l" THEN FOR i = 0 TO 44: master(y * 48 + i) = o: NEXT i: setpal master()
IF a$ = CHR$(0) + CHR$(75) THEN
 GOSUB undraw
 x = x - 1: IF x < 0 THEN x = 15
 GOSUB redraw
END IF
IF a$ = CHR$(0) + CHR$(77) THEN
 GOSUB undraw
 x = x + 1: IF x > 15 THEN x = 0
 GOSUB redraw
END IF
IF a$ = CHR$(0) + CHR$(72) THEN
 GOSUB undraw
 y = y - 1: IF y < 0 THEN y = 15
 GOSUB redraw
END IF
IF a$ = CHR$(0) + CHR$(80) THEN
 GOSUB undraw
 y = y + 1: IF y > 15 THEN y = 0
 GOSUB redraw
END IF
WEND

bitmap2page master(), "piano.bmp" + CHR$(0), 0
storepage "piano.pic" + CHR$(0), 0, 0
SYSTEM

undraw:
 rectangle x * 20 + 6, y * 12 + 3, 12, 8, 0, 0
 rectangle x * 20 + 8, y * 12 + 4, 8, 6, x + y * 16, 0
RETURN
redraw:
 rectangle x * 20 + 6, y * 12 + 3, 12, 8, 15, 0
 rectangle x * 20 + 8, y * 12 + 4, 8, 6, x + y * 16, 0
RETURN

REM $STATIC
SUB drawkey (i, p, x(), which(), pag)
oct = INT(i / 12)
koff = i - oct * 12
temp = which(koff)
IF p = 0 THEN c = 15 ELSE c = 111
IF temp = 3 THEN
 IF p = 0 THEN c = 8 ELSE c = 245
 rectangle x(koff) + 56 * (oct - 2) - 18, 80, 4, 27, c, pag
ELSE
 rectangle x(koff) + 56 * (oct - 2) - 19, 108, 7, 14, c, pag
 IF temp = 0 THEN
  rectangle x(koff) + 56 * (oct - 2) - 19, 80, 5, 28, c, pag
 END IF
 IF temp = 1 THEN
  rectangle x(koff) + 56 * (oct - 2) - 16, 80, 4, 28, c, pag
 END IF
 IF temp = 2 THEN
  rectangle x(koff) + 56 * (oct - 2) - 16, 80, 2, 28, c, pag
 END IF
END IF

END SUB