The classic gumball game

[vspickelen]

New in the series "from the vaults - for instruction purposes only":
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 "Gumball.bas"

Code:

'Subject: The classic bumperball game
'Keys   : L & R [Shift], [Space] to shake, [Esc] to quit
'Author : vspickelen
'Date   : 10-23-1999
'Code   : QBasic 1.0
DEFSNG A-J, L-M, O-Z
DEFINT K, 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 CurD = "c:\temp"
CONST xm = 319.5, ym = 174.5 '         center screen
CONST bal = "br4bud2bgu4bld4bgu6bld6blu6bgd4blu4bgd2"
KEY 15, CHR$(0) + CHR$(1) '            [Esc]
ON KEY(15) GOSUB eind: KEY(15) ON
KEY 16, CHR$(0) + CHR$(42) '      left [Shift]
ON KEY(16) GOSUB lefl: KEY(16) ON
KEY 17, CHR$(0) + CHR$(54) '     right [Shift]
ON KEY(17) GOSUB rifl: KEY(17) ON
KEY 18, CHR$(0) + CHR$(57) '           [Space]
ON KEY(18) GOSUB shak: KEY(18) ON
OPEN CurD + "\gumball.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 = .5: k0 = 8: kf = 7: kb = 0 '     pause, neutral/fore/back color
dx = 2: dy = 2: sb = 3
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) = .2 '              bumper axis/aspect
a(2) = 71: q(2) = .87 '                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
'
begin:
wp = wp XOR 1
SCREEN 9, 0, wp, wp XOR 1
game = (game + 1) MOD 3
tim = TIMER: t = lag
IF game = 0 THEN t = t * 2
WHILE TIMER - tim < t: WEND '          countdown...
fl = 0: sw = 0: sp = 0: 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)
  PAINT (xc(k), yc(k)), k0, k0
NEXT k
CIRCLE (xc(5), yc(5)), a(2), k0, , , q(2)
PAINT (xc(5), yc(5)), k0, k0
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
PCOPY wp, wp XOR 1

DO
   nl = 0: nr = 0: sp = 0
   wp = wp XOR 1
   SCREEN 9, 0, 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
      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
         tl = tl + 1.5
         cs = (RND - .5) * .2
         sn = SQR(1 - cs * cs) '       random shake
         vx = vx + cs * vo * .5
         vy = vy - sn * vo * .5
      END IF
   ELSE
      IF TIMER - tim > at THEN
         Bumpr fl, 0, kb '             erase bouncing ring
         fl = 0
      END IF
   END IF
LOOP
eind:
END

lefl:
nl = -1
RETURN
rifl:
nr = -1
RETURN
shak:
sp = -1
RETURN

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:
SCREEN 9, 0, wp XOR 1, wp XOR 1
COLOR kf, kb: LOCATE 1, 3: PRINT pnt
LOCATE 1, 76: PRINT mpt;
SCREEN 9, 0, 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
   SCREEN 9, 0, 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
   SCREEN 9, 0, 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.

:rotfl:
File "Gumball.ini"

Code:

4.5
.7
.75
.75
.2
3

Put "Gumball.ini" in c:\temp, or set CONST CurD = anotherDirectory.
The above values should be fine for a 700 Mhz machine.
:bounce:
Happy bouncin!