?? mread3ds.bas
字號:
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:
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -