|
|

楼主 |
发表于 2003-11-1 11:50:00
|
显示全部楼层
Re:碰撞检测
这是方形地面上,小车运动的碰撞检测
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then
move_verts car, MakeVector(2, 0, 0), False
ElseIf KeyCode = vbKeyUp Then
move_verts car, MakeVector(-2, 0, 0), False
End If
End Sub
Private sub form_load()
...
...
...
render loop...
If GetTickCount - ticks > 1 Then ' gravity
ticks = GetTickCount
move_verts car, MakeVector(0, -4.9 / FPS_Highest, 0), True
End If
...
end sub
Private Function move_verts(Object() As LITVERTEX, direction As D3DVECTOR, Gravity As Boolean) As Boolean
Dim i As Integer
Dim ans As Boolean
Dim p As LITVERTEX
Dim temp As LITVERTEX
Dim dmove As Boolean
Dim dmoveS() As Boolean
Dim x As Integer
ReDim dmoveS(UBound(Object)) As Boolean
For i = 0 To UBound(Object)
temp.x = Object(i).x + direction.x
temp.y = Object(i).y + direction.y
temp.z = Object(i).z + direction.z
For x = 0 To UBound(Cube) Step 3
If Coll_Test(Cube(x), Cube(x + 1), Cube(x + 2), Object(i), temp, p) Then 'collision call collision detectoin
'dmoveS(i) = True
Exit Function
'MoveToPlaneHeight Object(i), x / 3, Cube(x), temp 'ignore these notes
'Object(i).x = temp.x
'Object(i).z = temp.z
End If
Next x
Next i
For i = 0 To UBound(Object)
'If Not dmoveS(i) Then
Object(i).x = Object(i).x + direction.x
Object(i).y = Object(i).y + direction.y
Object(i).z = Object(i).z + direction.z
'End If
Next i
Set carBuffer = D3DDevice.CreateVertexBuffer(Len(car(0)) * 6, 0, Lit_FVF, D3DPOOL_DEFAULT)
If carBuffer Is Nothing Then Exit Function
D3DVertexBuffer8SetData carBuffer, 0, Len(car(0)) * 6, 0, car(0)
D3DXMatrixLookAtLH matView, MakeVector(0, 15, 15), MakeVector(Object(0).x, Object(0).y, Object(0).z), MakeVector(0, 1, 0)
D3DDevice.SetTransform D3DTS_VIEW, matView
End Function
'//colision detection
Function ACos(ByVal number As Double) As Double
If Abs(number) <> 1 Then
ACos = 1.5707963267949 - Atn(number / Sqr(1 - number * number))
ElseIf number = -1 Then
ACos = 3.14159265358979
End If
End Function
Private Function normalise(Vertex As LITVERTEX) As LITVERTEX
Dim x As D3DVECTOR
x.x = Vertex.x
x.y = Vertex.y
x.z = Vertex.z
D3DXVec3Normalize x, x
normalise.x = x.x
normalise.y = x.y
normalise.z = x.z
End Function
Public Function Coll_Test(p1 As LITVERTEX, p2 As LITVERTEX, p3 As LITVERTEX, l1 As LITVERTEX, l2 As LITVERTEX, point As LITVERTEX) As Boolean
Dim p As LITVERTEX
Dim N As LITVERTEX
Dim pa1 As LITVERTEX
Dim pa2 As LITVERTEX
Dim pa3 As LITVERTEX
Dim d As Double
Dim a1 As Double
Dim a2 As Double
Dim a3 As Double
Dim denom As Double
Dim mu As Double
Dim total As Double
'//Get Planes Normal and Make Length Of 1\\
N.x = (p2.y - p1.y) * (p3.z - p1.z) - (p2.z - p1.z) * (p3.y - p1.y)
N.y = (p2.z - p1.z) * (p3.x - p1.x) - (p2.x - p1.x) * (p3.z - p1.z)
N.z = (p2.x - p1.x) * (p3.y - p1.y) - (p2.y - p1.y) * (p3.x - p1.x)
N = normalise(N) ' normalise normal
d = -N.x * p1.x - N.y * p1.y - N.z * p1.z
'//see if line is paralel to plane
denom = N.x * (l2.x - l1.x) + N.y * (l2.y - l1.y) + N.z * (l2.z - l1.z)
If denom = 0 Then
Coll_Test = False
Exit Function
End If
'//get location on line
mu = -(d + N.x * l1.x + N.y * l1.y + N.z * l1.z) / denom
p.x = l1.x + mu * (l2.x - l1.x)
p.y = l1.y + mu * (l2.y - l1.y)
p.z = l1.z + mu * (l2.z - l1.z)
If mu > 1 Or mu < 0 Then '//intersection isn't on line, no collision
Coll_Test = False
Exit Function
End If
'// see if intersection is with in plane
pa1.x = p1.x - p.x
pa1.y = p1.y - p.y
pa1.z = p1.z - p.z
pa1 = normalise(pa1)
pa2.x = p2.x - p.x
pa2.y = p2.y - p.y
pa2.z = p2.z - p.z
pa2 = normalise(pa2)
pa3.x = p3.x - p.x
pa3.y = p3.y - p.y
pa3.z = p3.z - p.z
pa3 = normalise(pa3)
a1 = pa1.x * pa2.x + pa1.y * pa2.y + pa1.z * pa2.z
a2 = pa2.x * pa3.x + pa2.y * pa3.y + pa2.z * pa3.z
a3 = pa3.x * pa1.x + pa3.y * pa1.y + pa3.z * pa1.z
’判断交点是否在三角形内部,如果在内部,它与三个顶点向量的夹角的反余弦和会在一范围内
total = (ACos(a1) + ACos(a2) + ACos(a3)) ' * RTOD
If Abs(total) > 6.284 Or Abs(total) < 6.282 Then
Coll_Test = False
Exit Function
End If
Coll_Test = True
point = p
End Function
|
|