Well done, that one ran nice and smooth for as long as I watched it. I'll have to study the end strike algorithm and see if it would go into mine.
I added a screen limiter so my ball doesn't go interstellar. If it gets out now, it rebounds off the screen edges. That way it can't maraud about the neighborhood eating innocent children. It would then bounce off the outside of the walls. One thing it demonstrates to me is that the dot product function doesn't care which way the wall orthogonals point, it still bounces correctly on either side. That left me free to cut about five lines of code out of the wall making sub. Of course, I more than put that back in the screen limiter...
I also got the idea to dot the wall orthogonal with the balls displacement. If they are acute angles (i.e. going the same direction as of an intersection true) then it must indicate that the ball is outside heading in. In which case, it's allowed to continue on its way, skipping the reflection vector step.
I'll have to watch for a while and see if it works. UPDATE: Yes! that worked. A ball that gets out will pass through the walls from the outside and go right back in.
I added a screen limiter so my ball doesn't go interstellar. If it gets out now, it rebounds off the screen edges. That way it can't maraud about the neighborhood eating innocent children. It would then bounce off the outside of the walls. One thing it demonstrates to me is that the dot product function doesn't care which way the wall orthogonals point, it still bounces correctly on either side. That left me free to cut about five lines of code out of the wall making sub. Of course, I more than put that back in the screen limiter...
I also got the idea to dot the wall orthogonal with the balls displacement. If they are acute angles (i.e. going the same direction as of an intersection true) then it must indicate that the ball is outside heading in. In which case, it's allowed to continue on its way, skipping the reflection vector step.
I'll have to watch for a while and see if it works. UPDATE: Yes! that worked. A ball that gets out will pass through the walls from the outside and go right back in.
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)
R2_Norm w(x%).n, w(x%).n, 20 ' create and display orthogonals, 20 length
LINE (w(x%).m.x, w(x%).m.y)-(w(x%).m.x + w(x%).n.x, w(x%).m.y + w(x%).n.y), &H9FFF0000
R2_Norm w(x%).n, w(x%).n, 1 ' reset to unit size
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
IF R2_Dot(w(wc%).n, b(0).d) > 0 THEN _CONTINUE ' if it's out, let it back in
'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 ball escapes the border prevent it from leaving the screen
IF b(0).p.x > scrw% OR b(0).p.x < 0 THEN
b(0).d.x = -b(0).d.x
END IF
IF b(0).p.y > scrh% OR b(0).p.y < 0 THEN
b(0).d.y = -b(0).d.y
END IF
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
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
w(x%).n.x = -w(x%).v.y: w(x%).n.y = w(x%).v.x ' compute inward 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: