10-31-2022, 01:27 AM
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