Here's my attempt. It will occasionally blow out of the bounds, or deflect at a funny angle. Mostly, it seems to occur at the wall corners. If it blows out and heads for infinity, you can just hit enter to reset the ball to center. Hit escape when you've had enough of it.
I'm thinking a dot product test might rescue blowouts, but it would probably just stick in an infinite loop if the underlying bug isn't corrected.
EDIT: changing the background underlay to hardware image knocked almost 2/3 off of CPU usage.
I'm thinking a dot product test might rescue blowouts, but it would probably just stick in an infinite loop if the underlying bug isn't corrected.
EDIT: changing the background underlay to hardware image knocked almost 2/3 off of CPU usage.
Code: (Select All)
'Janky wall bouncy ball
TYPE V2 ' Vector type 2D contains
x AS SINGLE ' x component
y AS SINGLE ' y component
END TYPE
TYPE wall ' Wall type contains
v AS V2 ' direction vector
n AS V2 ' normalized {orthogonal} vector
s AS V2 ' start point
e AS V2 ' end point
m AS V2 ' midpoint
l AS INTEGER ' length
END TYPE
TYPE ball ' Ball type contains
p AS V2 ' position
d AS V2 ' displacement (speed)
n AS V2 ' normalized displacement vector
r AS INTEGER ' radius
END TYPE
DIM SHARED AS wall w(40)
DIM AS ball b(0)
DIM AS V2 tempv, reflec
DIM SHARED scrw%, scrh%
scrw% = _DESKTOPWIDTH: scrh% = _DESKTOPHEIGHT - 80 ' Create screen
SCREEN _NEWIMAGE(scrw%, scrh%, 32)
DO UNTIL _SCREENEXISTS: LOOP
_SCREENMOVE 0, 0
RANDOMIZE TIMER
Make_wall ' create wall space
FOR x% = 1 TO 40 ' draw walls
LINE (w(x%).s.x, w(x%).s.y)-(w(x%).e.x, w(x%).e.y)
NEXT x%
'initialize ball size, position and velocity
b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1): b(0).r = 20
b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10 ' random initial direction
back& = _COPYIMAGE(0, 33) ' save background
DO ' main loop
CLS
_PUTIMAGE , back& ' redraw background
CIRCLE (b(0).p.x, b(0).p.y), b(0).r ' draw ball
R2_Add b(0).p, b(0).d, 1 ' move ball
'm! = _HYPOT(b(0).d.x, b(0).d.y) ' get displacement magnitude
'R2_Norm b(0).d, b(0).d, m! * .999 ' apply rolling friction loss
FOR wc% = 1 TO 40 ' check all walls for wall strike
'first check for a reasonable proximity and skip if not true
IF _HYPOT(w(wc%).m.x - b(0).p.x, w(wc%).m.y - b(0).p.y) > b(0).r + (w(wc%).l / 2) THEN _CONTINUE
'We're close so check further
IF NewlineSegCirc(w(wc%), b(0)) = 0 THEN _CONTINUE ' skip if not intersecting
'We're intersecting w(wc%) so we back off until we don't, counting the back ups
R2_Norm b(0).n, b(0).d, 1 ' get displacement unit vector
bk% = 0
DO
R2_Add b(0).p, b(0).n, -1 ' backup by unit vectors, updating ball position
bk% = bk% + 1 ' counting number of backups
LOOP UNTIL NewlineSegCirc(w(wc%), b(0)) = 0 ' until we no longer intersect
R2_Norm tempv, w(wc%).n, R2_Dot(b(0).d, w(wc%).n) * 2 ' compute reflection angle bisecter
reflec = tempv: R2_Add reflec, b(0).d, -1 ' subtract ball displacement from bisecter to get reflect vector
R2_Norm reflec, reflec, -1 ' invert reflect to point away from wall
R2_Norm reflec, reflec, bk% ' recover backed up unit vectors
R2_Add b(0).p, reflec, 1 ' and add them to ball position
m! = _HYPOT(b(0).d.x, b(0).d.y) ' preserve displacement magnitude
R2_Norm b(0).d, reflec, m! ' set ball displacement to new angle
'R2_Norm b(0).d, b(0).d, m! * .9 ' lose energy in wall bounce
NEXT wc%
IF _KEYDOWN(13) THEN ' Press <Enter> to reset ball
b(0).p.x = _SHR(scrw%, 1): b(0).p.y = _SHR(scrh%, 1)
b(0).d.x = INT(RND * 20) - 10: b(0).d.y = INT(RND * 20) - 10
END IF
_LIMIT 30
_DISPLAY
LOOP UNTIL _KEYDOWN(27) ' Press <Esc> to quit
_FREEIMAGE back&
END
'VECTOR MATH PROCEDURES
'²²²²²²²²Return result of dot product of two vectors²²²²²²²²²²²²
FUNCTION R2_Dot (v AS V2, v2 AS V2)
R2_Dot = v.x * v2.x + v.y * v2.y
END FUNCTION 'R3_Dot
'²²²²²²²²Add a scalar multiple of se to re²²²²²²²²²²²²²²²²²²²²²²
SUB R2_Add (re AS V2, se AS V2, m AS INTEGER)
re.x = re.x + se.x * m
re.y = re.y + se.y * m
END SUB 'R3_Add
'²²²²²²²²Normalize v and regrow to scalar, return in re²²²²²²²²²
SUB R2_Norm (re AS V2, v AS V2, scalar AS SINGLE)
x! = v.x: y! = v.y ' preserve vector v from changes (if desired)
m! = _HYPOT(x!, y!) ' compute magnitude of v
IF m! = 0 THEN ' trap division by zero
re.x = 0: re.y = 0 ' by returning a zero vector
ELSE ' if magnitude not zero
re.x = (x! / m!) * scalar ' shrink to unit vector and rescale x component
re.y = (y! / m!) * scalar ' " " " " " y component
END IF
END SUB 'R2_Norm
'OTHER SUBROUTINES
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Make_wall
DIM AS V2 tmp1, tmp2, tmpc
lsp% = ((scrw% - 200) + (scrh% - 200)) / 20 '
trip1% = INT((scrw% - 200) / lsp%) ' # of horizontal wall sections
trip2% = 20 - trip1% ' # of vertical wall sections
bs% = 100: dr% = 1 ' baseline and direction multiplier
horz% = -1
FOR x% = 1 TO 40
rand% = INT(RND * 80) - 40
IF x% = 1 THEN ' set start point
w(x%).s.x = bs%
w(x%).s.y = bs% + rand%
ELSE
w(x%).s = w(x% - 1).e
END IF
IF x% = 40 THEN ' set end point
w(x%).e = w(1).s
ELSE
IF horz% THEN
w(x%).e.x = w(x%).s.x + lsp% * dr%
w(x%).e.y = bs% + rand%
ELSE
w(x%).e.x = bs% + rand%
w(x%).e.y = w(x%).s.y + lsp% * dr%
END IF
END IF
w(x%).v = w(x%).e: R2_Add w(x%).v, w(x%).s, -1 ' set wall vector
tmp1.x = w(x%).v.y: tmp1.y = -w(x%).v.x ' set wall normal -orthogonal 1
tmp2.x = -w(x%).v.y: tmp2.y = w(x%).v.x ' -orthogonal 2
tmpc.x = scrw% / 2 - w(x%).e.x: tmpc.y = scrh% / 2 - w(x%).e.y ' -vector pointing at screen center
IF R2_Dot(tmpc, tmp1) > 0 THEN w(x%).n = tmp1 ELSE w(x%).n = tmp2 ' -choose inward pointing orthogonal
R2_Norm w(x%).n, w(x%).n, 1 ' -and convert it to a unit vector
w(x%).l = _HYPOT(w(x%).e.x - w(x%).s.x, w(x%).e.y - w(x%).s.y) 'set wall length
w(x%).m = w(x%).v ' set midpoint of wall -midpoint = wall vector
R2_Norm w(x%).m, w(x%).m, w(x%).l / 2 ' -divide by 2
R2_Add w(x%).m, w(x%).s, 1 ' -add midpoint to start point
ct% = ct% + 1
IF horz% AND ct% = trip1% THEN
horz% = NOT horz%
ct% = 0: bs% = w(x%).e.x
END IF
IF NOT horz% AND ct% = trip2% THEN
horz% = NOT horz%
ct% = 0: bs% = w(x%).e.y: dr% = -1
END IF
NEXT x%
END SUB 'Make_wall
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION NewlineSegCirc (w AS wall, b AS ball)
'shorthand version of Bplus' lineSegIntersectCircle
'utilizing vector math SUBs already implemented
DIM AS V2 d, p
DIM AS INTEGER rtn, i
R2_Norm d, w.v, 1 ' d is unit vector of wall
FOR i = 0 TO w.l '
p = w.s: R2_Add p, d, i ' add i multiples to wall start position to get p
'if p within ball radius then intersect true and leave loop
IF _HYPOT(p.x - b.p.x, p.y - b.p.y) <= b.r THEN rtn = NOT rtn: EXIT FOR
NEXT
NewlineSegCirc = rtn
END FUNCTION 'NewlineSegCirc
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
sha_na_na_na_na_na_na_na_na_na: