-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathmodCollision.bas
405 lines (321 loc) · 11.3 KB
/
modCollision.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
Attribute VB_Name = "modCollision"
Option Explicit
Public Type tBB
minX As Double
minY As Double
maxX As Double
maxY As Double
End Type
Public Function InsideBB(BB As tBB, P As geoVector2D) As Boolean
InsideBB = True
If P.x < BB.minX Then InsideBB = False: Exit Function
If P.y < BB.minY Then InsideBB = False: Exit Function
If P.x > BB.maxX Then InsideBB = False: Exit Function
If P.y > BB.maxY Then InsideBB = False: Exit Function
End Function
Public Function BBOverlapping(BB1 As tBB, BB2 As tBB) As Boolean
If BB1.maxX < BB2.minX Then Exit Function
If BB1.maxY < BB2.minY Then Exit Function
If BB1.minX > BB2.maxX Then Exit Function
If BB1.minY > BB2.maxY Then Exit Function
BBOverlapping = True
End Function
'Public Sub CheckCollisionsOnlyPlayer()
' Dim R As Double
' Dim R2 As Double
' Dim I As Long
' Dim J As Long
' Dim TokenPosition As geoVector2D
' Dim Dx As Double
' Dim Dy As Double
' Dim D As Double
' Dim MIND As Double
' Dim BB As tBB
'
'
' Dim HeadPosI As geoVector2D
'
'
' 'PLAYER to ENEMY
' HeadPosI = snake(player).GetHEADPos
' R = snake(player).radius
'
' For I = 1 To NSnakes
'
' If InsideBB(Snake(I).getBB, HeadPosI) Then
'
' R2 = Snake(I).radius
'
' For J = 0 To Snake(I).Ntokens - 1
'
' TokenPosition = Snake(I).GetTokenPos(J)
'
' Dx = HeadPosI.x - TokenPosition.x
' Dy = HeadPosI.y - TokenPosition.y
' D = Dx * Dx + Dy * Dy
' MIND = R + R2
' MIND = MIND * MIND
'
' If D < MIND Then
' 'Player Dead
' If snake(player).IsDying = 0 Then MultipleSounds.playsound SoundPlayerDeath
'
' snake(player).Kill: Exit For
' End If
'
' Next
'
' End If
' Next
' '----------------------------------
' 'ENEMY to PLAYER
' BB = snake(player).getBB
' R2 = snake(player).radius
' For I = 1 To NSnakes
' HeadPosI = Snake(I).GetHEADPos
'
' If InsideBB(BB, HeadPosI) Then
'
' R = Snake(I).radius
'
' For J = 0 To snake(player).Ntokens - 1
' TokenPosition = snake(player).GetTokenPos(J)
' Dx = HeadPosI.x - TokenPosition.x
' Dy = HeadPosI.y - TokenPosition.y
'
' D = Dx * Dx + Dy * Dy
' MIND = R + R2
' MIND = MIND * MIND
'
' If D < MIND Then
'
' 'If Snake(I).IsDying = 0 Then MultipleSounds.playsound SoundEnenmyKilledByMe
' If Snake(I).IsDying = 0 Then MultipleSounds.playsound SoundEnenmyKilledByMe
'
' Snake(I).Kill
' End If
' Next
' End If
'
' Next
'
'
' '----------------------------------
'
'
'End Sub
Public Sub CheckCollisionsALLtoALL()
Dim Ri As Double
Dim Rj As Double
Dim I As Long
Dim J As Long
Dim K As Long
Dim TokenPosition As geoVector2D
Dim dx As Double
Dim dy As Double
Dim D As Double
Dim MIND As Double
Dim BB As tBB
Dim HeadPosI As geoVector2D
Dim HeadPosJ As geoVector2D
For I = 0 To NSnakes
Snake(I).UpdateBB
Next
For I = 0 To NSnakes - 1
HeadPosI = Snake(I).GetHEADPos
Ri = Snake(I).Radius
For J = I + 1 To NSnakes
If InsideBB(Snake(J).getBB, HeadPosI) Then
Rj = Snake(J).Radius
MIND = Ri + Rj
MIND = MIND * MIND
For K = 0 To Snake(J).Ntokens '- 1
TokenPosition = Snake(J).GetTokenPos(K)
dx = HeadPosI.x - TokenPosition.x
dy = HeadPosI.y - TokenPosition.y
D = dx * dx + dy * dy
If D < MIND Then
'Dead Snake
If I = SNAKECAMERA Then
If Snake(I).IsDying = 0 Then MultipleSounds.PlaySound SoundPlayerDeath
Else
If Snake(I).IsDying = 0 Then
HeadPosI = Snake(SNAKECAMERA).GetHEADPos
dx = HeadPosI.x - TokenPosition.x
dy = HeadPosI.y - TokenPosition.y
D = Sqr(dx * dx + dy * dy)
MultipleSounds.PlaySound SoundEnenmyKilled, ClampLong(-dx * 2, -10000, 10000), ClampLong(-D * 0.5, -10000, 0)
HeadPosI = Snake(I).GetHEADPos
End If
End If
Snake(I).Kill
Exit For
End If
Next
End If
HeadPosJ = Snake(J).GetHEADPos
Rj = Snake(J).Radius
If InsideBB(Snake(I).getBB, HeadPosJ) Then
' Ri = Snake(I).radius
MIND = Ri + Rj
MIND = MIND * MIND
For K = 0 To Snake(I).Ntokens '- 1
TokenPosition = Snake(I).GetTokenPos(K)
dx = HeadPosJ.x - TokenPosition.x
dy = HeadPosJ.y - TokenPosition.y
D = dx * dx + dy * dy
If D < MIND Then
'Player Dead
If J = SNAKECAMERA Then
If Snake(J).IsDying = 0 Then MultipleSounds.PlaySound SoundPlayerDeath
Else
If I = SNAKECAMERA Then
If Snake(J).IsDying = 0 Then
HeadPosJ = Snake(SNAKECAMERA).GetHEADPos
dx = HeadPosJ.x - TokenPosition.x
dy = HeadPosJ.y - TokenPosition.y
D = Sqr(dx * dx + dy * dy)
MultipleSounds.PlaySound SoundEnenmyKilledByMe, ClampLong(-dx * 2, -10000, 10000), ClampLong(-D * 1, -10000, 0)
HeadPosJ = Snake(J).GetHEADPos
End If
Else
If Snake(J).IsDying = 0 Then
HeadPosI = Snake(SNAKECAMERA).GetHEADPos
dx = HeadPosI.x - TokenPosition.x
dy = HeadPosI.y - TokenPosition.y
D = Sqr(dx * dx + dy * dy)
MultipleSounds.PlaySound SoundEnenmyKilled, ClampLong(-dx * 2, -10000, 10000), ClampLong(-D * 0.5, -10000, 0)
HeadPosI = Snake(I).GetHEADPos
End If
End If
' Snake(J).Kill: Exit For
End If
Snake(J).Kill: Exit For
End If
Next
End If
Next
Next
'----------------------------------
End Sub
Public Function NewSnakePosition(Idx As Long) As geoVector2D
Dim BB As tBB
Dim POS As geoVector2D
Dim PlayerHeadPOS As geoVector2D
Dim dx As Double
Dim dy As Double
Dim C As Long
Dim InsBB As Boolean
' If Idx = PLAYER Then
'
' Do
' InsBB = False
' POS.x = wMinX + (wMaxX - wMinX) * RndM
' POS.y = wMinY + (wMaxY - wMinY) * RndM
' For C = 1 To NSnakes
' BB = Snake(C).getBB
' If InsideBB(BB, POS) Then InsBB = True: Exit For
' Next
' Loop While InsBB
'
' Else
' ' BB = Snake(PLAYER).getBB
' PlayerHeadPOS = Snake(PLAYER).GetHEADPos
'
' Do
' POS.x = wMinX + (wMaxX - wMinX) * RndM
' POS.y = wMinY + (wMaxY - wMinY) * RndM
' dx = POS.x - PlayerHeadPOS.x
' dy = POS.y - PlayerHeadPOS.y
' 'Loop While InsideBB(BB, POS) Or ((dx * dx + dy * dy) < 40000)
' Loop While (dx * dx + dy * dy) < 40000
'
'
' End If
For C = 0 To NSnakes
Snake(C).UpdateBB True
Next
Do
InsBB = False
POS.x = wMinX + (wMaxX - wMinX) * RndM
POS.y = wMinY + (wMaxY - wMinY) * RndM
For C = 0 To NSnakes
If C <> Idx Then
BB = Snake(C).getBB
If InsideBB(BB, POS) Then InsBB = True: Exit For
End If
Next
Loop While InsBB
NewSnakePosition = POS
End Function
Public Function AvoidEnemy(ByVal Idx As Long, POS As geoVector2D, Vel As geoVector2D) As geoVector2D
Dim I As Long
Dim J As Long
Dim TPleft As geoVector2D
Dim TPRight As geoVector2D
Dim TP As geoVector2D
Dim C As Double
Dim S As Double
Dim A As Double
Dim EscapeDirection As geoVector2D
Dim Dmin As Double
Dim D1 As Double
Dim D2 As Double
Dim Diam As Double
Diam = Snake(Idx).Diam
A = Atan2(Vel.x, Vel.y)
'TPleft.x = POS.x - Cos(A - 0.5) * Diam
'TPleft.y = POS.y - Sin(A - 0.5) * Diam
'TPRight.x = POS.x - Cos(A + 0.5) * Diam
'TPRight.y = POS.y - Sin(A + 0.5) * Diam
'USING TABLE---------------------------------------
Dim CC#, SS#
Dim tbA As Long
If A < 0.5 Then A = A + PI2
tbA = (A - 0.5) * 360# * InvPI2
TPleft.x = POS.x - COStable(tbA) * Diam
TPleft.y = POS.y - SINtable(tbA) * Diam
If (A + 0.5) > PI2 Then A = A - PI2
tbA = (A + 0.5) * 360# * InvPI2
TPRight.x = POS.x - COStable(tbA) * Diam
TPRight.y = POS.y - SINtable(tbA) * Diam
'---------------------------------------
If A < 0# Then A = A + PI2
Dmin = 1E+28
'Diam = (Diam + 30) * 3 ' 8 '''' Distance Sense
'Diam = Diam * Diam
For I = 0 To NSnakes
If I <> Idx Then
Diam = Snake(Idx).Diam * 2.5 + 1 * Snake(I).Diam '--2024
Diam = Diam * Diam
For J = 0 To Snake(I).Ntokens '- 1
TP = Snake(I).GetTokenPos(J)
If Sgn((TP.x - POS.x) * Vel.x + (TP.y - POS.y) * Vel.y) > 0 Then 'Correct!
D1 = DistFromPointSQU(TP, TPleft)
D2 = DistFromPointSQU(TP, TPRight)
If (D1 < Diam) Or (D2 < Diam) Then
If D1 < Dmin Or D2 < Dmin Then
If D1 < D2 Then
'EscapeDirection.x = Cos(A - 0.25) * 8#
'EscapeDirection.y = Sin(A - 0.25) * 8#
If A < 0.25 Then A = A + PI2
tbA = (A - 0.25) * 360# * InvPI2
EscapeDirection.x = COStable(tbA) * 8#
EscapeDirection.y = SINtable(tbA) * 8#
Else
'EscapeDirection.x = Cos(A + 0.25) * 8#
'EscapeDirection.y = Sin(A + 0.25) * 8#
If (A + 0.25) > PI2 Then A = A - PI2
tbA = (A + 0.25) * 360# * InvPI2
EscapeDirection.x = COStable(tbA) * 8#
EscapeDirection.y = SINtable(tbA) * 8#
End If
If D1 < Dmin Then Dmin = D1 Else: Dmin = D2
End If
End If
End If
Next
End If
Next
AvoidEnemy = EscapeDirection
End Function