DEFINT A
-Z
' Mar94, with minor updates for QB64 xc = 320: yc = 240 ' center
xs = 56: ys = 56 ' marble placement
b = 63: g = 63: r = 63
b = 10: g = 63: r = 10
b = 23: g = 0: r = 43
p&
= CDBL(b
) * 65536 + CDBL(g
) * 256 + r
r
= r
- 4:
IF r
< 0 THEN r
= 0 b
= b
+ 4:
IF b
> 63 THEN b
= 63x1 = xc - 4 * xs: x2 = xc + 4 * xs: y1 = yc - 4 * ys: y2 = yc + 4 * ys
LINE (x1
- q
, y1
+ q
)-(x2
+ q
, y2
- q
), 8 + q
, B
m$ = "0011100001110011111111112111111111100111000011100"
begin:
board
(x
, y
) = VAL(MID$(m$
, (y
- 1) * 7 + x
, 1)) IF board
(x
, y
) = 2 THEN board
(x
, y
) = 0 x = 4: y = 2 ' initial cursor
Moving = 1 ' 1 cursor, 2 piece
gone = 0
cc
= Moving:
GOSUB plot
' cc = cursor color cc
= 10:
GOSUB plot: cc
= 0 ' erase cursor xd = 0: yd = 0 ' direction
xd = ((a$ = "K") - (a$ = "M")) * Moving ' left / right
yd = ((a$ = "H") - (a$ = "P")) * Moving ' up / down
sx = x: x = x + xd
sy = y: y = y + yd
IF (x
< 1) OR (y
< 1) OR (x
> 7) OR (y
> 7) THEN x
= sx: y
= sy
IF MID$(m$
, (y
- 1) * 7 + x
, 1) = "0" THEN x
= sx: y
= sy
IF board
(x
, y
) = 1 THEN Moving
= 2 ' toggle to moving piece Moving = 1 ' toggle back to cursor
MoveError = 0 ' assume no error
IF board
(sx
, sy
) = 0 THEN MoveError
= 1 ' no ball to move IF board
(x
, y
) = 1 THEN MoveError
= 2 ' target space not blank dx
= SGN(x
- sx
) ' direction x IF board
(sx
+ dx
, sy
+ dy
) = 0 THEN MoveError
= 3 ' no capture IF MoveError
THEN ' got an error SOUND 200, 3 ' error beep x = sx: y = sy ' restore xy pos
gone = gone + 1
board
(x
, y
) = 1:
GOSUB plot
' to x
= sx: y
= sy: board
(x
, y
) = 0:
GOSUB plot
' from x
= sx
+ dx: y
= sy
+ dy: board
(x
, y
) = 0:
GOSUB plot
' jumped x = x + dx: y = y + dy ' cursor to "to"
plot:
px = xc + (x - 4) * xs
py = yc + (y - 4) * ys
PAINT (px
, py
), 0 ' erase this space IF board
(x
, y
) THEN ' is a marble s = 16 - c ' size
px
= px
+ (c
MOD 2) * zx
' move center