Терраин

[Maxwell]

Есть объект и неровный терраин. Как можно сделать, что бы объект находился на такой высоте, на кокой находится полигон под ним? Как будто бы он едет по земле.

[d3drm]

Легко! Для этого нам понадобится:

три куриных яйца;
200 грамм сливочного масла:
пол кг муки...

А, нет, это не оттуда... Это кусок кода из гагрузки md2...

Так. Смотри. У нас есть ландшафт, выраженный массивом вертексов. Каждые шесть вертексов - квадрат. Если это так, то смтотри(кстати, это стандартный способ создания ландшафтов, так что у тя наверняка так):

':: Проверка столкновения луча с треугольником (3D)
Public Function Collision3D_RayToTriangle(Orig As D3DVECTOR, Dir As D3DVECTOR, Vert0 As D3DVECTOR, Vert1 As D3DVECTOR, Vert2 As D3DVECTOR, t As Double, u As Double, v As Double) As Byte
' Orig - позиция
' Dir - направление
' Vert0, Vert1, Vert2 - три вершины треугольника
' t, U, V - дополнительные параметры

On Error Resume Next

Dim edge1 As D3DVECTOR
Dim edge2 As D3DVECTOR
Dim tVec As D3DVECTOR
Dim pvec As D3DVECTOR
Dim qvec As D3DVECTOR
Dim inv_det As Double
Dim det As Double

D3DXVec3Subtract edge1, Vert1, Vert0
D3DXVec3Subtract edge2, Vert2, Vert0

D3DXVec3Cross pvec, Dir, edge2

det = D3DXVec3Dot(edge1, pvec)

If det > -0.0001 And det < 0.0001 Then
Collision3D_RayToTriangle = 0
Exit Function
End If
inv_det = 1 / det

D3DXVec3Subtract tVec, Orig, Vert0

u = D3DXVec3Dot(tVec, pvec) * inv_det
If u < 0 Or u > 1 Then
Collision3D_RayToTriangle = 0
Exit Function
End If

D3DXVec3Cross qvec, tVec, edge1


v = D3DXVec3Dot(Dir, qvec) * inv_det
If v < 0 Or u + v > 1 Then
Collision3D_RayToTriangle = 0
Exit Function
End If


t = D3DXVec3Dot(edge2, qvec) * inv_det

Collision3D_RayToTriangle = 1

End Function


Ну это классика! Пересечение треуольника лучом!

Далее:

':: Проверяем, находится ли точка в прямоугольнике (2D)
Public Function Collision2D_PointToQuadrangle(Point As D3DVECTOR2, QuadMin As D3DVECTOR2, QuadMax As D3DVECTOR2) As Boolean
' Point - точка для проверки
' QuadMin - вершина любого угла
' QuadMax - вершина угла, противолежащего QuadMin

Collision2D_PointToQuadrangle = False

If Point.X >= QuadMin.X And Point.X <= QuadMax.X And Point.Y >= QuadMin.Y And Point.Y <= QuadMax.Y Then Collision2D_PointToQuadrangle = True


End Function

Вот это, думаю, объяснять не надо...


Далее уже класс с ландшафтом:

' Получаем индекс первого вертекса из шести, над квадратом которых мы находимся
Private Function GetVertexCollidingIndex(X As Single, Y As Single) As Integer

Dim Vec(2) As D3DVECTOR2
Dim i As Long

Vec(2).X = X
Vec(2).Y = Y

For i = 0 To VertCount - 6 Step 6

Vec(0).X = lVertex(i).X
Vec(0).Y = lVertex(i).Z

Vec(1).X = lVertex(i + 3).X
Vec(1).Y = lVertex(i + 3).Z

If Collision2D_PointToQuadrangle(Vec(2), Vec(0), Vec(1)) Then
GetVertexCollidingIndex = i
Exit Function
End If

Next i

GetVertexCollidingIndex = -1 ' Если камера находится вне ландшафта, присваиваем значение -1 (Функция не может выдать отрицательное число, поэтому можем брать любое)

End Function

lVertex() Тот самый массив вертексов для ландшафта... Просто проверяем где находится точка, чтоб не перебирать весь ландшафт сложной функцией, указанной сверху(пересечение треугольника лучом).

И главная функция класса ландшафта, которая все это объединяет:

' Получаем координату точки по координатам X и Z
Public Function GetHeight(X As Single, Z As Single) As Single

Dim Ind As Integer
Dim t As Double, u As Double, v As Double, t1 As Double, u1 As Double, V1 As Double
Dim Dest As D3DVECTOR
Dim Origin As D3DVECTOR
Dim g As Byte, g1 As Byte


Ind = GetVertexCollidingIndex(X, Z)

If Ind = -1 Then

GetHeight = -1
Exit Function

End If


Origin = CreateVector(X, 0, Z)
Dest = CreateVector(0, 1, 0)

D3DXVec3Normalize Dest, Dest

g = Collision3D_RayToTriangle(Origin, Dest, CreateVectorFromLVertex2(lVertex(Ind)), CreateVectorFromLVertex2(lVertex(Ind + 1)), CreateVectorFromLVertex2(lVertex(Ind + 2)), t, u, v)
g1 = Collision3D_RayToTriangle(Origin, Dest, CreateVectorFromLVertex2(lVertex(Ind + 5)), CreateVectorFromLVertex2(lVertex(Ind + 4)), CreateVectorFromLVertex2(lVertex(Ind + 3)), t1, u1, V1)

If (g = 1 And t >= 0) Or (g1 = 1 And t1 >= 0) Then

If t = 0 Then GetHeight = t1 Else GetHeight = t
Exit Function

End If

End Function


Вот вроде и все. Все проверено, все работает. А с тебя пиво!

[Maxwell]

Я наверно с вопросамми уже достал...

Я ландшавт в 3DMax-е делаю, просто привычнее.
Так, как особых навыков программирования не имею и DX8 начал заниматься сравнительно недавно. Не мог бы ты примечик кинуть? Тогда с меня два пива.

[Mikle]

Если сетка ландшафта регулярная, мне кажется высоту можно найти раз в сто проще.

[d3drm]

Если сетка ландшафта регулярная, мне кажется высоту можно найти раз в сто проще.

Наример?

Так, как особых навыков программирования не имею и DX8 начал заниматься сравнительно недавно. Не мог бы ты примечик кинуть? Тогда с меня два пива.

Эх... Мыло давай... И пусть люди думают, что я такой добрый... На самом деле просто пиво люблю...

[Maxwell]

maxwell@nm.ru

[Mikle]

Код: Выделить всё

Option Explicit
Dim map(3, 3) As Single

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim XX As Single, YY As Single
  Me.Cls
  Randomize Timer

  For YY = 0 To 3               'Заполняем массив
    For XX = 0 To 3
      map(XX, YY) = Rnd
    Next XX
  Next YY

  Me.DrawWidth = 1              'Рисуем сетку
  Me.ForeColor = RGB(0, 0, 255)
  For YY = 0 To 3 Step 0.05
    For XX = 0 To 3 Step 0.05
      If Button = 1 Then
        Plot XX, YY, Val1(XX, YY)
      Else
        Plot XX, YY, Val2(XX, YY)
      End If
    Next XX
  Next YY

  Me.DrawWidth = 3              'Рисуем узлы
  Me.ForeColor = RGB(255, 0, 0)
  For YY = 0 To 3
    For XX = 0 To 3
      Plot XX, YY, map(XX, YY)
    Next XX
  Next YY
End Sub

Private Function Val0(X As Single, Y As Single) As Single
Dim sx As Single, sy As Single, ix As Integer, iy As Integer
  ix = Int(X): sx = X - ix
  iy = Int(Y): sy = Y - iy
  Val0 = map(ix, iy) * (1! - sx) * (1! - sy)
  Val0 = Val0 + map(ix + 1, iy) * sx * (1! - sy)
  Val0 = Val0 + map(ix, iy + 1) * (1! - sx) * sy
  Val0 = Val0 + map(ix + 1, iy + 1) * sx * sy
End Function

Private Function Val1(X As Single, Y As Single) As Single
Dim sx As Single, sy As Single, ix As Integer, iy As Integer
  ix = Int(X): sx = X - ix
  iy = Int(Y): sy = Y - iy
  If sx + sy < 1 Then
    Val1 = map(ix, iy + 1) + map(ix + 1, iy) - map(ix, iy)
    Val1 = Val1 * sx * sy + map(ix, iy) * (1! - sx) * (1! - sy)
  Else
    Val1 = map(ix, iy + 1) + map(ix + 1, iy) - map(ix + 1, iy + 1)
    Val1 = Val1 * (1! - sx) * (1! - sy) + map(ix + 1, iy + 1) * sx * sy
  End If
  Val1 = Val1 + map(ix + 1, iy) * sx * (1! - sy)
  Val1 = Val1 + map(ix, iy + 1) * (1! - sx) * sy
End Function

Private Function Val2(X As Single, Y As Single) As Single
Dim sx As Single, sy As Single, ix As Integer, iy As Integer
  ix = Int(X): sx = X - ix
  iy = Int(Y): sy = Y - iy
  If sx - sy < 0 Then
    Val2 = map(ix + 1, iy + 1) + map(ix, iy) - map(ix, iy + 1)
    Val2 = Val2 * sx * (1! - sy) + map(ix, iy + 1) * (1! - sx) * sy
  Else
    Val2 = map(ix + 1, iy + 1) + map(ix, iy) - map(ix + 1, iy)
    Val2 = Val2 * (1! - sx) * sy + map(ix + 1, iy) * sx * (1! - sy)
  End If
  Val2 = Val2 + map(ix, iy) * (1! - sx) * (1! - sy)
  Val2 = Val2 + map(ix + 1, iy + 1) * sx * sy
End Function

Private Sub Form_Load()
  Me.ScaleMode = 3
  Me.Width = Screen.TwipsPerPixelX * 450
  Me.Height = Screen.TwipsPerPixelY * 400
End Sub

Private Sub Plot(X As Single, Y As Single, v As Single)
  Me.PSet (X * 100 + 30 + Y * 30, Y * 100 + 70 - v * 70)
End Sub


Не пугайтесь размера - это полный проект. Вставить ЭТО в код новой формы - и готово. Очевидно, что каждую ячейку сетки можно разбить на 2 треугольника двумя способами. В результате я привожу две функции - Val1 и Val2. Какую из них применять - зависит от сетки. По клику мышкой по форме происходит заполнение сетки 4*4 случайными значениями (красные точки), потом, используя Val1 или Val2, в зависимости от кнопки мыши, все поле заполняется высотами с шагом 0.05. В коде есть еще неиспользованная ф-ция Val0 - это линейная интерполяция - дает более гладкое заполнение, но, к сожалению, не соответствует разбиению на треугольники.

[d3drm]

В общем это... Все валим на http://infinite-race.narod.ru и там скачиваем мой хрен. (Хрен - мой старый движок) Там 2 версии под dx7 и под dx8. Кроме ландшафтов там еще до фика полезного найти можно.[/url]

[Maxwell]

Спасибо, пиво на мыло кину.

[d3drm]

Буду подождать