04-21-2005, 08:49 PM
Next in the series: "from the vaults - now updated for freeBasic".
This is nofrills ballistics code made into a simple arcade typo'game,
originally designed for interpreted basic on a 25 Mhz machine.
Note the absence of fancy graphics and trigonometric function calls.
Keep the ball flying by kicking it with the bottom bouncers. You'll
score 1 point for hitting the central ellipse and 3 points for each
top bumper. The ball's lost if it comes to a halt or drops into one
of the nasty lil'holes next to the bouncers. One game lasts 3 balls.
You both trigger the kickers and shut the holes with the [Shift] keys.
File "BumpBall.bas"
A few hints for tuning the game:
The first three parameters mass, resistance and gravitational force
are interdependent, it might take some trial & error to get them right.
The heavier the projectile, the less impact the bouncers will have.
The speed of your box determines how much deceleration you'll need
along the trajectory, apply gravity to vary its height and range.
The fourth parameter sets the launching speed, the fifth the time
the kickers will sustain their impulse power, the last the game's
tolerance against prolonged key pushing.
File "BumpBall.ini"
The above values should be fine for a 700 Mhz machine.
Enjoy!
This is nofrills ballistics code made into a simple arcade typo'game,
originally designed for interpreted basic on a 25 Mhz machine.
Note the absence of fancy graphics and trigonometric function calls.
Keep the ball flying by kicking it with the bottom bouncers. You'll
score 1 point for hitting the central ellipse and 3 points for each
top bumper. The ball's lost if it comes to a halt or drops into one
of the nasty lil'holes next to the bouncers. One game lasts 3 balls.
You both trigger the kickers and shut the holes with the [Shift] keys.
File "BumpBall.bas"
Code:
'Subject: The classic bumperball game
'Keys : L & R [Shift], [Space] to shake, [Esc] to quit
'Author : vspickelen
'Date : 20-09-2005
'Code : FreeBasic 0.12b w/gfxlib
DEFSNG A-J, L-M, O-Z
DEFINT K-K, N-N
DECLARE SUB Bumpr (k, n, kl)
DIM SHARED wp AS INTEGER
DIM SHARED xc(5), yc(5), x1(2), x2(2) 'positions
DIM SHARED a(2), q(2)
DIM a2(2), b2(2), ba(2), p(7) ' measures
DIM fl AS INTEGER, sw AS INTEGER ' switches
DIM sp AS INTEGER, ex AS INTEGER
DIM pnt AS INTEGER, mpt AS INTEGER
DIM game AS INTEGER, bc(2) AS STRING
DIM co(1) AS STRING * 11, ps AS STRING * 11
CONST xm = 319.5, ym = 239.5 ' center screen
CONST bal = "s4br4bud2blbd2u6bld6bgu8bld8blu8bgd6blu6blbd2d2"
OPEN CURDIR$ + "\bumpball.ini" FOR INPUT AS #1
INPUT #1, ms, rs, gv ' mass, resistance, gravity
INPUT #1, vo, at, pl ' launching speed, active time, penalty level
CLOSE
bc(0) = "c9": bc(1) = "c14": bc(2) = "c12" 'ball-
lag = 500: k0 = 8: kf = 7: kb = 0 ' pause, neutral/fore/back color
dx = 2: dy = 2: sb = 4
xr = xm - dx: yr = ym - dy ' bumper centres:
xc(1) = xm + xr: yc(1) = ym + yr ' bottom right
xc(2) = dx: yc(2) = ym + yr ' bottom left
xc(3) = dx: yc(3) = dy ' top left
xc(4) = xm + xr: yc(4) = dy ' top right
xc(5) = xm: yc(5) = ym ' ellipse
p(1) = -.3: p(2) = -.3 ' bumper impulse adjustment
p(3) = .2: p(4) = .2 '
p(5) = .2: p(6) = -.17: p(7) = 1.2 ' for ellipse, frame, bouncers
min = vo * .0009 ' minimal movement
rs = 1 - rs / 4000 ' calibrate input
gv = gv / 2000
'
a(1) = 209.3: q(1) = .27 ' bumper axis/aspect
a(2) = 76: q(2) = 1.1 ' ellipse axis/aspect
FOR n = 2 TO 1 STEP -1
c = a(n): b = q(n) * c
b2(n) = b * b: a2(n) = c * c
ba(n) = b2(n) * a2(n)
q(0) = q(n): q(n) = (b - sb) / (c - sb)
IF q(n) > 1 THEN SWAP b, c
a(0) = c: a(n) = c - sb
NEXT n
'
flr = 92 ' bouncerfloor width
x1(1) = xm + flr - dx: x2(1) = 2 * xm - a(0) - dx
x1(2) = a(0) + dx: x2(2) = xm - flr + dx ' hole shutters
RANDOMIZE TIMER: game = 2: mpt = 0
SCREEN 12, 4, 2, 1
'
begin:
wp = wp XOR 1
SCREENSET wp, wp XOR 1
game = (game + 1) MOD 3
SLEEP lag: IF game = 0 THEN SLEEP lag 'countdown...
fl = 0: sw = 0: sp = -1: ex = 0 ' reset
CLS : COLOR kf, kb: tl = 0
FOR k = 1 TO 4 ' draw bumpers
CIRCLE (xc(k), yc(k)), a(1), k0, , , q(1), F
NEXT k
CIRCLE (xc(5), yc(5)), a(2), k0, , , q(2), F
x = xm: y = yc(1) ' random launch
co(0) = "bm" + STR$(CINT(x)) + "," + STR$(CINT(y))
co(1) = co(0)
cs = SGN(RND - .5) * (.5 + .15 * RND)
vx = vo * cs: vy = -vo * SQR(1 - cs * cs)
IF game = 0 THEN
IF pnt > mpt THEN mpt = pnt ' maxscore
pnt = 0
END IF
GOSUB prnt
SCREENCOPY wp, wp XOR 1
DO
wp = wp XOR 1
SCREENSET wp, wp XOR 1
vx = vx * rs
vy = vy * rs + gv ' deceleration & vertical drop
x = x + vx: y = y + vy ' update trajectories
u = ABS(x - xm): u0 = u - xr
v = ABS(y - ym): v0 = v - yr
t = b2(1) * u0 * u0 + a2(1) * v0 * v0
IF t < ba(1) THEN
IF y > ym THEN
k = 2 + (x > xm) ' ball on kickers
IF k - fl = 0 THEN SWAP p(k), p(7) 'power push
ELSE
k = 4 + (x < xm) ' ball on top bumps
pnt = pnt + 3: GOSUB prnt
END IF
IF sw = 0 AND fl = 0 THEN
Bumpr k, 1, kf ' hit ring
sw = k: ring = TIMER
END IF
GOSUB insect
GOSUB push
IF k - fl = 0 THEN SWAP p(k), p(7)
ELSE
IF u0 > 0 OR v0 > 0 THEN
'intersection trajectory-frame
vx. = -vx: vy. = -vy
IF u0 > 0 THEN
cs = 0: sn = SGN(x - xm)
xs = xc(2 - sn)
ys = y + (xs - x) * vy. / vx.
dv = ABS((xs - x) / vx.)
ELSE
cs = SGN(ym - y): sn = 0
ys = yc(2 + cs)
xs = x + (ys - y) * vx. / vy.
dv = ABS((ys - y) / vy.)
END IF
IF y > yc(1) THEN
IF ABS(xs - xm) > flr THEN
k = 2 + (xs > xm) ' ball in gaps?
IF (k - fl) <> 0 THEN ex = -1
END IF
END IF
k = 6: GOSUB push
IF y >= yc(1) THEN ' motion damped?
v = vx * vx + vy * vy
IF v < min THEN ex = -1
END IF
ELSE
t = b2(2) * u * u + a2(2) * v * v
IF t < ba(2) THEN
k = 5 ' ball on central ellipse
pnt = pnt + 1: GOSUB prnt
IF sw = 0 THEN
Bumpr k, 2, kf ' hit ring
sw = k: ring = TIMER
END IF
GOSUB insect
GOSUB push
END IF
END IF
END IF
'
DRAW co(wp) + "c0" + bal
IF ex THEN GOTO begin
ps = "bm" + STR$(CINT(x)) + "," + STR$(CINT(y))
DRAW ps + bc(game) + bal: co(wp) = ps
'
IF sw > 0 THEN
IF TIMER - ring > .1 THEN
n = 2 + (sw < 5)
Bumpr sw, n, k0 ' erase hit ring
sw = 0
END IF
END IF
IF fl = 0 THEN
nl = MULTIKEY(42) ' left [Shift]
nr = MULTIKEY(54) ' right [Shift]
IF nl OR nr THEN
fl = 2 + nr: tl = tl + 1
Bumpr fl, 0, kf ' bouncing ring & shutter
tim = TIMER ' kick alert
END IF
IF sp THEN
sp = 0
IF MULTIKEY(57) THEN ' [Space]
tl = tl + 2
cs = (RND - .5) * .2
sn = SQR(1 - cs * cs) ' random shake
vx = vx + cs * vo * .5
vy = vy - sn * vo * .5
END IF
END IF
ELSE
IF TIMER - tim > at THEN
Bumpr fl, 0, kb ' erase bouncing ring
fl = 0
END IF
END IF
WHILE INKEY$ <> "": sp = -1: WEND
LOOP UNTIL MULTIKEY(1)
END
insect:
n = 2 + (k < 5)
IF ABS(vx) < 1E-19 THEN
vx = SGN((x > xm) + .5) * min
END IF
'intersection trajectory-ellips
vx. = -vx: vy. = -vy: h = vy. / vx.
t = y - yc(k) - h * (x - xc(k))
de = a2(n) * h * h + b2(n)
di = SQR(ba(n) * ABS(de - t * t))
u = (-a2(n) * h * t + SGN(vx.) * di) / de
v = (b2(n) * t + SGN(vx.) * h * di) / de
xs = xc(k) + u: ys = yc(k) + v
dv = ABS((xs - x) / vx.)
dx = a2(n) * v: dy = -b2(n) * u ' tangent
h = SQR(dx * dx + dy * dy)
cs = dx / h: sn = dy / h
RETURN
push:
vx = -(vx. * cs + vy. * sn) ' rotate axes
vy = -vx. * sn + vy. * cs
vx. = vx: vy. = vy: v = vy
vy. = vy. + SGN(vy.) * p(k) / ms ' kick ball
IF SGN(v) <> SGN(vy.) THEN vy. = 0
vx = vx. * cs - vy. * sn
vy = vx. * sn + vy. * cs
x = xs + dv * vx
y = ys + dv * vy
IF TIMER - tkey > 1 THEN
IF tl >= pl THEN ' push buffer filled
FOR n = 1 TO 4
Bumpr n, 1, kf
NEXT n: ex = -1
Bumpr 5, 2, kf
END IF
tl = 0: tkey = TIMER
END IF
RETURN
prnt:
SCREENSET wp XOR 1, wp XOR 1
COLOR kf, kb: LOCATE 1, 3: PRINT pnt
LOCATE 1, 76: PRINT mpt;
SCREENSET wp, wp XOR 1
COLOR kf, kb: LOCATE 1, 3: PRINT pnt
LOCATE 1, 76: PRINT mpt;
RETURN
SUB Bumpr (k, n, kl)
h = ym + ym
SCREENSET wp XOR 1, wp XOR 1
CIRCLE (xc(k), yc(k)), a(n), kl, , , q(n)
IF n = 0 THEN LINE (x1(k), h)-(x2(k), h), kl
SCREENSET wp, wp XOR 1
CIRCLE (xc(k), yc(k)), a(n), kl, , , q(n)
IF n = 0 THEN LINE (x1(k), h)-(x2(k), h), kl
END SUB
A few hints for tuning the game:
The first three parameters mass, resistance and gravitational force
are interdependent, it might take some trial & error to get them right.
The heavier the projectile, the less impact the bouncers will have.
The speed of your box determines how much deceleration you'll need
along the trajectory, apply gravity to vary its height and range.
The fourth parameter sets the launching speed, the fifth the time
the kickers will sustain their impulse power, the last the game's
tolerance against prolonged key pushing.
File "BumpBall.ini"
Code:
7
.3
.33
.5
.2
4
The above values should be fine for a 700 Mhz machine.
Enjoy!