10-30-2022, 04:41 PM
(This post was last modified: 10-30-2022, 05:00 PM by james2464.
Edit Reason: Program controls were backwards
)
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 Sub