mread3ds.bas

3ds文件浏览程序

Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' Read a material definition, add it to the material collection.
' Materials are linked into the chain of nodes, but they are also
' maintained separately in Materials collection.
'----------------------------------------------------
Public Function ReadMatEntry(ParentNode As CNode, MyChunk As Chunk3DS) As Boolean
Dim MyChunkStart&, MyChunkEnd&
Dim Chunk As Chunk3DS, Name$, ChunkStart&
Dim red!, green!, blue!, percentage!, s%, f!, i&, b As Byte
Dim material As CMaterial
Dim Field As CField
On Error GoTo ErrorHandler
    Set material = New CMaterial
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    With material
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then Exit Do
        Select Case Chunk.ID
        Case MAT_NAME:
            If Not Read3DSString(Name) Then Exit Function
            Debug.Print "Reading material:" & Name
        Case MAT_AMBIENT:
            If Not ReadColor(material, red, green, blue) Then Exit Function
            .SetAmbient red, green, blue
            If Chunk.Length = 24 Then
                If Not ReadColor(material, red, green, blue) Then Exit Function
            End If
        Case MAT_DIFFUSE:
            If Not ReadColor(material, red, green, blue) Then Exit Function
            .SetDiffuse red, green, blue
            If Chunk.Length = 24 Then
                If Not ReadColor(material, red, green, blue) Then Exit Function
            End If
        Case MAT_SPECULAR:
            If Not ReadColor(material, red, green, blue) Then Exit Function
            .SetSpecular red, green, blue
            If Chunk.Length = 24 Then
                If Not ReadColor(material, red, green, blue) Then Exit Function
            End If
        Case MAT_SHININESS:
            If Not ReadPercentage(material, percentage) Then Exit Function
            .Shininess 128 * percentage
        Case MAT_TRANSPARENCY:
            If Not ReadPercentage(material, percentage) Then Exit Function
            .Transparency = percentage
        Case MAT_TWO_SIDE:
            .TwoSide = True
        Case MAT_DECAL
            .Decal = True
        Case MAT_TEXMAP, MAT_TEXMASK, MAT_TEX2MAP, MAT_TEX2MASK, MAT_OPACMAP, MAT_OPACMASK, _
            MAT_BUMPMAP, MAT_BUMPMASK, MAT_SPECMAP, MAT_SPECMASK, MAT_SHINMAP, MAT_SHINMASK, _
            MAT_SELFIMAP, MAT_SELFIMASK, MAT_REFLMAP, MAT_REFLMASK:
            If Not ReadMap(material, Chunk) Then Exit Function
        'percent
        Case MAT_SHIN2PCT, MAT_XPFALL, MAT_REFBLUR, MAT_SELF_ILPCT
            If Not ReadPercentage(material, percentage) Then Exit Function
            Set Field = .AddField(Chunk.ID)
            Field.Value = percentage
        'short
        Case MAT_SHADING
            If Not ReadShort(m_Ptr, s) Then Exit Function
            Set Field = .AddField(Chunk.ID)
            Field.Value = s
        'boolean chunks
        Case MAT_SELF_ILLUM, MAT_PHONGSOFT, MAT_FACEMAP, MAT_WIRE, MAT_USE_XPFALL, MAT_USE_REFBLUR, MAT_ADDITIVE
            Set Field = .AddField(Chunk.ID)
            Field.Value = "True"
        'float
        Case MAT_WIRESIZE
            If Not ReadFloat(m_Ptr, f) Then Exit Function
            Set Field = .AddField(Chunk.ID)
            Field.Value = f
        Case MAT_ACUBIC
            'these values don't have IDs defined
            If Not ReadByte(m_Ptr, b) Then Exit Function 'unused
            If Not ReadByte(m_Ptr, b) Then Exit Function 'unused
            'AcubicAntiAlias
            Set Field = .AddField(Chunk.ID)
            Field.Value = b
            If Not ReadShort(m_Ptr, s) Then Exit Function
            'AcubicReflection
            Set Field = .AddField(Chunk.ID)
            Field.Value = s
            If Not ReadLong(m_Ptr, i) Then Exit Function
            'AcubicMapSize
            Set Field = .AddField(Chunk.ID)
            Field.Value = i
            If Not ReadLong(m_Ptr, i) Then Exit Function
            'AcubicFrame = i
            Set Field = .AddField(Chunk.ID)
            Field.Value = i
        'procedurals
        Case MAT_SXP_TEXT_DATA, MAT_SXP_TEXT_MASKDATA, MAT_SXP_TEXT2_DATA, MAT_SXP_TEXT2_MASKDATA, MAT_SXP_OPAC_DATA, MAT_SXP_OPAC_MASKDATA, _
            MAT_SXP_BUMP_DATA, MAT_SXP_BUMP_MASKDATA, MAT_SXP_SPEC_DATA, MAT_SXP_SPEC_MASKDATA, MAT_SXP_SHIN_DATA, _
            MAT_SXP_SHIN_MASKDATA, MAT_SXP_SELFI_DATA, MAT_SXP_SELFI_MASKDATA, MAT_SXP_REFL_MASKDATA
            If Not SkipChunk(material, Chunk) Then Exit Function
        Case MAT_XPFALLIN 'unknown
            If Not SkipChunk(material, Chunk) Then Exit Function
        Case Else: ' Skip unknown chunks
            If Chunk.ID <> DUMMY Then
            Debug.Assert 0
            End If
            If Not SkipChunk(material, Chunk) Then Exit Function
        End Select
    Loop
    '
    material.NodeID = NODE_MATERIAL
    material.ChunkID = MAT_ENTRY
    Materials.Add ParentNode, Name, material
    End With
    ReadMatEntry = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

Public Function ReadMap(material As CMaterial, MyChunk As Chunk3DS) As Boolean
Dim MyChunkStart&, MyChunkEnd&
Dim Chunk As Chunk3DS, Name$, ChunkStart&
Dim x!, s%
Dim Map As CMap
On Error GoTo ErrorHandler
    'Stop
    Set Map = material.GetMap(MyChunk.ID)
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    '
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then Exit Do
        Select Case Chunk.ID
        Case INT_PERCENTAGE:
            If Not ReadShort(m_Ptr, s) Then Exit Function
            Map.Strength = s
        Case MAT_MAPNAME:
            If Not Read3DSString(Name) Then Exit Function
            Debug.Print "Reading map:" & Name
            Map.Filename = Name
        Case MAT_MAP_TILING:
            If Not ReadShort(m_Ptr, s) Then Exit Function
            Map.Tiling = s
        Case MAT_MAP_USCALE:
            If Not ReadFloat(m_Ptr, x) Then Exit Function
            Map.UScale = x
        Case MAT_MAP_VSCALE:
            If Not ReadFloat(m_Ptr, x) Then Exit Function
            Map.VScale = x
        Case MAT_MAP_UOFFSET:
            If Not ReadFloat(m_Ptr, x) Then Exit Function
            Map.UOffset = x
        Case MAT_MAP_VOFFSET:
            If Not ReadFloat(m_Ptr, x) Then Exit Function
            Map.VOffset = x
        Case MAT_MAP_ANG
            If Not ReadFloat(m_Ptr, x) Then Exit Function
            Map.Angle = x
        Case MAT_MAP_TEXBLUR, MAT_MAP_COL1, MAT_MAP_COL2, MAT_MAP_RCOL, MAT_MAP_GCOL, MAT_MAP_BCOL, MAT_BUMP_PERCENT
            If Not SkipChunk(Map, Chunk) Then Exit Function
        Case Else:
            If Chunk.ID <> DUMMY Then
            Debug.Assert 0
            End If
            If Not SkipChunk(Map, Chunk) Then Exit Function
        End Select
    Loop
    '
    ReadMap = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' ReadNamedObject -
'----------------------------------------------------
Public Function ReadNamedObject(ParentNode As CNode, MyChunk As Chunk3DS)
Dim MyChunkStart&, MyChunkEnd&
Dim Name$, Chunk As Chunk3DS, ChunkStart&
On Error GoTo ErrorHandler
Dim MyNode As CNode
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    If Not Read3DSString(Name) Then Exit Function
    Set MyNode = Scene.AddNode(ParentNode, NAMED_OBJECT, NODE_ROOT, Name)
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then Exit Function
        Select Case Chunk.ID
        Case N_CAMERA
            If Not ReadCamera(MyNode, Chunk) Then Exit Function
        Case N_DIRECT_LIGHT
            If Not ReadDLight(MyNode, Chunk) Then Exit Function
        Case N_TRI_OBJECT:
            If Not ReadTriObject(MyNode, Chunk) Then Exit Function
        'skipped chunks
        Case OBJ_HIDDEN, OBJ_VIS_LOFTER, OBJ_DOESNT_CAST, OBJ_DONT_RCVSHADOW, OBJ_MATTE, OBJ_FAST, _
            OBJ_PROCEDURAL, OBJ_FROZEN
            'Debug.Assert 0
            If Not SkipChunk(ParentNode, Chunk) Then Exit Function
        Case Else:
            Debug.Assert 0
            If Not SkipChunk(MyNode, Chunk) Then Exit Function
        End Select
    Loop
    ReadNamedObject = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' ReadCamera -
'----------------------------------------------------
Public Function ReadCamera(ParentNode As CNode, MyChunk As Chunk3DS) As Boolean
Dim Chunk As Chunk3DS, ChunkStart&
Dim i&, r&, MyChunkStart&, MyChunkEnd&
Dim MyNode As CNode
Dim x!, v!(0 To 2)
Dim Field As CField
On Error GoTo ErrorHandler
    '
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    ' Create a new child node
    Set MyNode = Scene.AddNode(ParentNode, N_CAMERA, NODE_VIEWPOINT)
    '
    If Not Read3Floats(m_Ptr, v) Then Exit Function
    Set Field = MyNode.AddField(N_CAMERA)
    Field.Value = v(0) & "," & v(1) & "," & v(2)
    
    If Not Read3Floats(m_Ptr, v) Then Exit Function
    Set Field = MyNode.AddField(N_CAMERA)
    Field.Value = v(0) & "," & v(1) & "," & v(2)
    '
    If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
    Set Field = MyNode.AddField(N_CAMERA)
    Field.Value = x
    
    If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
    Set Field = MyNode.AddField(N_CAMERA)
    Field.Value = x
    '
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then GoTo ErrorHandler
        Select Case Chunk.ID
'        Case CAM_RANGES:
'            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
'            MyNode.NearFXRadius = x
'            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
'            MyNode.FarFXRadius = x
        'skipped
        Case CAM_RANGES, CAM_SEE_CONE:
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        Case Else:
            Debug.Assert 0
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    '
    ReadCamera = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' ReadDLight - this reads and sets the values on a glLight. It overwrites
'light 8 if more than 8 lights are defined
'----------------------------------------------------
Public Function ReadDLight(ParentNode As CNode, MyChunk As Chunk3DS) As Boolean
Dim Chunk As Chunk3DS, ChunkStart&
Dim i&, Str$, r&, MyChunkStart&, MyChunkEnd&
Dim MyNode As CNode
Dim Field As CField
Dim Light As glxLight
Dim x!, v!(0 To 2)
Dim SpotChunkEnd&
On Error GoTo ErrorHandler
    '
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    ' Create a new child node
    Set MyNode = Scene.AddNode(ParentNode, N_DIRECT_LIGHT, NODE_DIRECTIONALLIGHT)
    'if it has more than 8 lights, just overwrite
    'the data on the eighth light
    Set Light = gCtl.Lights(liLight0 + NextLight)
    Set Field = MyNode.AddField(N_DIRECT_LIGHT)
    Field.Value = NextLight
    '
    If Not Read3Floats(m_Ptr, v) Then Exit Function
    Light.SetPosition v(0), v(1), v(2)
    If Not ReadColor(MyNode, v(0), v(1), v(2)) Then Exit Function
    Set Field = MyNode.AddField(N_DIRECT_LIGHT)
    Field.Value = NextLight
    '
    Light.SetDiffuse v(0), v(1), v(2)
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then GoTo ErrorHandler
        Select Case Chunk.ID
        Case DL_OFF: