mreadobj.bas

3ds文件浏览程序

    MatFaces.Count = triCount
    'group.Count = GroupTriCount
End Sub

'----------------------------------------------------------------------------
'Read a wavefront material library file
' File  - name of the material library
'newmtl red
'Ka  0.1 0.0 0.0         ! ambient color responce
'Kd  0.4 0.0 0.0         ! diffuse color responce
'Ks  0.4 0.0 0.0         ! spectular color
'Ns  20                      ! spectular exponent
'd  1.0                        ! dissolve   0.0 -- 1.0  transparent --
'OPAQUE
'illum 1                     ! illumination model  0:color  1:diffuse ligthing
'                ! 2:diffuse and spectular lighting
'----------------------------------------------------------------------------
Public Function ReadMTL(File$) As Boolean
Dim FileName$, fn#
Dim Mat As CMaterial
Dim buf$, s$, r!, g!, b!, a!
Dim pos&
On Error GoTo eh
    FileName = PathName & "\" & File
    ' open the file
    fn = FreeFile
    Open FileName For Input As fn
    Do While Not EOF(fn)
        Line Input #fn, buf
        Select Case Left$(buf, 1)
        Case "'" ' comment
        Case "n": ' newmtl
            pos = 8
            If Not GetNextToken(s, buf, pos) Then Exit Do
            Set Mat = New CMaterial
            Materials.Add Nothing, s, Mat
            Mat.NodeID = NODE_MATERIAL
            Mat.ChunkID = MAT_ENTRY
        Case "N":
            pos = 4
            If Not GetNextToken(s, buf, pos) Then Exit Do
            ' wavefront shininess is from (0, 1000), so scale for OpenGL
            Mat.Shininess Val(s) / 1000 * 128
        Case "K":
            pos = 4
            If Not GetNextToken(s, buf, pos) Then Exit Do
            r = Val(s)
            If Not GetNextToken(s, buf, pos) Then Exit Do
            g = Val(s)
            If Not GetNextToken(s, buf, pos) Then Exit Do
            b = Val(s)
            Select Case Mid$(buf, 2, 1)
            Case "a": Mat.SetAmbient r, g, b
            Case "d": Mat.SetDiffuse r, g, b
            Case "s": Mat.SetSpecular r, g, b
            Case Else: 'ignore
            End Select
        Case Else: 'ignore
        End Select
    Loop
Close #fn
Exit Function
eh:
Close #fn
Debug.Assert 0
End Function

'----------------------------------------------------------------------------
'Note: this is just cleanup
'----------------------------------------------------------------------------
Public Sub Clear()
Dim i&
    PathName = ""
    MaterialLibName = ""
End Sub

'----------------------------------------------------------------------------
' public functions
'----------------------------------------------------------------------------

'----------------------------------------------------------------------------
'Find a group in the model
'this is used only by AddGroup
'----------------------------------------------------------------------------
'Private Function m_FindGroup(Name$) As MFLong
'Dim i&
'    For i = 1 To m_Groups.Count
'        If StrComp(Name, m_Groups(i).Name) = 0 Then
'            Set m_FindGroup = m_Groups(i)
'            Exit Function
'        End If
'    Next
'    'Debug.Assert 0
'End Function

'----------------------------------------------------------------------------
'Add a group to the model
'----------------------------------------------------------------------------
'Private Function m_AddGroup(Name$) As MFLong
'Dim group As MFLong
'    Set group = m_FindGroup(Name)
'    If group Is Nothing Then
'        Set group = New MFLong
'        group.Name = Name
'        m_Groups.Add group
'    End If
'    Set m_AddGroup = group
'End Function

'----------------------------------------------------------------------------
'Find a material in the model
'----------------------------------------------------------------------------
'Private Function m_FindMaterial&(Name$)
'Dim i&
'    For i = 1 To m_Materials.Count
'        If StrComp(m_Materials(i).Name, Name, 0) = 0 Then
'            GoTo found
'        End If
'    Next
'    ' didn't find the name, so set it as the default material
'    Debug.Print "m_FindMaterial():  can't find material " & Name
'    Debug.Assert 0
'    i = 0
'found:
'    m_FindMaterial = i
'End Function




'----------------------------------------------------------------------------
' glmDraw: Renders the model to the current OpenGL context using the
' mode specified.
' mode     - a bitwise OR of values describing what is to be rendered.
'            GLM_NONE     -  render with only vertices
'            GLM_FLAT     -  render with facet normals
'            GLM_SMOOTH   -  render with vertex normals
'            GLM_TEXTURE  -  render with texture coords
'            GLM_COLOR    -  render with colors (color material)
'            GLM_MATERIAL -  render with materials
'            GLM_COLOR and GLM_MATERIAL should not both be specified.
'            GLM_FLAT and GLM_SMOOTH should not both be specified.
'----------------------------------------------------------------------------
'Public Sub Draw(mode&)
'Dim i&, j&
'Dim group As MFLong
'
'
'    glPushMatrix
'    glTranslatef m_Position(0), m_Position(1), m_Position(2)
'
'    glBegin GL_TRIANGLES
'    For j = 1 To m_Groups.Count
'        Set group = m_Groups(j)
'        If mode And GLM_MATERIAL Then
'            Debug.Assert 0
'            glMaterialfv GL_FRONT_AND_BACK, GL_AMBIENT, _
'                 m_Materials(group.material).Ambient
'            glMaterialfv GL_FRONT_AND_BACK, GL_DIFFUSE, _
'                 m_Materials(group.material).Diffuse
'            glMaterialfv GL_FRONT_AND_BACK, GL_SPECULAR, _
'                 m_Materials(group.material).Specular
'            glMaterialf GL_FRONT_AND_BACK, GL_SHININESS, _
'                m_Materials(group.material).Shininess
'        End If
'
'        If mode And GLM_COLOR Then
'            Debug.Assert 0
'            glColor3fv m_Materials(group.material).Diffuse
'        End If
'
'        For i = 0 To group.NumTriangles - 1
'            If (mode And GLM_FLAT) Then
'                Debug.Assert 0
'               glNormal3fv m_FacetNorms(3 * FaceIndices(group.Triangles(i)).fIndex)
'            End If
'            '
'            If (mode And GLM_SMOOTH) Then
'                glNormal3fv m_Normals(3 * FaceIndices(group.Triangles(i)).Nindices(0))
'            End If
'            If (mode And GLM_TEXTURE) Then
'                Debug.Assert 0
'                glTexCoord2fv m_TexCoords(2 * FaceIndices(group.Triangles(i)).Tindices(0))
'            End If
'            glVertex3fv m_Vertices(3 * FaceIndices(group.Triangles(i)).Vindices(0))
'            '
'            If (mode And GLM_SMOOTH) Then
'                glNormal3fv m_Normals(3 * FaceIndices(group.Triangles(i)).Nindices(1))
'            End If
'            If (mode And GLM_TEXTURE) Then
'                glTexCoord2fv m_TexCoords(2 * FaceIndices(group.Triangles(i)).Tindices(1))
'            End If
'            glVertex3fv m_Vertices(3 * FaceIndices(group.Triangles(i)).Vindices(1))
'            '
'            If (mode And GLM_SMOOTH) Then
'                glNormal3fv m_Normals(3 * FaceIndices(group.Triangles(i)).Nindices(2))
'            End If
'            If (mode And GLM_TEXTURE) Then
'                glTexCoord2fv m_TexCoords(2 * FaceIndices(group.Triangles(i)).Tindices(2))
'            End If
'            glVertex3fv m_Vertices(3 * FaceIndices(group.Triangles(i)).Vindices(2))
'        Next
'    Next
'    glEnd
'    glPopMatrix
'End Sub
'