Function VDot(a As D3DVECTOR, b As D3DVECTOR) As Single
VDot = a.x * b.x + a.y * b.y + a.z * b.z
End Function
'=================================
' VectorAddAndScale
'=================================
Sub VectorAddAndScale(dest As D3DVECTOR, s1 As Single, v1 As D3DVECTOR, s2 As Single, v2 As D3DVECTOR)
dest.x = s1 * v1.x + s2 * v2.x
dest.y = s1 * v1.y + s2 * v2.y
dest.z = s1 * v1.z + s2 * v2.z
End Sub
'=================================
' VectorCopy
'=================================
Sub VectorCopy(dest As D3DVECTOR, src As D3DVECTOR)
dest.x = src.x
dest.y = src.y
dest.z = src.z
End Sub
Function VCopy(src As D3DVECTOR) As D3DVECTOR
Dim dest As D3DVECTOR
dest.x = src.x
dest.y = src.y
dest.z = src.z
VCopy = dest
End Function
'=================================
' VectorScale
'=================================
' scale a vector by a scalar
Sub VectorScale(dest As D3DVECTOR, src As D3DVECTOR, s As Single)
dest.x = src.x * s
dest.y = src.y * s
dest.z = src.z * s
End Sub
Function VScale(src As D3DVECTOR, s As Single) As D3DVECTOR
Dim dest As D3DVECTOR
dest.x = src.x * s
dest.y = src.y * s
dest.z = src.z * s
VScale = dest
End Function
'=================================
' MakeVector
'=================================
Sub MakeVector(v As D3DVECTOR, x As Single, y As Single, z As Single)
v.x = x
v.y = z
v.z = y
End Sub
Function RVector(x As Single, y As Single, z As Single) As D3DVECTOR
Dim v As D3DVECTOR
v.x = x
v.y = y
v.z = z
RVector = v
End Function
'=================================
' MakeVertex
'=================================
Sub MakeVertex(ret As D3DVERTEX, Vect As D3DVECTOR, vNorm As D3DVECTOR, tu As Single, tv As Single)
With ret
.nx = vNorm.x
.ny = vNorm.y
.nz = vNorm.z
.tu = tu
.tv = tv
.x = Vect.x
.y = Vect.y
.z = Vect.z
End With
End Sub
Function RVertex(Vect As D3DVECTOR, vNorm As D3DVECTOR, tu As Single, tv As Single) As D3DVERTEX
Dim ret As D3DVERTEX
With ret
.nx = vNorm.x
.ny = vNorm.y
.nz = vNorm.z
.tu = tu
.tv = tv
.x = Vect.x
.y = Vect.y
.z = Vect.z
End With
RVertex = ret
End Function
'=================================
' MakeLVertex
'=================================
Sub MakeLVertex(ret As D3DLVERTEX, x As Single, y As Single, z As Single, color As Long, specular As Single, tu As Single, tv As Single)
With ret
.specular = specular
.tu = tu
.tv = tv
.x = x
.y = y
.z = z
.color = color
End With
End Sub
Function RLVertex(x As Single, y As Single, z As Single, color As Long, specular As Single, tu As Single, tv As Single) As D3DLVERTEX
Dim ret As D3DLVERTEX
With ret
.specular = specular
.tu = tu
.tv = tv
.x = x
.y = y
.z = z
.color = color
End With
RLVertex = ret
End Function
'=================================
' MakeTLVertex
'=================================
Function MakeTLVertex(vert As D3DTLVERTEX, sx As Single, sy As Single, sz As Single, w As Single, c As Long, s As Single, u As Single, v As Single) As D3DTLVERTEX
vert.sx = sx
vert.sy = sy
vert.sz = sz
vert.rhw = w
vert.color = c
vert.specular = s
vert.tu = u
vert.tv = v
End Function
Function RTLVertex(sx As Single, sy As Single, sz As Single, w As Single, c As Long, s As Single, u As Single, v As Single) As D3DTLVERTEX
Dim vert As D3DTLVERTEX
vert.sx = sx
vert.sy = sy
vert.sz = sz
vert.rhw = w
vert.color = c
vert.specular = s
vert.tu = u
vert.tv = v
RTLVertex = vert
End Function
'=================================
' MakeRect
'=================================
Function MakeRect(ret As RECT, X1 As Single, Y1 As Single, X2 As Single, Y2 As Single)
With ret
.Left = X1
.Top = Y1
.right = X2
.Bottom = Y2
End With
End Function
Function RRect(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As RECT
Dim RetRect As RECT
With RetRect
.Left = X1
.Top = Y1
.right = X2
.Bottom = Y2
End With
RRect = RetRect
End Function
'=================================
' ResetFloat
' easy way of reseting the floating
' point cpu flags so vb doesnt complian
' of Overflow error.
' Issues are always driver specific
'=================================
Sub ResetFloat()
On Local Error GoTo out
Dim s As Single
Dim v As Single
s = 1#
s = s / v
out:
s = 0
End Sub
'=================================
' PrintVector
' aids in debuging
'=================================
Sub PrintVector(v As D3DVECTOR)
Debug.Print v.x, v.y, v.z
End Sub
'=================================
' FVF VERTEX helpers
' used for mutli textured polygons
'=================================
'Helper function for
Private Function RaisePower(ByVal lPower As Long) As Long
Dim lCount As Long, lRaised As Long
lRaised = 1
For lCount = 1 To lPower
lRaised = lRaised * 2
Next
RaisePower = lRaised
End Function
Private Function ShiftLeft(ByVal lInitNum As Long, ByVal lBitsLeft As Long) As Long
'Shift Left is computed as floor( this * (2**BitsLeft))
Dim lPower As Long
lPower = RaisePower(lBitsLeft)
ShiftLeft = CLng(lInitNum * lPower)
End Function
Private Function D3DFVF_TEXTCOORDSIZE1(ByVal CoordIndex As Long) As Long