mmath.bas

3ds文件浏览程序

Attribute VB_Name = "mMath"
Option Explicit

' maxf: returns the maximum of two floats
Public Function Maxf!(a!, b!)
    If a > b Then
        Maxf = a
    Else
        Maxf = b
    End If
End Function

'----------------------------------------------------------------------------
Public Sub FillArrayb(a() As Byte, ParamArray n())
Dim v, i&
    For Each v In n
        a(i) = v
        i = i + 1
    Next
End Sub

'----------------------------------------------------------------------------
Public Sub FillArrayf(a!(), ParamArray n())
Dim v, i&
    For Each v In n
        a(i) = v
        i = i + 1
    Next
End Sub

'----------------------------------------------------------------------------
Public Sub FillArrayi(a&(), ParamArray n())
Dim v, i&
    For Each v In n
        a(i) = v
        i = i + 1
    Next
End Sub

'----------------------------------------------------------------------------
Public Sub Fill1DArray(a() As POINT3F, ParamArray n())
Dim i&, j&
    For i = 0 To 17
        a(i).p(0) = n(j)
        a(i).p(1) = n(j + 1)
        a(i).p(2) = n(j + 2)
        j = j + 3
    Next
End Sub

'----------------------------------------------------------------------------
'to fill a 2d array of v
Public Sub Fill2DArray(a() As POINT2F, ParamArray n())
Dim i&, j&, cnt&
    For i = 0 To 6
    For j = 0 To 8
        a(i, j).p(0) = n(cnt)
        a(i, j).p(1) = n(cnt + 1)
        cnt = cnt + 2
    Next
    Next
End Sub


Public Sub M4_Identity(m!())
    FillArrayf m, 1, 0, 0, 0, _
                      0, 1, 0, 0, _
                      0, 0, 1, 0, _
                      0, 0, 0, 1

End Sub

'----------------------------------------------------------------------------
' Equal: compares two vectors and returns true if they are
' equal (within a certain threshold) or GL_FALSE if not. An epsilon
' that works fairly well is 0.000001.
' *
' u - array of 3 GLfloats (GLfloat u(0 to 2))
' v - array of 3 GLfloats (GLfloat v(0 to 2))
'----------------------------------------------------------------------------
Public Function Equal(u!(), uIndex&, v!(), vIndex&, epsilon!) As Boolean
    If (Abs(u(uIndex) - v(vIndex)) < epsilon And _
        Abs(u(uIndex + 1) - v(vIndex + 1)) < epsilon And _
        Abs(u(uIndex + 2) - v(vIndex + 2)) < epsilon) Then
          Equal = True
    End If
End Function

'----------------------------------------------------------------------------
'the following are from the glm library
'----------------------------------------------------------------------------

'----------------------------------------------------------------------------
' _m_Normalize: normalize a vector
' n - array of 3 GLfloats (GLfloat n(0 to 2)) to be normalized
'----------------------------------------------------------------------------
Public Sub Normalize(n!())
Dim l!
    ' normalize
    l = Sqr(n(0) * n(0) + n(1) * n(1) + n(2) * n(2))
    If l = 0 Then
        'Debug.Assert 0
        Exit Sub
    End If
    n(0) = n(0) / l
    n(1) = n(1) / l
    n(2) = n(2) / l
End Sub

'----------------------------------------------------------------------------
' Dot: compute the dot product of two vectors
' u - array of 3 GLfloats (GLfloat u(0 to 2))
' v - array of 3 GLfloats (GLfloat v(0 to 2))
'----------------------------------------------------------------------------
Public Function Dot!(u!(), v!())
    Dot = u(0) * v(0) + u(1) * v(1) + u(2) * v(2)
End Function

'----------------------------------------------------------------------------
' Cross: compute the cross product of two vectors
' u - array of 3 GLfloats (GLfloat u(0 to 2))
' v - array of 3 GLfloats (GLfloat v(0 to 2))
' n - array of 3 GLfloats (GLfloat n(0 to 2)) to return the cross product in
'----------------------------------------------------------------------------
Public Sub Cross(u!(), v!(), n!())
  ' compute the cross product (u x v for right-handed (ccw))
  n(0) = u(1) * v(2) - u(2) * v(1)
  n(1) = u(2) * v(0) - u(0) * v(2)
  n(2) = u(0) * v(1) - u(1) * v(0)
End Sub

'----------------------------------------------------------------------------
' glmSpheremapTexture: Generates texture coordinates according to a
' spherical projection of the texture map.  Sometimes referred to as
' spheremap, or reflection map texture coordinates.  It generates
' these by using the normal to calculate where that vertex would map
' onto a sphere.  Since it is impossible to map something flat
' perfectly onto something spherical, there is distortion at the
' poles.  This particular implementation causes the poles along the X
' axis to be distorted.
'----------------------------------------------------------------------------
'Public Sub SpheremapTexture()
'Dim group As GLMGroup
'Dim theta!, phi!, rho!, x!, y!, z!, r!, i&, j&
'
'    'reset the array
'    NumTexCoords = m_NumNormals
'
'    ' do the calculations
'    For i = 1 To m_NumNormals
'        z = m_Normals(3 * i + 0)  ' re-arrange for pole distortion
'        y = m_Normals(3 * i + 1)
'        x = m_Normals(3 * i + 2)
'        r = Sqr((x * x) + (y * y))
'        rho = Sqr((r * r) + (z * z))
'
'        If r = 0# Then
'            theta = 0#
'            phi = 0
'        Else
'            If z = 0 Then
'                phi = 3.14159265 / 2
'            Else
'                phi = ArcCos(z / rho)
'            End If
'            '#if WE_DONT_NEED_THIS_CODE
'            '      if(x == 0.0)
'            '    theta = 3.14159265 / 2.0;   ' asin(y / r);
'            '      Else
'            '    theta = acos(x / r);
'            '#End If
'
'            If y = 0 Then
'                theta = 3.141592365 / 2  ' acos(x / r);
'            Else
'                theta = ArcSin(y / r) + (3.14159265 / 2)
'            End If
'        End If
'
'        m_TexCoords(2 * i + 0) = theta / 3.14159265
'        TexCoords(2 * i + 1) = phi / 3.14159265
'    Next
'
'    ' go through and put texcoord indices in all the triangles
'    For j = 1 To m_Groups.Count
'        Set group = m_Groups(j)
'        For i = 0 To group.NumTriangles - 1
'            m_Triangles(group.Triangles(i)).Tindices(0) = _
'                m_Triangles(group.Triangles(i)).Nindices(0)
'            m_Triangles(group.Triangles(i)).Tindices(1) = _
'                m_Triangles(group.Triangles(i)).Nindices(1)
'            m_Triangles(group.Triangles(i)).Tindices(2) = _
'                m_Triangles(group.Triangles(i)).Nindices(2)
'        Next
'    Next
'
''#if 0
''  debug.print("glmSpheremapTexture(): generated %d spheremap texture coordinates\n",
''     m_numtexcoords);
''#End If
'End Sub

'----------------------------------------------------------------------------
' glmLinearTexture: Generates texture coordinates according to a
' linear projection of the texture map.  It generates these by
' linearly mapping the vertices onto a square.
'----------------------------------------------------------------------------
'Public Sub LinearTexture()
'Dim group As GLMGroup
'Dim dimensions!(0 To 2)
'Dim x!, y!, scalefactor!, i&, j&
'    'reset texcoords
'    NumTexCoords = m_NumVertices
'    GetDimensions dimensions
'    scalefactor = 2# / _
'        Abs(Maxf(Maxf(dimensions(0), dimensions(1)), dimensions(2)))
'
'    ' do the calculations
'    For i = 1 To m_NumVertices
'        x = m_Vertices(3 * i + 0) * scalefactor
'        y = m_Vertices(3 * i + 2) * scalefactor
'        m_TexCoords(2 * i + 0) = (x + 1#) / 2
'        m_TexCoords(2 * i + 1) = (y + 1#) / 2
'    Next
'
'    ' go through and put texture coordinate indices in all the triangles
'    For j = 1 To m_Groups.Count
'        Set group = m_Groups(j)
'        For i = 0 To group.NumTriangles - 1
'            m_Triangles(group.Triangles(i)).Tindices(0) = _
'                m_Triangles(group.Triangles(i)).Vindices(0)
'            m_Triangles(group.Triangles(i)).Tindices(1) = _
'                m_Triangles(group.Triangles(i)).Vindices(1)
'            m_Triangles(group.Triangles(i)).Tindices(2) = _
'                m_Triangles(group.Triangles(i)).Vindices(2)
'        Next
'    Next
''#if 0
''  debug.print("glmLinearTexture(): generated %d linear texture coordinates\n",
''      m_numtexcoords);
''#End If
'End Sub