Posts: 230
Threads: 25
Joined: Aug 2022
Reputation:
23
10-30-2022, 06:25 PM
(This post was last modified: 10-30-2022, 06:25 PM by james2464.)
Yeah honestly I'm not sure what the solution looks like for fast objects that collide...I'm just guessing it's line/line because you can maybe detect ahead of time where it will hit, rather than what I'm doing now which is just step by step. So something like a fast bullet (round shape or whatever) probably needs a different method that can see ahead to know how far away the wall is. Hoping to understand this eventually.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
I think I mentioned before don't have speed > radius maybe even .5 * radius, it could jump out of the radius circle detection of the circle location. A bullet is more like a point which is a very small circle.
b = b + ...
Posts: 230
Threads: 25
Joined: Aug 2022
Reputation:
23
(10-30-2022, 06:31 PM)bplus Wrote: I think I mentioned before don't have speed > radius maybe even .5 * radius, it could jump out of the radius circle detection of the circle location. A bullet is more like a point which is a very small circle.
Yes this is very true. And that's why I wonder how to be able to go faster than .5 * radius. A small bullet would be speeding maybe 100* radius. Interesting.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
10-30-2022, 06:45 PM
(This post was last modified: 10-30-2022, 06:46 PM by bplus.)
Good question now you are making me think...
Ah I usually worry about circle Intersect circle the easiest collision detection IMHO. For that you look at 2 radius the bullet almost nothing but also the radius of targets... Catching bullets at border "use to be" just seeing if the new bullet x,y was past a line border. "Use to be" before some crazy guy came up with jagged borders!
b = b + ...
Posts: 230
Threads: 25
Joined: Aug 2022
Reputation:
23
Ok so here is basically the same program, modified into a hockey game. An example of a possible need to use another type of collision detection, for faster moving objects.
Code: (Select All) 'AI HOCKEY demo
'(AI = approaching idiot)
'james2464
'CONTROLS:
'Space Bar : Faceoff at center ice
'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 = 3 'ball radius
walltotal = 12
For t = 1 To walltotal
w(t).b = ballrad + 2
Next t
Dim Shared home, visitor As Integer
home = 0
visitor = 0
wallsetup
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
'start
xv01 = (Rnd * 2 - 1) * 10
yv01 = (Rnd * 2 - 1) * 10
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 > (770 - ballrad) Then
If sby > 270 Then
If sby < 330 Then
Locate 5, 49
Print "GOAL"
Color c(1)
_Display
visitor = visitor + 1
_Delay 1.
faceoff
End If
End If
End If
If sbx < (30 + ballrad) Then
If sby > 270 Then
If sby < 330 Then
Locate 5, 49
Print "GOAL"
Color c(1)
_Display
home = home + 1
_Delay 1.
faceoff
End If
End If
End If
If sbx > (770 - ballrad) Then
xv = xv * -.9
t = sbx - (770 - ballrad)
sbx = sbx - t
End If
If sby > (500 - ballrad) Then
yv = yv * -.9
t = sby - (500 - ballrad)
sby = sby - t
End If
If sbx < (30 + ballrad) Then
xv = xv * -.9
t = (30 + ballrad) - sbx
sbx = sbx + t
End If
If sby < (100 + ballrad) Then
yv = yv * -.9
t = (100 + ballrad) - sby
sby = sby + t
End If
'=====================================================
'player movements - random plus
For p = 1 To 10
tdx = sbx - w(p).x1: tdy = sby - w(p).y1: tdh = _Hypot(tdx, tdy)
If tdh < 100 Then 'move toward the puck if it's nearby
If sbx > w(p).x1 Then
w(p).x1 = w(p).x1 + 5: w(p).x2 = w(p).x2 + 5
Else
w(p).x1 = w(p).x1 - 5: w(p).x2 = w(p).x2 - 5
End If
If sby > w(p).y1 Then
w(p).y1 = w(p).y1 + 3: w(p).y2 = w(p).y2 + 3
Else
w(p).y1 = w(p).y1 - 3: w(p).y2 = w(p).y2 - 3
End If
Else
xp = Rnd * 10 - 5: yp = Rnd * 6 - 3 'random movement
End If
If tdh < 7 Then 'shoot puck
If p < 6 Then
xv = xv - 7
Else
xv = xv + 7
End If
End If
w(p).x1 = w(p).x1 + xp: w(p).x2 = w(p).x2 + xp
w(p).y1 = w(p).y1 + yp: w(p).y2 = w(p).y2 + yp
If w(p).x1 < 35 Then
w(p).x1 = w(p).x1 + 10: w(p).x2 = w(p).x2 + 10
End If
If w(p).x1 > 765 Then
w(p).x1 = w(p).x1 - 10: w(p).x2 = w(p).x2 - 10
End If
If w(p).y1 < 105 Then
w(p).y1 = w(p).y1 + 10: w(p).y2 = w(p).y2 + 10
End If
If w(p).y2 > 495 Then
w(p).y1 = w(p).y1 - 10: w(p).y2 = w(p).y2 - 10
End If
Next p
'goalie movements - follow puck
If sby > 300 Then
w(11).y1 = w(11).y1 + 3: w(11).y2 = w(11).y2 + 3
w(12).y1 = w(12).y1 + 3: w(12).y2 = w(12).y2 + 3
End If
If sby < 300 Then
w(11).y1 = w(11).y1 - 3: w(11).y2 = w(11).y2 - 3
w(12).y1 = w(12).y1 - 3: w(12).y2 = w(12).y2 - 3
End If
'limits
If w(11).y1 < 270 Then
w(11).y1 = w(11).y1 + 3: w(11).y2 = w(11).y2 + 3
End If
If w(11).y1 > 300 Then
w(11).y1 = w(11).y1 - 3: w(11).y2 = w(11).y2 - 3
End If
If w(12).y1 < 270 Then
w(12).y1 = w(12).y1 + 3: w(12).y2 = w(12).y2 + 3
End If
If w(12).y1 > 300 Then
w(12).y1 = w(12).y1 - 3: w(12).y2 = w(12).y2 - 3
End If
wallupdate
'=====================================================
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(0) 'screen location of ball
Paint (sbx, sby), c(0), c(0)
'_Delay .5 'use to step through animation to see each frame separately
h = _Hypot(xv, yv)
If h > 12 Then
yv = yv * .95
xv = xv * .95
End If
If _KeyDown(32) Then ' IF space bar was pressed
faceoff
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 faceoff
Cls
_Delay 1.
wallsetup
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
ballrad = 3
xv = (Rnd * 2 - 1) * 10
yv = (Rnd * 2 - 1) * 10
sbx = 400 'starting x position
sby = 300 'starting y position
End Sub
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
'outer border
Line (30, 100)-(770, 500), c(11), BF
'goal
Line (30, 270)-(20, 330), c(1), B
Line (770, 270)-(780, 330), c(1), B
'center line
Line (395, 100)-(405, 500), c(13), BF
'blue line
Line (295, 100)-(305, 500), c(17), BF
Line (495, 100)-(505, 500), c(17), BF
'goal line
Line (30, 100)-(35, 500), c(13), BF
Line (30, 270)-(60, 330), c(13), B
Line (765, 100)-(770, 500), c(13), BF
Line (740, 270)-(770, 330), c(13), B
'skaters
w(1).x1 = 110: w(1).x2 = 100: w(1).y1 = 200: w(1).y2 = 220
w(2).x1 = 100: w(2).x2 = 110: w(2).y1 = 350: w(2).y2 = 370
w(3).x1 = 250: w(3).x2 = 245: w(3).y1 = 200: w(3).y2 = 220
w(4).x1 = 245: w(4).x2 = 250: w(4).y1 = 350: w(4).y2 = 370
w(5).x1 = 300: w(5).x2 = 300: w(5).y1 = 270: w(5).y2 = 290
w(6).x1 = 660: w(6).x2 = 670: w(6).y1 = 200: w(6).y2 = 220
w(7).x1 = 670: w(7).x2 = 660: w(7).y1 = 350: w(7).y2 = 370
w(8).x1 = 515: w(8).x2 = 520: w(8).y1 = 200: w(8).y2 = 220
w(9).x1 = 520: w(9).x2 = 515: w(9).y1 = 350: w(9).y2 = 370
w(10).x1 = 470: w(10).x2 = 470: w(10).y1 = 270: w(10).y2 = 290
'goalies
w(11).x1 = 40: w(11).x2 = 40: w(11).y1 = 285: w(11).y2 = 315
w(12).x1 = 760: w(12).x2 = 760: w(12).y1 = 285: w(12).y2 = 315
'rink corners
'w(13).x1 = 29: w(13).x2 = 90: w(13).y1 = 160: w(13).y2 = 99
'w(14).x1 = 770: w(14).x2 = 710: w(14).y1 = 160: w(14).y2 = 100
'w(15).x1 = 770: w(15).x2 = 710: w(15).y1 = 440: w(15).y2 = 500
'w(16).x1 = 30: w(16).x2 = 90: w(16).y1 = 440: w(16).y2 = 500
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
'If wct > 12 Then
'Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(1) 'rink corners
'End If
'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
Circle (400, 300), 10, c(13)
Circle (400, 300), 80, c(13)
End Sub
Sub wallupdate
Locate 3, 20
Print "Visitor: "; visitor
Locate 3, 65
Print "Home: "; home
'outer border
Line (30, 100)-(770, 500), c(1), B
For wct = 1 To 12
Select Case wct
Case Is < 6
Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(3)
Case 11
Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(3)
Case Else
Line (w(wct).x1, w(wct).y1)-(w(wct).x2, w(wct).y2), c(7)
End Select
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
Select Case wct
Case Is < 6
Circle (w(wct).xx, w(wct).yy), 3, c(3)
Case 11
Circle (w(wct).xx, w(wct).yy), 3, c(3)
Case Else
Circle (w(wct).xx, w(wct).yy), 3, c(7)
End Select
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, 0, 0)
c(1) = _RGB(255, 255, 255)
c(2) = _RGB(255, 255, 0)
c(3) = _RGB(100, 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, 100)
c(8) = _RGB(150, 150, 250)
c(9) = _RGB(250, 150, 150)
c(10) = _RGB(150, 250, 150)
c(11) = _RGB(150, 150, 150)
c(12) = _RGB(255, 255, 0)
c(13) = _RGBA(100, 0, 0, 150)
c(14) = _RGB(0, 255, 0)
c(15) = _RGB(0, 255, 255)
c(16) = _RGB(255, 0, 255)
c(17) = _RGBA(30, 30, 100, 150)
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
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
10-31-2022, 01:52 AM
Oh man that is cute! I gotta try that with circle players.
b = b + ...
Posts: 296
Threads: 14
Joined: Jul 2022
Reputation:
15
@james2464
very fine hockey autoplay!
I cannot prove it , but it seems sometimes the ball goes trough the goalkeeper.
@Bplus
strange the effect of end of line stucking the bouncing!
Running your code I have noticed that stucking of ball on a penisula is a switching between 2 lines but there is no moves
moreover the 2 status of bouncing ball have the same blu vector....
Posts: 40
Threads: 2
Joined: May 2022
11-01-2022, 03:03 AM
(This post was last modified: 11-01-2022, 04:06 AM by triggered.)
Alright here's how you do angle collisions. To do it right, you need to (i) conserve momentum, and (ii) conserve energy. If you're a real mac daddy, you can reflect shapes with arbitrary boundaries (so long as they're closed), AND create and manipulate new shapes while the program is running. This program does all four. It was written before my Option Explicit days so I don't stand by the style and I don't update it anymore. It perfects collisions but does not quite do condensed matter particularly well.
Code: (Select All) ' Display
Screen _NewImage(800, 600, 32)
_ScreenMove (_DesktopWidth \ 2 - _Width \ 2) - 3, (_DesktopHeight \ 2 - _Height \ 2) - 29
_Title "Collisions - Version 9"
_Delay 1
' Meta
start:
Clear
Cls
Randomize Timer
' Data structures
Type Vector
x As Double
y As Double
End Type
Dim Shared vtemp As Vector
' Object type
Type Object
Centroid As Vector
Collisions As Long
CollisionSwitch As Integer
DeltaO As Double
DeltaV As Vector
Diameter As Double
Elements As Integer
Fixed As Integer
Mass As Double
MOI As Double
PartialNormal As Vector
Omega As Double
Shade As _Unsigned Long
Velocity As Vector
End Type
' Object storage
Dim Shared Shape(300) As Object
Dim Shared PointChain(300, 500) As Vector
Dim Shared TempChain(300, 500) As Vector
Dim Shared ShapeCount As Integer
Dim Shared SelectedShape As Integer
' Dynamics
Dim Shared CollisionCount As Integer
Dim Shared ProximalPairs(300 / 2, 1 To 2) As Integer
Dim Shared ProximalPairsCount As Integer
Dim Shared ContactPoints As Integer
Dim Shared CPC, FPC, RST, VD, SV As Double
' Environment
Dim Shared ForceField As Vector ' Ex: gravity
' Initialize
ShapeCount = 0
CollisionCount = 0
' Prompt
Cls
Call cprintstring(16 * 17, "WELCOME! ")
Call cprintstring(16 * 16, "Press 1 for Pool prototype ")
Call cprintstring(16 * 15, "Press 2 for Wacky game ")
Call cprintstring(16 * 14, "Press 3 for Concentric rings")
Call cprintstring(16 * 13, "Press 4 for Walls only ")
Call cprintstring(16 * 12, "Press 5 for Angle pong game ")
_Display
'_KeyClear
'Do
' kk = _KeyHit
' Select Case kk
' Case Asc("1")
' Call SetupPoolGame
' Exit Do
' Case Asc("2")
' Call SetupWackyGame
' Exit Do
' Case Asc("3")
' Call SetupRings
' Exit Do
' Case Asc("4")
' Call SetupWallsOnly
' Exit Do
' Case Asc("5")
' Call SetupAnglePong
' Exit Do
' Case Else
' _KeyClear
' End Select
' _Limit 60
'Loop
Call SetupAnglePong
Call Graphics
Call cprintstring(-16 * 4, "During Play:")
Call cprintstring(-16 * 6, "Move mouse to select closest object (by centroid).")
Call cprintstring(-16 * 7, "Boost velocity with arrow keys or W/S/A/D. ")
Call cprintstring(-16 * 8, "Boost angluar velocity with Q/E. ")
Call cprintstring(-16 * 9, "Drag and fling object with Mouse 1. ")
Call cprintstring(-16 * 10, "Rotate selected object with Mousewheel. ")
Call cprintstring(-16 * 11, "Halt all motion with ESC. ")
Call cprintstring(-16 * 12, "Create new ball with Mouse 2. ")
Call cprintstring(-16 * 13, "Initiate creative mode with SPACE. ")
Call cprintstring(-16 * 14, "Restart by pressing R during motion. ")
Call cprintstring(-16 * 16, "PRESS ANY KEY TO BEGIN.")
_Display
Do: Loop Until (_KeyHit > 0)
While (_MouseInput): Wend
_KeyClear
' Main loop
Do
If (UserInput = -1) Then GoTo start
Call PairDynamics(CPC, FPC, RST)
Call FleetDynamics(VD, SV)
Call Graphics
_Limit 120
Loop
End
Function UserInput
TheReturn = 0
' Keyboard input
kk = _KeyHit
Select Case kk
Case 32
Do: Loop Until _KeyHit
While _MouseInput: Wend
_KeyClear
Call cprintstring(16 * 17, "Drag Mouse 1 counter-clockwise to draw a new shape.")
Call cprintstring(16 * 16, "Make sure centroid is inside body. ")
Call NewMouseShape(7.5, 150, 15)
Cls
Case 18432, Asc("w"), Asc("W") ' Up arrow
Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 1.05 + 1.5
Case 20480, Asc("s"), Asc("S") ' Down arrow
Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 0.95 - 1.5
Case 19200, Asc("a"), Asc("A") ' Left arrow
Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 0.95 - 1.5
Case 19712, Asc("d"), Asc("D") ' Right arrow
Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 1.05 + 1.5
Case Asc("e"), Asc("E")
Shape(SelectedShape).Omega = Omega * 0.5 - .02
Case Asc("q"), Asc("Q")
Shape(SelectedShape).Omega = Omega * 1.5 + .02
Case Asc("r"), Asc("R")
TheReturn = -1
Case 27
For k = 1 To ShapeCount
Shape(k).Velocity.x = .000001 * (Rnd - .5)
Shape(k).Velocity.y = .000001 * (Rnd - .5)
Shape(k).Omega = .000001 * (Rnd - .5)
Next
End Select
If (kk) Then
_KeyClear
End If
' Mouse input
mb = 0
mxold = 999999999
myold = 999999999
Do While _MouseInput
x = _MouseX
y = _MouseY
If (x > 0) And (x < _Width) And (y > 0) And (y < _Height) Then
x = x - (_Width / 2)
y = -y + (_Height / 2)
rmin = 999999999
For k = 1 To ShapeCount
dx = x - Shape(k).Centroid.x
dy = y - Shape(k).Centroid.y
r2 = dx * dx + dy * dy
If (r2 < rmin) Then
rmin = r2
SelectedShape = k
End If
Next
If (_MouseButton(1)) Then
If (mb = 0) Then
mb = 1
vtemp.x = x - Shape(SelectedShape).Centroid.x
vtemp.y = y - Shape(SelectedShape).Centroid.y
Call TranslateShape(SelectedShape, vtemp)
Shape(SelectedShape).Velocity.x = 0
Shape(SelectedShape).Velocity.y = 0
Shape(SelectedShape).Omega = 0
mxold = x
myold = y
End If
End If
If (_MouseButton(2)) Then
If (mb = 0) Then
mb = 1
Call NewAutoBall(x, y, 15, 0, 1, 1, 0)
_Delay .1
End If
End If
If (_MouseWheel > 0) Then
Call RotShape(SelectedShape, Shape(SelectedShape).Centroid, -.02 * 8 * Atn(1))
End If
If (_MouseWheel < 0) Then
Call RotShape(SelectedShape, Shape(SelectedShape).Centroid, .02 * 8 * Atn(1))
End If
End If
Loop
If ((mxold <> 999999999) And (myold <> 999999999)) Then
Shape(SelectedShape).Velocity.x = x - mxold
Shape(SelectedShape).Velocity.y = y - myold
End If
UserInput = TheReturn
End Function
Sub PairDynamics (CoarseProximityConstant As Double, FineProximityConstant As Double, Restitution As Double)
Dim GrossJ(300) As Integer
Dim GrossK(300) As Integer
Dim NumJK As Integer
' Proximity detection
ProximalPairsCount = 0
Shape1 = 0
Shape2 = 0
For j = 1 To ShapeCount
Shape(j).CollisionSwitch = 0
Shape(j).DeltaO = 0
Shape(j).DeltaV.x = 0
Shape(j).DeltaV.y = 0
Shape(j).PartialNormal.x = 0
Shape(j).PartialNormal.y = 0
For k = j + 1 To ShapeCount
dx = Shape(j).Centroid.x - Shape(k).Centroid.x
dy = Shape(j).Centroid.y - Shape(k).Centroid.y
dr = Sqr(dx * dx + dy * dy)
If (dr < (CoarseProximityConstant) * (Shape(j).Diameter + Shape(k).Diameter)) Then
ProximalPairsCount = ProximalPairsCount + 1
ProximalPairs(ProximalPairsCount, 1) = j
ProximalPairs(ProximalPairsCount, 2) = k
'Shape1 = j
'Shape2 = k
End If
Next
Next
ContactPoints = 0
If (ProximalPairsCount > 0) Then
For n = 1 To ProximalPairsCount
Shape1 = ProximalPairs(n, 1)
Shape2 = ProximalPairs(n, 2)
' Collision detection
rmin = 999999999
ClosestIndex1 = 0
ClosestIndex2 = 0
NumJK = 0
For j = 1 To Shape(Shape1).Elements
For k = 1 To Shape(Shape2).Elements
dx = PointChain(Shape1, j).x - PointChain(Shape2, k).x
dy = PointChain(Shape1, j).y - PointChain(Shape2, k).y
r2 = dx * dx + dy * dy
If (r2 <= FineProximityConstant) Then
ContactPoints = ContactPoints + 1
' Partial normal vector 1
nx1 = CalculateNormalY(Shape1, j)
ny1 = -CalculateNormalX(Shape1, j)
nn = Sqr(nx1 * nx1 + ny1 * ny1)
nx1 = nx1 / nn
ny1 = ny1 / nn
Shape(Shape1).PartialNormal.x = Shape(Shape1).PartialNormal.x + nx1
Shape(Shape1).PartialNormal.y = Shape(Shape1).PartialNormal.y + ny1
' Partial normal vector 2
nx2 = CalculateNormalY(Shape2, k)
ny2 = -CalculateNormalX(Shape2, k)
nn = Sqr(nx2 * nx2 + ny2 * ny2)
nx2 = nx2 / nn
ny2 = ny2 / nn
Shape(Shape2).PartialNormal.x = Shape(Shape2).PartialNormal.x + nx2
Shape(Shape2).PartialNormal.y = Shape(Shape2).PartialNormal.y + ny2
NumJK = NumJK + 1
GrossJ(NumJK) = j
GrossK(NumJK) = k
End If
If (r2 < rmin) Then
rmin = r2
ClosestIndex1 = j
ClosestIndex2 = k
End If
Next
Next
If (NumJK > 1) Then
If ((GrossJ(1) - GrossJ(NumJK)) * (GrossJ(1) - GrossJ(NumJK)) > 50) Then
'ClosestIndex1 = 1
Else
ClosestIndex1 = Int(IntegrateArray(GrossJ(), NumJK) / NumJK)
End If
If ((GrossK(1) - GrossK(NumJK)) * (GrossK(1) - GrossK(NumJK)) > 50) Then
'ClosestIndex2 = 1
Else
ClosestIndex2 = Int(IntegrateArray(GrossK(), NumJK) / NumJK)
End If
End If
If (rmin <= FineProximityConstant) Then
CollisionCount = CollisionCount + 1
Shape(Shape1).CollisionSwitch = 1
Shape(Shape2).CollisionSwitch = 1
' Undo previous motion
If (Shape(Shape1).Collisions = 0) Then
Call RotShape(Shape1, Shape(Shape1).Centroid, -1 * Shape(Shape1).Omega)
vtemp.x = -1 * (Shape(Shape1).Velocity.x)
vtemp.y = -1 * (Shape(Shape1).Velocity.y)
Call TranslateShape(Shape1, vtemp)
End If
If (Shape(Shape2).Collisions = 0) Then
Call RotShape(Shape2, Shape(Shape2).Centroid, -1 * Shape(Shape2).Omega)
vtemp.x = -1 * (Shape(Shape2).Velocity.x)
vtemp.y = -1 * (Shape(Shape2).Velocity.y)
Call TranslateShape(Shape2, vtemp)
End If
' Momentum absorption
If (Shape(Shape1).Collisions = 0) Then
Shape(Shape1).Velocity.x = Shape(Shape1).Velocity.x * Restitution
Shape(Shape1).Velocity.y = Shape(Shape1).Velocity.y * Restitution
End If
If (Shape(Shape2).Collisions = 0) Then
Shape(Shape2).Velocity.x = Shape(Shape2).Velocity.x * Restitution
Shape(Shape2).Velocity.y = Shape(Shape2).Velocity.y * Restitution
End If
' Centroid of object 1 (cx1, cy1)
cx1 = Shape(Shape1).Centroid.x
cy1 = Shape(Shape1).Centroid.y
' Centroid of object 2 (cx2, cy2)
cx2 = Shape(Shape2).Centroid.x
cy2 = Shape(Shape2).Centroid.y
' Contact point on object 1 (px1, py1)
px1 = PointChain(Shape1, ClosestIndex1).x
py1 = PointChain(Shape1, ClosestIndex1).y
' Contact point on object 2 (px2, py2)
px2 = PointChain(Shape2, ClosestIndex2).x
py2 = PointChain(Shape2, ClosestIndex2).y
' Contact-centroid differentials 1 (dx1, dy1)
dx1 = px1 - cx1
dy1 = py1 - cy1
' Contact-centroid differentials 2 (dx2, dy2)
dx2 = px2 - cx2
dy2 = py2 - cy2
' Normal vector 1 (nx1, ny1)
nn = Sqr(Shape(Shape1).PartialNormal.x * Shape(Shape1).PartialNormal.x + Shape(Shape1).PartialNormal.y * Shape(Shape1).PartialNormal.y)
nx1 = Shape(Shape1).PartialNormal.x / nn
ny1 = Shape(Shape1).PartialNormal.y / nn
' Normal vector 2 (nx2, ny2)
nn = Sqr(Shape(Shape2).PartialNormal.x * Shape(Shape2).PartialNormal.x + Shape(Shape2).PartialNormal.y * Shape(Shape2).PartialNormal.y)
nx2 = Shape(Shape2).PartialNormal.x / nn
ny2 = Shape(Shape2).PartialNormal.y / nn
'''
'nx1 = CalculateNormalY(Shape1, ClosestIndex1)
'ny1 = -CalculateNormalX(Shape1, ClosestIndex1)
'nn = SQR(nx1 * nx1 + ny1 * ny1)
'nx1 = nx1 / nn
'ny1 = ny1 / nn
'nx2 = CalculateNormalY(Shape2, ClosestIndex2)
'ny2 = -CalculateNormalX(Shape2, ClosestIndex2)
'nn = SQR(nx2 * nx2 + ny2 * ny2)
'nx2 = nx2 / nn
'ny2 = ny2 / nn
'''
' Perpendicular vector 1 (prx1, pry1)
prx1 = -1 * dy1
pry1 = dx1
pp = Sqr(prx1 * prx1 + pry1 * pry1)
prx1 = prx1 / pp
pry1 = pry1 / pp
' Perpendicular vector 2 (prx2, pry2)
prx2 = -1 * dy2
pry2 = dx2
pp = Sqr(prx2 * prx2 + pry2 * pry2)
prx2 = prx2 / pp
pry2 = pry2 / pp
' Angular velocity vector 1 (w1, r1, vx1, vy1)
w1 = Shape(Shape1).Omega
r1 = Sqr(dx1 * dx1 + dy1 * dy1)
vx1 = w1 * r1 * prx1
vy1 = w1 * r1 * pry1
' Angular velocity vector 2 (w2, r2, vx2, vy2)
w2 = Shape(Shape2).Omega
r2 = Sqr(dx2 * dx2 + dy2 * dy2)
vx2 = w2 * r2 * prx2
vy2 = w2 * r2 * pry2
' Mass terms (m1, m2, mu)
m1 = Shape(Shape1).Mass
m2 = Shape(Shape2).Mass
mu = 1 / (1 / m1 + 1 / m2)
' Re-Calculate moment of inertia (i1, i2)
vtemp.x = px1
vtemp.y = py1
Call CalculateMOI(Shape1, vtemp)
vtemp.x = px2
vtemp.y = py2
Call CalculateMOI(Shape2, vtemp)
i1 = Shape(Shape1).MOI
i2 = Shape(Shape2).MOI
' Velocity differentials (v1, v2, dvtx, dvty)
vcx1 = Shape(Shape1).Velocity.x
vcy1 = Shape(Shape1).Velocity.y
vcx2 = Shape(Shape2).Velocity.x
vcy2 = Shape(Shape2).Velocity.y
vtx1 = vcx1 + vx1
vty1 = vcy1 + vy1
vtx2 = vcx2 + vx2
vty2 = vcy2 + vy2
v1 = Sqr(vtx1 * vtx1 + vty1 * vty1)
v2 = Sqr(vtx2 * vtx2 + vty2 * vty2)
dvtx = vtx2 - vtx1
dvty = vty2 - vty1
' Geometry (n1dotdvt, n2dotdvt)
n1dotdvt = nx1 * dvtx + ny1 * dvty
n2dotdvt = nx2 * dvtx + ny2 * dvty
' Momentum exchange (qx1, qy1, qx2, qy2)
qx1 = nx1 * 2 * mu * n1dotdvt
qy1 = ny1 * 2 * mu * n1dotdvt
qx2 = nx2 * 2 * mu * n2dotdvt
qy2 = ny2 * 2 * mu * n2dotdvt
' Momentum exchange unit vector (qhat)
qq = Sqr(qx1 * qx1 + qy1 * qy1)
If (qx1 * qx1 > 0.01) Then
qhatx1 = qx1 / qq
Else
qx1 = 0
qhatx1 = 0
End If
If (qy1 * qy1 > 0.01) Then
qhaty1 = qy1 / qq
Else
qy1 = 0
qhaty1 = 0
End If
qq = Sqr(qx2 * qx2 + qy2 * qy2)
If (qx2 * qx2 > 0.01) Then
qhatx2 = qx2 / qq
Else
qx2 = 0
qhatx2 = 0
End If
If (qy2 * qy2 > 0.01) Then
qhaty2 = qy2 / qq
Else
qy2 = 0
qhaty2 = 0
End If
' Angular impulse (qdotp)
q1dotp1 = qx1 * prx1 + qy1 * pry1
q2dotp2 = qx2 * prx2 + qy2 * pry2
' Translational impulse (qdotn, ndotrhat, f)
q1dotn1 = qhatx1 * nx1 + qhaty1 * ny1
q2dotn2 = qhatx2 * nx2 + qhaty2 * ny2
n1dotr1hat = (nx1 * dx1 + ny1 * dy1) / r1
n2dotr2hat = (nx2 * dx2 + ny2 * dy2) / r2
f1 = -q1dotn1 * n1dotr1hat
f2 = -q2dotn2 * n2dotr2hat
' Special case for shape within shape.
np = nx1 * nx2 + ny1 * ny2
If (np > 0) Then
dcx = cx1 - cx2
dcy = cy1 - cy2
dc = Sqr(dcx * dcx + dcy * dcy)
If (dc < (r1 + r2)) Then
If (m1 > m2) Then ' This criteria may be bullshit in general but works now.
q1dotp1 = -q1dotp1
f1 = -f1
Else
q2dotp2 = -q2dotp2
f2 = -f2
End If
End If
End If
' Angular impulse update (edits omega)
Shape(Shape1).DeltaO = Shape(Shape1).DeltaO + r1 * q1dotp1 / i1
Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - r2 * q2dotp2 / i2
' Linear impulse update (edits velocity)
dvx1 = f1 * qx1 / m1
dvy1 = f1 * qy1 / m1
dvx2 = f2 * qx2 / m2
dvy2 = f2 * qy2 / m2
dvx1s = dvx1 * dvx1
dvy1s = dvy1 * dvy1
dvx2s = dvx2 * dvx2
dvy2s = dvy2 * dvy2
If ((dvx1s > .001) And (dvx1s < 50)) Then
Shape(Shape1).DeltaV.x = Shape(Shape1).DeltaV.x + dvx1
End If
If ((dvy1s > .001) And (dvy1s < 50)) Then
Shape(Shape1).DeltaV.y = Shape(Shape1).DeltaV.y + dvy1
End If
If ((dvx2s > .001) And (dvx2s < 50)) Then
Shape(Shape2).DeltaV.x = Shape(Shape2).DeltaV.x + dvx2
End If
If ((dvy2s > .001) And (dvy2s < 50)) Then
Shape(Shape2).DeltaV.y = Shape(Shape2).DeltaV.y + dvy2
End If
' External torque (edits omega)
torque1 = m1 * (dx1 * ForceField.y - dy1 * ForceField.x)
torque2 = m2 * (dx2 * ForceField.y - dy2 * ForceField.x)
Shape(Shape1).DeltaO = Shape(Shape1).DeltaO - torque1 / i1
Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - torque2 / i2
' Separate along normal (edits position)
If (Shape(Shape1).Collisions < 2) Then ' changed from = 0
vtemp.x = -nx1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
vtemp.y = -ny1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
Call TranslateShape(Shape1, vtemp)
End If
If (Shape(Shape2).Collisions < 2) Then
vtemp.x = -nx2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
vtemp.y = -ny2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
Call TranslateShape(Shape2, vtemp)
End If
' Dent along normal
'PointChain(Shape1, ClosestIndex1).x = PointChain(Shape1, ClosestIndex1).x - v1 * nx1 / 2
'PointChain(Shape1, ClosestIndex1).y = PointChain(Shape1, ClosestIndex1).y - v1 * ny1 / 2
'PointChain(Shape2, ClosestIndex2).x = PointChain(Shape2, ClosestIndex2).x - v2 * nx2 / 2
'PointChain(Shape2, ClosestIndex2).y = PointChain(Shape2, ClosestIndex2).y - v2 * ny2 / 2
' Feedback
If ((Shape(Shape1).Collisions = 0) And (Shape(Shape2).Collisions = 0)) Then
Call snd(100 * (v1 + v2) / 2, .5)
End If
End If
Next
End If
End Sub
Sub FleetDynamics (MotionDamping As Double, LowLimitVelocity As Double)
For ShapeIndex = 1 To ShapeCount
' Contact update
If (Shape(ShapeIndex).CollisionSwitch = 1) Then
Shape(ShapeIndex).Collisions = Shape(ShapeIndex).Collisions + 1
Else
Shape(ShapeIndex).Collisions = 0
End If
If (Shape(ShapeIndex).Fixed = 0) Then
' Angular velocity update
Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega + Shape(ShapeIndex).DeltaO
' Linear velocity update
Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + Shape(ShapeIndex).DeltaV.x
Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + Shape(ShapeIndex).DeltaV.y
If (Shape(ShapeIndex).Collisions = 0) Then
' Freefall (if airborne)
Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + ForceField.x
Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + ForceField.y
End If
If (Shape(ShapeIndex).Collisions > 2) Then
' Static friction
If ((Shape(ShapeIndex).Velocity.x * Shape(ShapeIndex).Velocity.x) < LowLimitVelocity) Then
Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * .05
End If
If ((Shape(ShapeIndex).Velocity.y * Shape(ShapeIndex).Velocity.y) < LowLimitVelocity) Then
Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * .05
End If
If ((Shape(ShapeIndex).Omega * Shape(ShapeIndex).Omega) < .000015 * LowLimitVelocity) Then
Shape(ShapeIndex).Omega = 0
End If
End If
' Rotation update
Call RotShape(ShapeIndex, Shape(ShapeIndex).Centroid, Shape(ShapeIndex).Omega)
' Position update
Call TranslateShape(ShapeIndex, Shape(ShapeIndex).Velocity)
' Motion Damping
Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * MotionDamping
Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * MotionDamping
Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega * MotionDamping
Else
' Lock all motion
Shape(ShapeIndex).Velocity.x = 0
Shape(ShapeIndex).Velocity.y = 0
Shape(ShapeIndex).Omega = 0
End If
Next
End Sub
Sub Graphics
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 200), BF
'Locate 1, 1: Print ProximalPairsCount, CollisionCount, ContactPoints
For ShapeIndex = 1 To ShapeCount
For i = 1 To Shape(ShapeIndex).Elements - 1
Call cpset(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, Shape(ShapeIndex).Shade)
Call cline(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, PointChain(ShapeIndex, i + 1).x, PointChain(ShapeIndex, i + 1).y, Shape(ShapeIndex).Shade)
If (ShapeIndex = SelectedShape) Then
Call ccircle(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, 1, Shape(ShapeIndex).Shade)
End If
Next
Call cpset(PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
Call cline(PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
Call cline(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, Shape(ShapeIndex).Shade)
If (ShapeIndex = SelectedShape) Then
Call ccircle(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, 3, Shape(ShapeIndex).Shade)
Call cpaint(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, Shape(ShapeIndex).Shade, Shape(ShapeIndex).Shade)
End If
Next
_Display
End Sub
Function IntegrateArray (arr() As Integer, lim As Integer)
t = 0
For j = 1 To lim
t = t + arr(j)
Next
IntegrateArray = t
End Function
Function CalculateNormalX (k As Integer, i As Integer)
Dim l As Vector
Dim r As Vector
li = i - 1
ri = i + 1
If (i = 1) Then li = Shape(k).Elements
If (i = Shape(k).Elements) Then ri = 1
l.x = PointChain(k, li).x
r.x = PointChain(k, ri).x
dx = r.x - l.x
CalculateNormalX = dx
End Function
Function CalculateNormalY (k As Integer, i As Integer)
Dim l As Vector
Dim r As Vector
li = i - 1
ri = i + 1
If (i = 1) Then li = Shape(k).Elements
If (i = Shape(k).Elements) Then ri = 1
l.y = PointChain(k, li).y
r.y = PointChain(k, ri).y
dy = r.y - l.y
CalculateNormalY = dy
End Function
Sub CalculateCentroid (k As Integer)
xx = 0
yy = 0
For i = 1 To Shape(k).Elements
xx = xx + PointChain(k, i).x
yy = yy + PointChain(k, i).y
Next
Shape(k).Centroid.x = xx / Shape(k).Elements
Shape(k).Centroid.y = yy / Shape(k).Elements
End Sub
Sub CalculateDiameter (k As Integer)
r2max = -1
For i = 1 To Shape(k).Elements
xx = Shape(k).Centroid.x - PointChain(k, i).x
yy = Shape(k).Centroid.y - PointChain(k, i).y
r2 = xx * xx + yy * yy
If (r2 > r2max) Then
r2max = r2
End If
Next
Shape(k).Diameter = Sqr(r2max)
End Sub
Sub CalculateMass (k As Integer, factor As Double)
aa = 0
For i = 2 To Shape(k).Elements
x = PointChain(k, i).x - Shape(k).Centroid.x
y = PointChain(k, i).y - Shape(k).Centroid.y
dx = (PointChain(k, i).x - PointChain(k, i - 1).x)
dy = (PointChain(k, i).y - PointChain(k, i - 1).y)
da = .5 * (x * dy - y * dx)
aa = aa + da
Next
Shape(k).Mass = factor * Sqr(aa * aa)
End Sub
Sub CalculateMOI (k As Integer, ctrvec As Vector)
xx = 0
yy = 0
For i = 1 To Shape(k).Elements
a = ctrvec.x - PointChain(k, i).x
b = ctrvec.y - PointChain(k, i).y
xx = xx + a * a
yy = yy + b * b
Next
Shape(k).MOI = Sqr((xx + yy) * (xx + yy)) * (Shape(k).Mass / Shape(k).Elements)
End Sub
Sub TranslateShape (k As Integer, c As Vector)
For i = 1 To Shape(k).Elements
PointChain(k, i).x = PointChain(k, i).x + c.x
PointChain(k, i).y = PointChain(k, i).y + c.y
Next
Shape(k).Centroid.x = Shape(k).Centroid.x + c.x
Shape(k).Centroid.y = Shape(k).Centroid.y + c.y
End Sub
Sub RotShape (k As Integer, c As Vector, da As Double)
For i = 1 To Shape(k).Elements
xx = PointChain(k, i).x - c.x
yy = PointChain(k, i).y - c.y
PointChain(k, i).x = c.x + xx * Cos(da) - yy * Sin(da)
PointChain(k, i).y = c.y + yy * Cos(da) + xx * Sin(da)
Next
End Sub
Sub NewAutoBall (x1 As Double, y1 As Double, r1 As Double, r2 As Double, pa As Double, pb As Double, fx As Integer)
ShapeCount = ShapeCount + 1
Shape(ShapeCount).Fixed = fx
Shape(ShapeCount).Collisions = 0
i = 0
For j = 0 To (8 * Atn(1)) Step .02 * 8 * Atn(1)
i = i + 1
r = r1 + r2 * Cos(pa * j) ^ pb
PointChain(ShapeCount, i).x = x1 + r * Cos(j)
PointChain(ShapeCount, i).y = y1 + r * Sin(j)
Next
Shape(ShapeCount).Elements = i
Call CalculateCentroid(ShapeCount)
If (fx = 0) Then
Call CalculateMass(ShapeCount, 1)
Else
Call CalculateMass(ShapeCount, 999999)
End If
Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
Call CalculateDiameter(ShapeCount)
Shape(ShapeCount).Velocity.x = 0
Shape(ShapeCount).Velocity.y = 0
Shape(ShapeCount).Omega = 0
If (fx = 0) Then
Shape(ShapeCount).Shade = _RGB(100 + Int(Rnd * 155), 100 + Int(Rnd * 155), 100 + Int(Rnd * 155))
Else
Shape(ShapeCount).Shade = _RGB(100, 100, 100)
End If
SelectedShape = ShapeCount
End Sub
Sub NewAutoBrick (x1 As Double, y1 As Double, wx As Double, wy As Double, ang As Double)
ShapeCount = ShapeCount + 1
Shape(ShapeCount).Fixed = 1
Shape(ShapeCount).Collisions = 0
i = 0
For j = -wy / 2 To wy / 2 Step 5
i = i + 1
PointChain(ShapeCount, i).x = x1 + wx / 2
PointChain(ShapeCount, i).y = y1 + j
Next
For j = wx / 2 To -wx / 2 Step -5
i = i + 1
PointChain(ShapeCount, i).x = x1 + j
PointChain(ShapeCount, i).y = y1 + wy / 2
Next
For j = wy / 2 To -wy / 2 Step -5
i = i + 1
PointChain(ShapeCount, i).x = x1 - wx / 2
PointChain(ShapeCount, i).y = y1 + j
Next
For j = -wx / 2 To wx / 2 Step 5
i = i + 1
PointChain(ShapeCount, i).x = x1 + j
PointChain(ShapeCount, i).y = y1 - wy / 2
Next
Shape(ShapeCount).Elements = i
Call CalculateCentroid(ShapeCount)
Call CalculateMass(ShapeCount, 99999)
Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
Call CalculateDiameter(ShapeCount)
Shape(ShapeCount).Velocity.x = 0
Shape(ShapeCount).Velocity.y = 0
Shape(ShapeCount).Omega = 0
Shape(ShapeCount).Shade = _RGB(100, 100, 100)
SelectedShape = ShapeCount
Call RotShape(ShapeCount, Shape(ShapeCount).Centroid, ang)
End Sub
Sub NewBrickLine (xi As Double, yi As Double, xf As Double, yf As Double, wx As Double, wy As Double)
d1 = Sqr((xf - xi) ^ 2 + (yf - yi) ^ 2)
d2 = Sqr(wx ^ 2 + wy ^ 2)
ang = Atn((yf - yi) / (xf - xi))
f = 1.2 * d2 / d1
For t = 0 To 1 + f Step f
Call NewAutoBrick(xi * (1 - t) + xf * t, yi * (1 - t) + yf * t, wx, wy, ang)
Next
End Sub
Sub NewMouseShape (rawresolution As Double, targetpoints As Integer, smoothiterations As Integer)
ShapeCount = ShapeCount + 1
Shape(ShapeCount).Fixed = 0
Shape(ShapeCount).Collisions = 0
numpoints = 0
xold = 999 ^ 999
yold = 999 ^ 999
Do
Do While _MouseInput
x = _MouseX
y = _MouseY
If (x > 0) And (x < _Width) And (y > 0) And (y < _Height) Then
If _MouseButton(1) Then
x = x - (_Width / 2)
y = -y + (_Height / 2)
delta = Sqr((x - xold) ^ 2 + (y - yold) ^ 2)
If (delta > rawresolution) And (numpoints < targetpoints - 1) Then
numpoints = numpoints + 1
PointChain(ShapeCount, numpoints).x = x
PointChain(ShapeCount, numpoints).y = y
Call cpset(x, y, _RGB(0, 255, 255))
xold = x
yold = y
End If
End If
End If
Loop
_Display
Loop Until Not _MouseButton(1) And (numpoints > 1)
Do While (numpoints < targetpoints)
rad2max = -1
kmax = -1
For k = 1 To numpoints - 1
xfac = PointChain(ShapeCount, k).x - PointChain(ShapeCount, k + 1).x
yfac = PointChain(ShapeCount, k).y - PointChain(ShapeCount, k + 1).y
rad2 = xfac ^ 2 + yfac ^ 2
If rad2 > rad2max Then
kmax = k
rad2max = rad2
End If
Next
edgecase = 0
xfac = PointChain(ShapeCount, numpoints).x - PointChain(ShapeCount, 1).x
yfac = PointChain(ShapeCount, numpoints).y - PointChain(ShapeCount, 1).y
rad2 = xfac ^ 2 + yfac ^ 2
If (rad2 > rad2max) Then
kmax = numpoints
rad2max = rad2
edgecase = 1
End If
numpoints = numpoints + 1
If (edgecase = 0) Then
For j = numpoints To kmax + 1 Step -1
PointChain(ShapeCount, j + 1).x = PointChain(ShapeCount, j).x
PointChain(ShapeCount, j + 1).y = PointChain(ShapeCount, j).y
Next
PointChain(ShapeCount, kmax + 1).x = (1 / 2) * (PointChain(ShapeCount, kmax).x + PointChain(ShapeCount, kmax + 2).x)
PointChain(ShapeCount, kmax + 1).y = (1 / 2) * (PointChain(ShapeCount, kmax).y + PointChain(ShapeCount, kmax + 2).y)
Else
PointChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
PointChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
End If
Loop
For j = 1 To smoothiterations
For k = 2 To numpoints - 1
TempChain(ShapeCount, k).x = (1 / 2) * (PointChain(ShapeCount, k - 1).x + PointChain(ShapeCount, k + 1).x)
TempChain(ShapeCount, k).y = (1 / 2) * (PointChain(ShapeCount, k - 1).y + PointChain(ShapeCount, k + 1).y)
Next
For k = 2 To numpoints - 1
PointChain(ShapeCount, k).x = TempChain(ShapeCount, k).x
PointChain(ShapeCount, k).y = TempChain(ShapeCount, k).y
Next
TempChain(ShapeCount, 1).x = (1 / 2) * (PointChain(ShapeCount, numpoints).x + PointChain(ShapeCount, 2).x)
TempChain(ShapeCount, 1).y = (1 / 2) * (PointChain(ShapeCount, numpoints).y + PointChain(ShapeCount, 2).y)
PointChain(ShapeCount, 1).x = TempChain(ShapeCount, 1).x
PointChain(ShapeCount, 1).y = TempChain(ShapeCount, 1).y
TempChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
TempChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
PointChain(ShapeCount, numpoints).x = TempChain(ShapeCount, numpoints).x
PointChain(ShapeCount, numpoints).y = TempChain(ShapeCount, numpoints).y
Next
Shape(ShapeCount).Elements = numpoints
Call CalculateCentroid(ShapeCount)
Call CalculateMass(ShapeCount, 1)
Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
Call CalculateDiameter(ShapeCount)
Shape(ShapeCount).Velocity.x = 0
Shape(ShapeCount).Velocity.y = 0
Shape(ShapeCount).Omega = 0
Shape(ShapeCount).Shade = _RGB(100 + Int(Rnd * 155), 100 + Int(Rnd * 155), 100 + Int(Rnd * 155))
SelectedShape = ShapeCount
End Sub
Sub cline (x1 As Double, y1 As Double, x2 As Double, y2 As Double, col As _Unsigned Long)
Line (_Width / 2 + x1, -y1 + _Height / 2)-(_Width / 2 + x2, -y2 + _Height / 2), col
End Sub
Sub ccircle (x1 As Double, y1 As Double, rad As Double, col As _Unsigned Long)
Circle (_Width / 2 + x1, -y1 + _Height / 2), rad, col
End Sub
Sub cpset (x1 As Double, y1 As Double, col As _Unsigned Long)
PSet (_Width / 2 + x1, -y1 + _Height / 2), col
End Sub
Sub cpaint (x1 As Double, y1 As Double, col1 As _Unsigned Long, col2 As _Unsigned Long)
Paint (_Width / 2 + x1, -y1 + _Height / 2), col1, col2
End Sub
Sub cprintstring (y As Double, a As String)
_PrintString (_Width / 2 - (Len(a) * 8) / 2, -y + _Height / 2), a
End Sub
Sub snd (frq As Double, dur As Double)
If ((frq >= 37) And (frq <= 2000)) Then
Sound frq, dur
End If
End Sub
Sub SetupPoolGame
' Set external field
ForceField.x = 0
ForceField.y = 0
' Rectangular border
wx = 42
wy = 10
Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
wx = 40
wy = 10
Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
' Balls (billiard setup)
x0 = 160
y0 = 0
r = 15
gg = 2 * r + 4
gx = gg * Cos(30 * 3.14159 / 180)
gy = gg * Sin(30 * 3.14159 / 180)
Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 4 * gx, y0 + 4 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 4 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 4 * gx, y0 - 0 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 4 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
Call NewAutoBall(x0 + 4 * gx, y0 - 4 * gy, r, 0, 1, 1, 0)
' Cue ball
Call NewAutoBall(-220, 0, r, 0, 1, 1, 0)
Shape(ShapeCount).Velocity.x = 10 + 2 * Rnd
Shape(ShapeCount).Velocity.y = 1 * (Rnd - .5)
Shape(ShapeCount).Shade = _RGB(255, 255, 255)
' Parameters
CPC = 1.15
FPC = 8
RST = 0.75
VD = 0.995
SV = 0
End Sub
Sub SetupWackyGame
' Set external field
ForceField.x = 0
ForceField.y = -.08
' Rectangular border
wx = 42
wy = 10
Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
wx = 40
wy = 10
Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
' Wacky balls
x0 = -70
y0 = 120
r1 = 15
r2 = 2.5
gg = 2.5 * (r1 + r2) + 3.5
gx = gg * Cos(30 * 3.14159 / 180)
gy = gg * Sin(30 * 3.14159 / 180)
Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
' Slanted bricks
wx = 60
wy = 10
ww = Sqr(wx * wx + wy * wy) * .85
Call NewBrickLine(ww, 0, 100 + ww, 100, wx, wy)
Call NewBrickLine(-ww, 0, -100 - ww, 100, wx, wy)
' Fidget spinner
Call NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
Shape(ShapeCount).Shade = _RGB(255, 255, 255)
' Parameters
CPC = 1.15
FPC = 8
RST = 0.70
VD = 0.995
SV = 0.025
End Sub
Sub SetupRings
' Set external field
ForceField.x = 0
ForceField.y = 0
' Rectangular border
wx = 42
wy = 10
Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
wx = 40
wy = 10
Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
For r = 25 To 175 Step 25
Call NewAutoBall(0, 0, r, 0, 1, 1, 0)
Next
' Parameters
CPC = 1.15
FPC = 8
RST = 0.75
VD = 0.995
SV = 0.025
End Sub
Sub SetupWallsOnly
' Set external field
ForceField.x = 0
ForceField.y = 0 - .08
' Fidget spinner
Call NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
Shape(ShapeCount).Shade = _RGB(255, 255, 255)
' Rectangular border
wx = 42
wy = 10
Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
wx = 40
wy = 10
Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
' Parameters
CPC = 1.15
FPC = 8
RST = 0.75
VD = 0.995
SV = 0.025
End Sub
Sub SetupAnglePong
' Set external field
ForceField.x = 0
ForceField.y = 0
' Rectangular border
wx = 42
wy = 10
Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
wx = 40
wy = 10
Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
' Pong ball
Call NewAutoBall(-50, 200, 20, 0, 1, 1, 0)
Shape(ShapeCount).Velocity.x = -1
Shape(ShapeCount).Velocity.y = -3
Shape(ShapeCount).Shade = _RGB(255, 255, 255)
' Pong Paddle
Call NewAutoBrick(-100, 10, 100, -10, -.02 * 8 * Atn(1))
vtemp.x = 0
vtemp.y = -200
Call TranslateShape(ShapeCount, vtemp)
Shape(ShapeCount).Shade = _RGB(200, 200, 200)
' Wacky balls
x0 = -70
y0 = 120
r1 = 15
r2 = 5.5
gg = 2.5 * (r1 + r2) + 3.5
gx = gg * Cos(30 * 3.14159 / 180)
gy = gg * Sin(30 * 3.14159 / 180)
Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
' Parameters
CPC = 1.15
FPC = 8
RST = 1 '0.75
VD = 1 '0.995
SV = 0.025
End Sub
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
(11-01-2022, 02:38 AM)TempodiBasic Wrote: @james2464
very fine hockey autoplay!
I cannot prove it , but it seems sometimes the ball goes trough the goalkeeper.
@Bplus
strange the effect of end of line stucking the bouncing!
Running your code I have noticed that stucking of ball on a penisula is a switching between 2 lines but there is no moves
moreover the 2 status of bouncing ball have the same blu vector....
That reminds me, I solved the peninsula problem and another one that cropped up after that.
See here: https://staging.qb64phoenix.com/showthre...99#pid8899
b = b + ...
Posts: 230
Threads: 25
Joined: Aug 2022
Reputation:
23
(11-01-2022, 02:38 AM)TempodiBasic Wrote: @james2464
very fine hockey autoplay!
I cannot prove it , but it seems sometimes the ball goes trough the goalkeeper.
Thanks! Yeah the goalies are terrible. Half the shots go right through them.
|
