+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: Angle Collisions (/showthread.php?tid=972)
RE: Angle Collisions - OldMoses - 10-26-2022
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.
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 'NewlineSegCircRE: Angle Collisions - james2464 - 10-26-2022
This is incredible! The strategy for making the wall is really interesting. Lots of stuff I can learn from here. Thank you.
RE: Angle Collisions - OldMoses - 10-26-2022
(10-26-2022, 03:51 PM)james2464 Wrote: This is incredible! The strategy for making the wall is really interesting. Lots of stuff I can learn from here. Thank you.
Thanks,
Yeah the wall building was a bit of a brain teaser. Since I was after a non-trig function, full vector math approach, I had to build in a lot of information for each wall section. The one thing I didn't need was any angle data, just start and end positions, and the rest is derived from those. Even length wasn't strictly necessary, but it maybe saved on a Pythagorean computation or two.
It sometimes folds in on itself in the upper left corner. I was thinking that dropping the "+ rand%" from 'w(x%).s.y = bs% + rand%' might help stop that. Then the upper left starting corner will always be at (100, 100)
The real sleeper was the R2_Norm sub. I was surprised how much of the brute work it did. It even stepped into Bplus' lineSegIntersectCircle function and shortened up the code considerably, given that the infrastructure was already in place. Having that infrastructure in place kept the wall bouncing code fairly short too.
I'm hoping that some of the learning process in doing this will help me on my billiards program, when I can motivate myself to take it back up.
RE: Angle Collisions - james2464 - 10-26-2022
Well I've had trouble with the random outer border, so I decided to try a fixed pattern for now. Added frame splitting, so going past the line is kept to a minimum. This seems to make the ball stick every so often, so I need to adjust this.
Code: (Select All)
'vector reflection and line detection demo
'james2464
Dim Shared scx, scy As Integer
scx = 800: scy = 600
Screen _NewImage(scx, scy, 32)
Const PI = 3.141592654#
Randomize Timer
Dim Shared x, y, h, xv, yv, ndpx, ndpy, rx, ry, rt
Dim Shared cpa, cpb, a, b, a2, b2, sbx, sby
Dim Shared bg&
bg& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared c(10) As Long
c(0) = _RGB(30, 30, 30)
c(1) = _RGB(255, 255, 255)
c(2) = _RGB(255, 255, 0)
c(3) = _RGB(255, 0, 0)
c(4) = _RGB(0, 255, 0)
c(5) = _RGB(0, 255, 255)
c(6) = _RGB(255, 0, 255)
Type fixedwall
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
b As Integer
bx1 As Integer
bx2 As Integer
by1 As Integer
by2 As Integer
xx As Single
yy As Single
wlen As Single
nx As Single
ny As Single
sc As Single
End Type
Dim Shared w(50) As fixedwall
Dim Shared walltotal, ballrad
ballrad = 12 'ball radius
walltotal = 10
For t = 1 To walltotal
w(t).b = ballrad + 2
Next t
w(1).x1 = 400: w(1).x2 = 456.1285: w(1).y1 = 50: w(1).y2 = 222.7458
w(2).x1 = 456.1285: w(2).x2 = 637.7641: w(2).y1 = 222.7458: w(2).y2 = 222.7458
w(3).x1 = 637.7641: w(3).x2 = 490.8178: w(3).y1 = 222.7458: w(3).y2 = 329.5085
w(4).x1 = 490.8178: w(4).x2 = 546.9463: w(4).y1 = 329.5085: w(4).y2 = 502.2542
w(5).x1 = 546.9463: w(5).x2 = 400: w(5).y1 = 502.2542: w(5).y2 = 395.4915
w(6).x1 = 400: w(6).x2 = 253.0537: w(6).y1 = 395.4915: w(6).y2 = 502.2542
w(7).x1 = 253.0537: w(7).x2 = 309.1822: w(7).y1 = 502.2542: w(7).y2 = 329.5085
w(8).x1 = 309.1822: w(8).x2 = 162.2359: w(8).y1 = 329.5085: w(8).y2 = 222.7458
w(9).x1 = 162.2359: w(9).x2 = 343.8715: w(9).y1 = 222.7458: w(9).y2 = 222.7458
w(10).x1 = 343.8715: w(10).x2 = 400: w(10).y1 = 222.7458: w(10).y2 = 50
wallsetup
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
xv = 6. 'starting ball x velocity
yv = 2. 'starting ball y velocity
sbx = 400 'starting x position
sby = 300 'starting y position
flag = 0
Do
_Limit 30
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background
'=====================================================
'_MouseHide
sbx = sbx + xv
sby = sby + yv
If sbx > (scx - ballrad) Then
xv = xv * -1
t = sbx - (scx - ballrad)
sbx = sbx - t
End If
If sby > (scy - ballrad) Then
yv = yv * -1
t = sby - (scy - ballrad)
sby = sby - t
End If
If sbx < ballrad Then
xv = xv * -1
t = ballrad - sbx
sbx = sbx + t
End If
If sby < ballrad Then
yv = yv * -1
t = ballrad - sby
sby = sby + t
End If
'=====================================================
rt = rectanglecheck 'early wall detection
'Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(3) 'early detection (red)
If rectanglecheck > 0 Then
rt = nearestwall
Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(4) 'nearest wall (green)
framesplit
reflect
End If
'=====================================================
Circle (sbx, sby), (ballrad - 1), c(2) 'screen location of ball
_Display
If mouseclick2 = 1 Then flag = 1
Loop Until flag = 1
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
Function rectanglecheck
rectanglecheck = 0
ttt = 1
While ttt <= walltotal
If sbx >= w(ttt).bx1 Then
If sbx <= w(ttt).bx2 Then
If sby >= w(ttt).by1 Then
If sby <= w(ttt).by2 Then
rectanglecheck = ttt
End If
End If
End If
End If
ttt = ttt + 1
Wend
End Function
Function nearestwall
nearestwall = 0
For ct = 1 To walltotal 'get each wall centerpoint distance from ball
tdx = Abs(sbx - w(ct).xx)
tdy = Abs(sby - w(ct).yy)
w(ct).sc = _Hypot(tdx, tdy)
Next ct
'sort to find nearest wall
lowscore = 500
lowscorewall = 0
For ct = 1 To walltotal
If w(ct).sc < lowscore Then
old = lowscore
oldwall = lowscorewall
lowscore = w(ct).sc
lowscorewall = ct
End If
Next ct
'faceoff between 2 closest walls
'predict which will be closer after another frame of movement
fsbx = sbx + xv
fsby = sby + yv
tdx = Abs(fsbx - w(oldwall).xx)
tdy = Abs(fsby - w(oldwall).yy)
fscoreold = _Hypot(tdx, tdy)
tdx = Abs(fsbx - w(lowscorewall).xx)
tdy = Abs(fsby - w(lowscorewall).yy)
fscorelow = _Hypot(tdx, tdy)
If fscoreold < fscorelow Then
nearestwall = oldwall
Else
nearestwall = lowscorewall
End If
End Function
Sub framesplit
x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall
h = (_Hypot(-x, y))
dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
If Abs(ndp) <= ballrad Then ' ball moved past the line
overtheline = ballrad - Abs(ndp)
spd = _Hypot(xv, yv)
nxv = xv / spd: nyv = yv / spd
oldsbx = sbx: oldsby = sby
sbx = sbx - (overtheline * nxv) * .8
sby = sby - (overtheline * nyv) * .8
End If
'check for endpoints distance
End Sub
Sub reflect
x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall
h = (_Hypot(-x, y))
dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
'dot product V.N - used to find distance of N
ndpx = w(rt).ny * ndp
ndpy = w(rt).nx * ndp
'Line (w(rt).xx, w(rt).yy)-(w(rt).xx + ndpx, w(rt).yy - ndpy), c(5)
'calculate point R
th1 = _Atan2(-y, x) 'radian value of ball (point I)
th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
thd = th1 - th2 'find difference
th3 = th2 - thd 'subtract difference from line N
rx = Cos(th3) * h: ry = Sin(th3) * h 'point R position - th3 * length of point I to collision point
'angled wall
a = w(rt).ny * w(rt).wlen
b = w(rt).nx * w(rt).wlen
a2 = a * -1: b2 = b * -1
c(9) = c(1)
'find length of line A
segx = Abs(x - rx)
segy = Abs((w(rt).yy - y) - (w(rt).yy + ry))
sega = _Hypot(segx, segy)
'find distance from point I to wall endpoints
i2w1x = Abs(x - b)
i2w1y = Abs(a + y)
i2w2x = Abs(x + b)
i2w2y = Abs(y - a)
i2wh1 = _Hypot(i2w1x, i2w1y)
i2wh2 = _Hypot(i2w2x, i2w2y)
If i2wh1 < i2wh2 Then 'determine which end the ball is closer to
i2ws = 1: i2w = i2wh1
Else
i2ws = 2: i2w = i2wh2
End If
If sega < (w(rt).wlen * 2) Then
If Abs(ndp) <= ballrad Then ' ***** collision with side of the line *****
c(9) = c(3) 'if beside the wall, just check length of line N
collisionpointa = w(rt).ny * (sega / 2)
collisionpointb = w(rt).nx * (sega / 2)
If i2ws = 1 Then
cpa = w(rt).yy + collisionpointa: cpb = w(rt).xx + collisionpointb
End If
If i2ws = 2 Then
cpa = w(rt).yy - collisionpointa: cpb = w(rt).xx - collisionpointb
End If
'Circle (cpb, cpa), 5, c(4) 'circle the collision point
'_Display
'_Delay .01
sidecollisionvector
End If
Else
If i2w <= ballrad Then ' ***** collision with endpoint of the line *****
c(9) = c(3)
If i2ws = 1 Then
cpa = w(rt).yy - a2: cpb = w(rt).xx + b
endpointcollision1
End If
If i2ws = 2 Then
cpa = w(rt).yy - a: cpb = w(rt).xx + b2
endpointcollision2
End If
'Circle (cpb, cpa), 5, c(4) 'circle the collision point
'_Display
'_Delay .01
End If
End If
End Sub
Sub sidecollisionvector
tx = xv: ty = yv: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
spd = _Hypot(tx, ty) 'speed of existing motion vector
th1 = _Atan2(tx, -ty) 'radian value of motion vector
th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
thd = th1 - th2 'find difference
th3 = th2 - thd 'subtract difference from line N
newxv = Sin(th3): newyv = Cos(th3)
xv = newxv * spd: yv = newyv * spd * -1
End Sub
Sub endpointcollision1
tx = x - b: ty = y - a2: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
xv = tx2 * spd: yv = ty2 * spd * -1
End Sub
Sub endpointcollision2
tx = x - b2: ty = y - a: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
xv = tx2 * spd: yv = ty2 * spd * -1
End Sub
Sub wallsetup
For wct = 1 To walltotal
w(wct).bx1 = w(wct).x1: w(wct).bx2 = w(wct).x2
w(wct).by1 = w(wct).y1: w(wct).by2 = w(wct).y2
'orient outer box
If w(wct).bx1 > w(wct).bx2 Then
t = w(wct).bx1
w(wct).bx1 = w(wct).bx2
w(wct).bx2 = t
End If
If w(wct).by1 > w(wct).by2 Then
t = w(wct).by1
w(wct).by1 = w(wct).by2
w(wct).by2 = t
End If
w(wct).bx1 = w(wct).bx1 - w(wct).b: w(wct).bx2 = w(wct).bx2 + w(wct).b
w(wct).by1 = w(wct).by1 - w(wct).b: w(wct).by2 = w(wct).by2 + w(wct).b
Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1)
'Line (w(wct).bx1, w(wct).by1)-(w(wct).bx2, w(wct).by2), c(2), B
w(wct).xx = (w(wct).x2 - w(wct).x1) / 2 + w(wct).x1
w(wct).yy = (w(wct).y2 - w(wct).y1) / 2 + w(wct).y1
'Circle (w(wct).xx, w(wct).yy), 5, c(4)
tx = w(wct).x2 - w(wct).xx: ty = w(wct).y2 - w(wct).yy
w(wct).wlen = _Hypot(tx, ty)
w(wct).nx = tx / w(wct).wlen 'normalized wall angle
w(wct).ny = ty / w(wct).wlen 'normalized wall angle
Next wct
End SubRE: Angle Collisions - OldMoses - 10-27-2022
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.
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 'NewlineSegCircRE: Angle Collisions - james2464 - 10-27-2022
Quote:UPDATE: Yes! that worked. A ball that gets out will pass through the walls from the outside and go right back in.
That's interesting, and it could be really useful at some point. Being able to trap an object that passes a barrier or line.
RE: Angle Collisions - OldMoses - 10-29-2022
A few refinements later...
I haven't seen it jump out of bounds nearly as much and have tried to implement an algorithm to handle bounces off of points. It seems to work most of the time.
I also added a mouse driven paddle. Tilting the paddle is done with the mouse wheel. Yes, the paddle acts really hinky, and I'm considering an air hockey-like round impactor instead.
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 bisect, reflec, halfv, npnt
DIM SHARED scrw%, scrh%
DIM wloss!, rfric!
wloss! = 1 ' change to <1 if speed loss in wall bounce
rfric! = 1 ' change to <1 if speed loss in rolling friction
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
'b(0).d.x = INT(RND * 40) - 20: b(0).d.y = INT(RND * 40) - 20 ' random initial direction
'b(0).d.x = 19: b(0).d.y = 19 ' full speed
back& = _COPYIMAGE(0, 33) ' save background
'Paddle wall initialization
w(0).s.x = scrw% / 2 - 50: w(0).s.y = scrh% / 2 ' start point
w(0).e.x = scrw% / 2 + 50: w(0).e.y = scrh% / 2 ' end point
P2V w(0).v, w(0).s, w(0).e ' set paddle vector
Ortho_Norm w(0).n, w(0).v ' compute paddle unit orthogonal
w(0).l = Mag(w(0).v)
w(0).m = w(0).v ' set midpoint of wall -midpoint = wall vector
R2_Norm w(0).m, w(0).m, w(0).l / 2 ' divide by 2
R2_Add w(0).m, w(0).s, 1 ' add midpoint to start point
_MOUSEHIDE
DO ' main loop
CLS
_PUTIMAGE , back& ' redraw background
WHILE _MOUSEINPUT
'mousewheel ops
R2_Norm w(0).v, w(0).v, 10 ' reduce vector granularity (speeds mousewheel changes)
IF ABS(w(0).v.x) <= ABS(w(0).v.y) THEN
w(0).v.x = w(0).v.x + SGN(_MOUSEWHEEL)
ELSE
w(0).v.y = w(0).v.y + SGN(_MOUSEWHEEL)
END IF
R2_Norm w(0).v, w(0).v, 50
Ortho_Norm w(0).n, w(0).v
w(0).s = w(0).m: R2_Add w(0).s, w(0).v, -1
w(0).e = w(0).m: R2_Add w(0).e, w(0).v, 1
R2_Norm w(0).v, w(0).v, 100
WEND
w(0).m.x = _MOUSEX: w(0).m.y = _MOUSEY
R2_Norm halfv, w(0).v, 50
w(0).s = w(0).m: R2_Add w(0).s, halfv, -1
w(0).e = w(0).m: R2_Add w(0).e, halfv, 1
'IF _MOUSEBUTTON(1) THEN
' b(0).p.x = _MOUSEX: b(0).p.y = _MOUSEY
'END IF
LINE (w(0).s.x, w(0).s.y)-(w(0).e.x, w(0).e.y) ' draw paddle
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
R2_Norm b(0).d, b(0).d, Mag(b(0).d) * rfric! ' apply rolling friction loss (if desired)
FOR wc% = 0 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 wc% > 0 THEN ' if not the paddle
IF R2_Dot(w(wc%).n, b(0).d) > 0 THEN _CONTINUE ' if it's out, let it back in
END IF
'We're close to wc%, but are we closer to wc% + 1? this might go in the above IF THEN
SELECT CASE wc% ' get adjacent wall indexes
CASE 1: pre% = 40: sbs% = 2
CASE 40: pre% = 39: sbs% = 1
CASE ELSE: pre% = wc% - 1: sbs% = wc% + 1
END SELECT
'check hypot of start and end points
IF _HYPOT(w(wc%).s.x - b(0).p.x, w(wc%).s.y - b(0).p.y) < b(0).r THEN alt% = pre% 'closer to previous wall
IF _HYPOT(w(wc%).e.x - b(0).p.x, w(wc%).e.y - b(0).p.y) < b(0).r THEN alt% = sbs% 'closer to subsequent wall
'We're intersecting w(wc%) so we back off until we don't, counting the back ups
'we check both wc% and alt% walls. Which one goes low on backup first?
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
IF alt% <> 0 AND wc% <> 0 THEN ' if alternate wall set and not checking paddle
mainlow% = NewlineSegCirc(w(wc%), b(0)) ' main wall intersect
altlow% = NewlineSegCirc(w(alt%), b(0)) ' alternate wall intersect
IF mainlow% = 0 AND altlow% = 0 THEN ' if both walls go low simultaneously
'alter the bisecter between wc% & alt%, two step process
Vec_Mirror bisect, w(wc%).n, w(alt%).n ' first bisect wc% and alt% orthogonals
R2_Norm bisect, bisect, 1 ' normalize it for next step
Vec_Mirror bisect, bisect, b(0).d ' then bisect result with ball displacement vector
in% = -1
ELSEIF mainlow% = 0 AND altlow% <> 0 THEN ' if main wall goes low first
Vec_Mirror bisect, w(wc%).n, b(0).d ' use wc% bisecter
in% = -1
ELSEIF mainlow% <> 0 AND altlow% = 0 THEN ' if alternate wall goes low first
Vec_Mirror bisect, w(alt%).n, b(0).d ' use alt% bisecter
in% = -1
END IF
ELSE
mainlow% = NewlineSegCirc(w(wc%), b(0))
IF mainlow% = 0 THEN in% = -1
Vec_Mirror bisect, w(wc%).n, b(0).d
END IF
bk% = bk% + 1 ' counting number of backups
LOOP UNTIL in% ' until we no longer intersect one or the other
in% = 0: alt% = 0
reflec = bisect: R2_Add reflec, b(0).d, -1 ' subtract ball displacement from bisecter to get reflect vector
R2_Norm reflec, reflec, -bk% ' invert & recover backed up unit vectors
R2_Add b(0).p, reflec, 1 ' and add them to ball position
m! = Mag(b(0).d) ' 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! * wloss! ' lose energy in wall bounce (if desired)
EXIT FOR ' if we got here no more checks are needed
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 60
_DISPLAY
LOOP UNTIL _KEYDOWN(27) ' Press <Esc> to quit
_FREEIMAGE back&
END
'VECTOR MATH PROCEDURES
'²²²²²²²²Convert points st & nd to a vector²²²²²²²²²²²²²²²²²²²²
SUB P2V (v AS V2, st AS V2, nd AS V2)
v.x = nd.x - st.x
v.y = nd.y - st.y
END SUB 'P2V
'²²²²²²²²Mirror a vector in around a unit bisecter²²²²²²²²²²²²²²
SUB Vec_Mirror (re AS V2, m AS V2, in AS V2)
R2_Norm re, m, R2_Dot(in, m) * 2
END SUB 'Vec_Mirror
'²²²²²²²²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
'²²²²²²²²Compute magnitude of vector v²²²²²²²²²²²²²²²²²²²²²²²²²²
FUNCTION Mag (v AS V2)
Mag = _HYPOT(v.x, v.y)
END FUNCTION 'Mag
'²²²²²²²²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
'²²²²²²²²Return the unit orthogonal of a vector²²²²²²²²²²²²²²²²²
SUB Ortho_Norm (orth AS V2, vec AS V2)
orth.x = -vec.y: orth.y = vec.x ' compute orthogonal
R2_Norm orth, orth, 1 ' and convert it to a unit vector
END SUB 'Ortho_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%
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
P2V w(x%).v, w(x%).s, w(x%).e ' set wall vector
Ortho_Norm w(x%).n, w(x%).v
w(x%).l = Mag(w(x%).v) ' 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 'NewlineSegCircRE: Angle Collisions - james2464 - 10-29-2022
This is awesome! Actually a working "Caveball" now. I like the air hockey with jagged borders idea.
RE: Angle Collisions - james2464 - 10-30-2022
I've been working at this and now I'm having too much fun. Random walls and some controls now. I think I understand this enough to apply this in a game. There is still another common game vector challenge I haven't tried yet, which is line/line intersection detection. I'm curious about how fast objects (like bullets) are kept from going through walls, and of course reflect as well. I'm guessing it's with line intersections but we'll see.
Code: (Select All)
'vector random angle collision demo
'james2464
'CONTROLS:
'Arrow keys: Left and right: change size of ball
' Up and Down: change speed
'Space Bar : Random Restart
'Escape key: Quit
Dim Shared scx, scy As Integer
scx = 800: scy = 600
Screen _NewImage(scx, scy, 32)
Const PI = 3.141592654#
Randomize Timer
Dim Shared x, y, h, xv, yv, ndpx, ndpy, rx, ry, rt, i2w, i2ws
Dim Shared cpa, cpb, a, b, a2, b2, sbx, sby, newxv, newyv, oldxv, oldyv
Dim Shared lastcollision, collisiontype, correctionwasmade
Dim Shared bg&
bg& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared c(30) As Long
colour1
Type fixedwall
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
b As Integer
bx1 As Integer
bx2 As Integer
by1 As Integer
by2 As Integer
xx As Single
yy As Single
wlen As Single
nx As Single
ny As Single
sc As Single
sc1 As Single
sc2 As Single
End Type
Dim Shared w(50) As fixedwall
Dim Shared walltotal, ballrad
ballrad = 20 'ball radius
walltotal = 11
For t = 1 To walltotal
w(t).b = ballrad + 2
Next t
wallsetup
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
'start
xv01 = 0
yv01 = 5.
sbx01 = 400
sby01 = 300
xv = xv01 'starting ball x velocity
yv = yv01 'starting ball y velocity
sbx = sbx01 'starting x position
sby = sby01 'starting y position
flag = 0
Do
_Limit 30
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background
'rcirc = Rnd * 20 + 3 'display to show program is active
'Circle (700, 100), rcirc, c(6)
'Paint (400, 300), c(30), c(1)
'=====================================================
'_MouseHide
sbx = sbx + xv
sby = sby + yv
If sbx > (scx - ballrad) Then
xv = xv * -1
t = sbx - (scx - ballrad)
sbx = sbx - t
End If
If sby > (scy - ballrad) Then
yv = yv * -1
t = sby - (scy - ballrad)
sby = sby - t
End If
If sbx < ballrad Then
xv = xv * -1
t = ballrad - sbx
sbx = sbx + t
End If
If sby < ballrad Then
yv = yv * -1
t = ballrad - sby
sby = sby + t
End If
'=====================================================
correctionwasmade = 0: collisiontype = 0
rt = 0
rt = nearestwall 'determine the nearest wall
Line (w(rt).x1, w(rt).y1)-(w(rt).x2, w(rt).y2), c(4) 'highlight the nearest wall (green)
nearestwallcheck 'check the nearest wall for collision
If cpb > 0 Then
If rt = lastcollision Then
'Locate 1, 1
'Print i2ws; i2w
'Line (cpb, cpa)-(cpb + x, cpa - y), c(2) 'collision to point I
'Line (cpb, cpa)-(sbx, sby), c(2) 'collision to point I
'Line (cpb, cpa)-(cpb - oldxv * ballrad * 4, cpa - oldyv * ballrad * 4), c(1) 'collision to point I
'Line (cpb + x, cpa - y)-(cpb + rx, cpa + ry), c(4) 'line A
'Line (cpb, cpa)-(cpb + newxv * ballrad * 4, cpa + newyv * ballrad * 4), c(1) 'collision to point R
'Line (cpb, cpa)-(cpb + ndpx * 50, cpa - ndpy * 50), c(5) 'line N
Circle (cpb, cpa), 2, c(4) 'circle the collision point
End If
Else
rt = 0
cpa = 0: cpb = 0: x = 0: y = 0
rx = 0: ry = 0: ndpx = 0: ndpy = 0
End If
'=====================================================
Circle (sbx, sby), (ballrad - 1), c(2) 'screen location of ball
'Paint (sbx, sby), c(17), c(2)
'_Delay .5 'use to step through animation to see each frame separately
If _KeyDown(18432) Then ' IF up arrow key was pressed
yv = yv * 1.1
xv = xv * 1.1
End If
If _KeyDown(20480) Then ' IF down arrow key was pressed
yv = yv * .9
xv = xv * .9
End If
If _KeyDown(19200) Then ' IF left arrow key was pressed
ballrad = ballrad * .9
If ballrad < 2 Then ballrad = 2
End If
If _KeyDown(19712) Then ' IF right arrow key was pressed
ballrad = ballrad * 1.1
If ballrad > 40 Then ballrad = 40
End If
For t = 1 To walltotal
w(t).b = ballrad + 2
Next t
If _KeyDown(32) Then ' IF space bar was pressed
Cls
_Delay .5
wallsetup
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
ballrad = Int(Rnd * 20) + 5
xv = xv01 'starting ball x velocity
yv = yv01 'starting ball y velocity
sbx = sbx01 'starting x position
sby = sby01 'starting y position
End If
If _KeyDown(27) Then ' IF escape key was pressed
End
End If
displayspd = _Hypot(xv, yv)
Locate 1, 1
Print "LEFT and RIGHT keys : Ball radius:"; Int(ballrad)
Print "UP and DOWN keys : Speed:"; Int(displayspd)
Print "SPACE BAR : Random Restart"
Print "ESC : Quit"
_Display
If mouseclick2 = 1 Then flag = 1
Loop Until flag = 1
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
'==============================================================================
Function nearestwall
nearestwall = 0
scoretobeat = 1000
closest = 0
Locate 1, 1
For ct = 1 To walltotal 'get each wall endpoints and mid point distances from ball
tdx1 = Abs(sbx - w(ct).x1)
tdy1 = Abs(sby - w(ct).y1)
score1 = _Hypot(tdx1, tdy1) 'distance from ball center to line endpoint 1
tdx2 = Abs(sbx - w(ct).x2)
tdy2 = Abs(sby - w(ct).y2)
score2 = _Hypot(tdx2, tdy2) 'distance from ball center to line endpoint 2
If score2 < score1 Then
lowscore = score2: low$ = "E2"
Else
lowscore = score1: low$ = "E1"
End If
tdxx = Abs(sbx - w(ct).xx)
tdyy = Abs(sby - w(ct).yy)
score3 = _Hypot(tdxx, tdyy) 'distance from ball center to line mid point
If score3 < lowscore Then
lowscore = score3: low$ = "M"
End If
x = sbx - w(ct).xx: y = 0 - sby + w(ct).yy
dx = -x * w(ct).ny * -1: dy = y * w(ct).nx
ndp = dx + dy
score4 = Abs(ndp) 'distance ball center to side of wall (using vector dot product) aka "POINT N"
'find if score4 is valid (ball is within the line, if outside then endpoints are used)
ndpx = w(ct).ny * (ndp): ndpy = w(ct).nx * (ndp) 'screen position of point N
score4distx = Abs(sbx - (w(ct).xx + ndpx))
score4disty = Abs(sby - (w(ct).yy - ndpy))
score4disth = _Hypot(score4distx, score4disty)
If score4disth <= w(ct).wlen Then 'if within the line segment then score4 counts
If score4 < ballrad * 5 Then
'display line N
'Line (w(ct).xx, w(ct).yy)-(w(ct).xx + ndpx, w(ct).yy - ndpy), c(ct)
'Circle (w(ct).xx + ndpx, w(ct).yy - ndpy), 2, c(ct)
End If
If score4 < lowscore Then
lowscore = score4: low$ = "N"
End If
End If
w(ct).sc = lowscore
If lowscore < scoretobeat Then
scoretobeat = lowscore
closest = ct
End If
'Print ct; w(ct).sc; "scores"; score1; score2; score3; score4; low$
Next ct
nearestwall = closest
End Function
Sub nearestwallcheck
'start by getting position info
x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall mid point
h = (_Hypot(-x, y))
dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
'dot product V.N - used to find distance of N
ndpx = w(rt).ny * ndp
ndpy = w(rt).nx * ndp
'calculate new vector (point R)
th1 = _Atan2(-y, x) 'radian value of ball (point I)
th2 = _Atan2(-ndpy, ndpx) 'radian value of line N (orthagonal to wall)
thd = th1 - th2 'find difference
th3 = th2 - thd 'subtract difference from line N
rx = Cos(th3) * h: ry = Sin(th3) * h 'point R position - th3 * length of point I to collision point
'angled wall endpoints
a = w(rt).ny * w(rt).wlen: b = w(rt).nx * w(rt).wlen: a2 = a * -1: b2 = b * -1
'find length of line A
segx = Abs(x - rx): segy = Abs((w(rt).yy - y) - (w(rt).yy + ry)): sega = _Hypot(segx, segy)
'find distance from point I to wall endpoints
i2w1x = Abs(x - b): i2w1y = Abs(a + y): i2w2x = Abs(x + b): i2w2y = Abs(y - a)
i2wh1 = _Hypot(i2w1x, i2w1y): i2wh2 = _Hypot(i2w2x, i2w2y)
If i2wh1 < i2wh2 Then 'determine which end the ball is closer to
i2ws = 1: i2w = i2wh1
Else
i2ws = 2: i2w = i2wh2
End If
If sega < (w(rt).wlen * 2) Then
If Abs(ndp) <= ballrad Then
'side collision
positioncorrection 'perform correction
collisionpointa = w(rt).ny * (sega / 2)
collisionpointb = w(rt).nx * (sega / 2)
If i2ws = 1 Then
cpa = w(rt).yy + collisionpointa: cpb = w(rt).xx + collisionpointb
End If
If i2ws = 2 Then
cpa = w(rt).yy - collisionpointa: cpb = w(rt).xx - collisionpointb
End If
sidecollisionvector 'find new vector
End If
Else
If i2w <= ballrad Then '***** collision with endpoint of the line *****
If i2ws = 1 Then
cpa = w(rt).yy - a2: cpb = w(rt).xx + b
endpointcollision1
End If
If i2ws = 2 Then
cpa = w(rt).yy - a: cpb = w(rt).xx + b2
endpointcollision2
End If
End If
End If
End Sub
Sub positioncorrection '(for side collisions)
x = sbx - w(rt).xx: y = 0 - sby + w(rt).yy 'location relative to wall mid point
h = (_Hypot(-x, y))
dx = -x * w(rt).ny * -1: dy = y * w(rt).nx: ndp = dx + dy
pastline1 = ballrad - Abs(ndp)
If pastline1 > 0 Then
'=================================
ballspd = _Hypot(xv, yv)
cor2 = pastline1 / ballspd
corx = xv * cor2: cory = yv * cor2
csbx = sbx - corx: csby = sby - cory
'=================================
pastline2 = ballrad - Abs(ndp)
sbx = csbx
sby = csby
End If
End Sub
Sub sidecollisionvector
tx = xv: ty = yv: th = _Hypot(tx, ty)
tx2 = tx / th: ty2 = ty / th
spd = _Hypot(tx, ty) 'speed of existing motion vector
th1 = _Atan2(tx, -ty) 'radian value of motion vector
th2 = _Atan2(-ndpy, ndpx) 'radian value of line N
thd = th1 - th2 'find difference
th3 = th2 - thd 'subtract difference from line N
newxv = Sin(th3): newyv = Cos(th3)
oldxv = tx2: oldyv = ty2
xv = newxv * spd: yv = newyv * spd * -1
newh = _Hypot(xv, yv)
newxv = xv / newh: newyv = yv / newh
lastcollision = rt
End Sub
Sub endpointcollision1
tx = x - b: ty = y + a2: th = _Hypot(tx, ty) 'tx, ty are distances from ball to end of line
If th < ballrad Then
past1 = ballrad - th
'position correction
txv = xv: tyv = yv: tspd = _Hypot(xv, yv)
cor2 = past1 / tspd
corx = xv * cor2: cory = yv * cor2
'Locate 1, 1
'Print "End1"; ballrad; th; past1; tspd; cor2; xv; corx; yv; cory
'Print sbx; sby
'_Display
'Sleep
'apply correction
csbx = sbx - corx: csby = sby - cory
tx = tx - corx: ty = ty - cory: th = _Hypot(tx, ty)
sbx = csbx: sby = csby
'Print "corrected"; sbx; sby
'_Display
'Sleep
End If
'continue to calculate new vector
tx2 = tx / th: ty2 = ty / th 'tx2, ty2 are normalized
txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
oldxv = xv: oldyv = yv
oldh = _Hypot(xv, yv)
oldxv = oldxv / oldh: oldyv = oldyv / oldh
xv = tx2 * spd: yv = ty2 * spd * -1
newh = _Hypot(xv, yv)
newxv = xv / newh: newyv = yv / newh
lastcollision = rt
End Sub
Sub endpointcollision2
tx = x - b2: ty = y - a: th = _Hypot(tx, ty)
If th < ballrad Then
past2 = ballrad - th
'position correction
txv = xv: tyv = yv: tspd = _Hypot(xv, yv)
cor2 = past2 / tspd
corx = xv * cor2: cory = yv * cor2
'Locate 1, 1
'Print "End2"; ballrad; th; past2; tspd; cor2; xv; corx; yv; cory
'Print sbx; sby
'_Display
'Sleep
'apply correction
csbx = sbx - corx: csby = sby - cory
tx = tx - corx: ty = ty - cory: th = _Hypot(tx, ty)
sbx = csbx: sby = csby
'Print "corrected"; sbx; sby
'_Display
'Sleep
End If
'continue to calculate new vector
tx2 = tx / th: ty2 = ty / th
txv = Abs(xv): tyv = Abs(yv): spd = _Hypot(txv, tyv)
oldxv = xv: oldyv = yv
oldh = _Hypot(xv, yv)
oldxv = oldxv / oldh: oldyv = oldyv / oldh
xv = tx2 * spd: yv = ty2 * spd * -1
newh = _Hypot(xv, yv)
newxv = xv / newh: newyv = yv / newh
lastcollision = rt
End Sub
Sub wallsetup
w(1).x1 = 400: w(1).x2 = w(1).x1 + Rnd * 100 + 50: w(1).y1 = 200: w(1).y2 = 250
w(2).x1 = w(1).x2: w(2).x2 = w(2).x1 + Rnd * 100: w(2).y1 = 250: w(2).y2 = 350
w(3).x1 = w(2).x2: w(3).x2 = w(3).x1 + Rnd * 100: w(3).y1 = 350: w(3).y2 = 450
w(4).x1 = w(3).x2: w(4).x2 = w(4).x1 - Rnd * 100 - 50: w(4).y1 = 450: w(4).y2 = 470
w(5).x1 = w(4).x2: w(5).x2 = w(5).x1 - Rnd * 100 - 100: w(5).y1 = 470: w(5).y2 = 450
w(6).x1 = w(5).x2: w(6).x2 = w(6).x1 - Rnd * 100 - 100: w(6).y1 = 450: w(6).y2 = 350
w(7).x1 = w(6).x2: w(7).x2 = w(7).x1 - Rnd * 100 - 50: w(7).y1 = 350: w(7).y2 = 250
w(8).x1 = w(7).x2: w(8).x2 = w(1).x1: w(8).y1 = 250: w(8).y2 = 200
'inner walls
w(9).x1 = 400: w(9).x2 = w(9).x1 + Rnd * 50 + 10: w(9).y1 = 320: w(9).y2 = 350
w(10).x1 = 400: w(10).x2 = w(10).x1 - Rnd * 50 - 10: w(10).y1 = 320: w(10).y2 = 350
w(11).x1 = w(10).x2: w(11).x2 = w(9).x2: w(11).y1 = w(10).y2: w(11).y2 = w(9).y2
For wct = 1 To walltotal
w(wct).bx1 = w(wct).x1: w(wct).bx2 = w(wct).x2
w(wct).by1 = w(wct).y1: w(wct).by2 = w(wct).y2
'orient outer box
If w(wct).bx1 > w(wct).bx2 Then
t = w(wct).bx1
w(wct).bx1 = w(wct).bx2
w(wct).bx2 = t
End If
If w(wct).by1 > w(wct).by2 Then
t = w(wct).by1
w(wct).by1 = w(wct).by2
w(wct).by2 = t
End If
w(wct).bx1 = w(wct).bx1 - w(wct).b: w(wct).bx2 = w(wct).bx2 + w(wct).b
w(wct).by1 = w(wct).by1 - w(wct).b: w(wct).by2 = w(wct).by2 + w(wct).b
Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1)
'Line (w(wct).bx1, w(wct).by1)-(w(wct).bx2, w(wct).by2), c(2), B
w(wct).xx = (w(wct).x2 - w(wct).x1) / 2 + w(wct).x1
w(wct).yy = (w(wct).y2 - w(wct).y1) / 2 + w(wct).y1
'Circle (w(wct).xx, w(wct).yy), 5, c(4)
tx = w(wct).x2 - w(wct).xx: ty = w(wct).y2 - w(wct).yy
w(wct).wlen = _Hypot(tx, ty)
w(wct).nx = tx / w(wct).wlen 'normalized wall angle
w(wct).ny = ty / w(wct).wlen 'normalized wall angle
Next wct
End Sub
Sub colour1
c(0) = _RGB(0, 100, 0)
c(1) = _RGB(255, 255, 255)
c(2) = _RGB(255, 255, 0)
c(3) = _RGB(255, 0, 0)
c(4) = _RGB(0, 255, 0)
c(5) = _RGB(0, 255, 255)
c(6) = _RGB(255, 0, 255)
c(7) = _RGB(30, 30, 255)
c(8) = _RGB(150, 150, 250)
c(9) = _RGB(250, 150, 150)
c(10) = _RGB(150, 250, 150)
c(11) = _RGB(255, 255, 255)
c(12) = _RGB(255, 255, 0)
c(13) = _RGB(255, 0, 0)
c(14) = _RGB(0, 255, 0)
c(15) = _RGB(0, 255, 255)
c(16) = _RGB(255, 0, 255)
c(17) = _RGB(30, 30, 255)
c(18) = _RGB(150, 150, 250)
c(19) = _RGB(250, 150, 150)
c(20) = _RGB(150, 250, 150)
c(21) = _RGB(255, 255, 255)
c(22) = _RGB(255, 255, 0)
c(23) = _RGB(255, 0, 0)
c(24) = _RGB(0, 255, 0)
c(25) = _RGB(0, 255, 255)
c(26) = _RGB(255, 0, 255)
c(27) = _RGB(30, 30, 255)
c(28) = _RGB(150, 150, 250)
c(29) = _RGB(250, 150, 150)
c(30) = _RGBA(0, 0, 0, 5)
End SubRE: Angle Collisions - bplus - 10-30-2022
"I'm curious about how fast objects (like bullets) are kept from going through walls, and of course reflect as well. I'm guessing it's with line intersections but we'll see."
Aren't bullets just like a little circle (more elliptical but circle close enough eg cannon balls and musket balls... circles are best shape for flying, not so much landing though).
If you really did have to do Line (segment) intersect Line (segment) don't mistake for line intersect line which we learned to solve in Algebra. That method assumes infinity long lines. I first used that with your problem of jagged edges and the ball ended up way more limited where it could go inside the container. See early on in this thread.