rabit/r3/Module_ASE.bas

Attribute VB_Name = "Module_ASE"
Option Explicit

Enum enumParserState

    ePS_OutsideBlock
    ePS_SceneDefinition
    ePS_MaterialList
    ePS_MaterialDefinition
    ePS_MaterialTextureDefinition
    ePS_ShapeDefinition
    ePS_ShapeNodeDefinition
    ePS_ShapeLineVertexList
    ePS_ObjectDefinition
    ePS_ObjectNodeDefinition
    ePS_ObjectMeshDefinition
    ePS_ObjectMeshVertexList
    ePS_ObjectMeshFaceList
    ePS_ObjectMeshTVectorList
    ePS_ObjectMeshTFaceList
    ePS_ObjectMeshNormals
    
End Enum

Dim lptpEmptyD3DMaterialList() As D3DMATERIAL8

Dim eParserState As enumParserState

Dim l1 As Long

Dim lParserLevel As Long

Dim lVerticesSum As Long

Dim clCurrentObject As Class_GeoObject

Dim lpVCurrentVertexList() As D3DVERTEX
Dim lpVEmptyVertexList() As D3DVERTEX

Dim lptpCurrentD3DVectorList() As D3DVECTOR
Dim lptpEmptyD3DVectorList() As D3DVECTOR

Dim tpCurrentD3DMaterial As D3DMATERIAL8
Dim tpEmptyD3DMaterial As D3DMATERIAL8

Dim clCurrentD3DTexture As Direct3DTexture8
'

Public Sub OpenGeometryFromASE2(strFilePath As String)

Dim iFileNo As Integer

Dim l As Long

Dim lArgument As Long
Dim lSegCount As Long

Dim strFileLine As String
Dim strSeg As String

Dim lpstrArguments() As String
Dim lpstrSegs() As String

    DeleteScene

    iFileNo = FreeFile
    
    Open strFilePath For Input As #iFileNo

    ConPrint Const_strConsoleBlockTitlePre + "opening """ + GetFilenameOfFullPath(strFilePath) + """:" + Const_strConsoleBlockTitlePost

    eParserState = ePS_OutsideBlock
    lParserLevel = 0
    
    While Not EOF(iFileNo)
    
        Line Input #iFileNo, strFileLine
        
        strFileLine = Trim(strFileLine)
        
        If strFileLine <> "" Then

            strFileLine = Replace(strFileLine, vbTab, " ")

            lpstrSegs = Split(strFileLine, " ")
            
            lSegCount = UBound(lpstrSegs)
            
            If lSegCount > -1 Then
            
                ReDim lpstrArguments(0) As String
                lArgument = 0
                
                For l = 0 To lSegCount
                
                    strSeg = Trim(lpstrSegs(l))
                    
                    If strSeg <> "" Then
                    
                        If strSeg = "{" Then
                        
                            lParserLevel = lParserLevel + 1

                        ElseIf strSeg = "}" Then
                        
                            ASE_CheckBlockTermination
                            lParserLevel = lParserLevel - 1
                        
                        End If
                        
                        ReDim Preserve lpstrArguments(lArgument) As String
                        lpstrArguments(lArgument) = strSeg
                        lArgument = lArgument + 1
                        
                    End If

                Next l
                
                ASE_ParseArguments lpstrArguments
                
            End If

        End If

    Wend

    ConPrint "[brk]  [c15]file reading complete.[c07][brk]  (" & lVerticesSum & " vertices, " & lVerticesSum / 3 & " faces in " & clScene.Col_clGeoObjects.Count & " objects)[brk][brk]"

    Close #iFileNo

End Sub

Private Function ASE_CreateD3DVectorFromASE(lpstrArguments() As String) As D3DVECTOR

    With ASE_CreateD3DVectorFromASE
    
        ' .ase saves in -X/-Z/+Y format (seen from our 3d world)
        
        .X = -Val(lpstrArguments(2))
        .Y = Val(lpstrArguments(4))
        .Z = -Val(lpstrArguments(3))
    
    End With
    
End Function

Private Function ASE_CreateD3DColorValueFromASE(sgAlpha As Single, lpstrArguments() As String) As D3DCOLORVALUE

    With ASE_CreateD3DColorValueFromASE
    
        .A = sgAlpha
        .R = Val(lpstrArguments(1))
        .G = Val(lpstrArguments(2))
        .B = Val(lpstrArguments(3))
        
    End With

End Function

Private Function ASE_CreateColorValueFromASE(lpstrArguments() As String) As Long

    ASE_CreateColorValueFromASE = RGB(255 * Val(lpstrArguments(3)), 255 * Val(lpstrArguments(2)), 255 * Val(lpstrArguments(1)))

End Function

Private Sub ASE_ParseArguments(lpstrArguments() As String)

Dim lArgumentsCount As Long
Dim lCount As Long
Dim strTextureFilePath As String
Dim vecNormal As D3DVECTOR

Dim v0 As D3DVECTOR
Dim v1 As D3DVECTOR
Dim v2 As D3DVECTOR

    lArgumentsCount = UBound(lpstrArguments) + 1
    
    Select Case lpstrArguments(0)

        Case "*SCENE"

            eParserState = ePS_SceneDefinition

        Case "*SCENE_BACKGROUND_STATIC"

            clScene.lBackgroundColour = ASE_CreateColorValueFromASE(lpstrArguments())

        Case "*SCENE_AMBIENT_STATIC"

            clScene.lAmbientLightColour = ASE_CreateColorValueFromASE(lpstrArguments())

        Case "*MATERIAL_LIST"
        
            eParserState = ePS_MaterialList
            
        Case "*MATERIAL"
        
            eParserState = ePS_MaterialDefinition
            tpCurrentD3DMaterial = tpEmptyD3DMaterial
            
        Case "*MATERIAL_AMBIENT"
        
            tpCurrentD3DMaterial.Ambient = ASE_CreateD3DColorValueFromASE(1, lpstrArguments)
            
        Case "*MATERIAL_DIFFUSE"
        
            tpCurrentD3DMaterial.diffuse = ASE_CreateD3DColorValueFromASE(1, lpstrArguments)
            
        Case "*MATERIAL_SPECULAR"
        
            tpCurrentD3DMaterial.Specular = ASE_CreateD3DColorValueFromASE(1, lpstrArguments)
            
        Case "*MAP_DIFFUSE"
        
            Set clCurrentD3DTexture = Nothing
            eParserState = ePS_MaterialTextureDefinition
        
        Case "*BITMAP"
        
            strTextureFilePath = App.Path + "\Scenes\Textures\" + UnQuote(GetFilenameOfFullPath(lpstrArguments(UBound(lpstrArguments))))
            Set clCurrentD3DTexture = clSystem.D3DX8.CreateTextureFromFileEx(clD3DDevice, strTextureFilePath, 256, 256, 1, 0, tpUsedDispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)

            ConPrint Const_strConsoleTextLineIndent + "reading texture """ + GetFilenameOfFullPath(strTextureFilePath) + """.[brk]"
            
        Case "*SHAPEOBJECT"
        
            Set clCurrentObject = New Class_GeoObject
            eParserState = ePS_ShapeDefinition
            ConPrint Const_strConsoleTextLineIndent + "reading shape...[brk]"
        
        Case "*SHAPE_LINE"
        
            eParserState = ePS_ShapeLineVertexList
            
        Case "*GEOMOBJECT"
        
            l1 = Benchmark(0)
            Set clCurrentObject = New Class_GeoObject
            eParserState = ePS_ObjectDefinition
            ConPrint Const_strConsoleTextLineIndent + "reading obj #" & clScene.Col_clGeoObjects.Count + 1 & "...[brk]"
        
        Case "*NODE_NAME"
        
            If eParserState = ePS_ObjectDefinition Or eParserState = ePS_ShapeDefinition Then
            
                clCurrentObject.strName = UnQuote(lpstrArguments(1))
                ConPrint "  name: """ + clCurrentObject.strName + """[brk]"
            
            End If
            
        Case "*NODE_TM"
        
            If eParserState = ePS_ObjectDefinition Then
            
                eParserState = ePS_ObjectNodeDefinition
        
            ElseIf eParserState = ePS_ShapeDefinition Then
            
                eParserState = ePS_ShapeNodeDefinition
            
            End If
        
        Case "*TM_POS"
        
            With clCurrentObject
            
                .sgPositionX = Val(lpstrArguments(1))
                .sgPositionY = Val(lpstrArguments(2))
                .sgPositionZ = Val(lpstrArguments(3))
                
            End With
        
        Case "*MESH"
        
            eParserState = ePS_ObjectMeshDefinition
            ConPrint "  reading mesh data..."
        
        Case "*MESH_VERTEX_LIST"
        
            eParserState = ePS_ObjectMeshVertexList
        
        Case "*MESH_VERTEX", "*SHAPE_VERTEX_KNOT", "*SHAPE_VERTEX_INTERP"
        
            lCount = Val(lpstrArguments(1))
            ReDim Preserve lptpCurrentD3DVectorList(lCount) As D3DVECTOR
            lptpCurrentD3DVectorList(lCount) = ASE_CreateD3DVectorFromASE(lpstrArguments)
        
        Case "*MESH_FACE_LIST"
        
            eParserState = ePS_ObjectMeshFaceList
        
        Case "*MESH_FACE"
        
            lCount = Val(lpstrArguments(1)) * 3
            ReDim Preserve lpVCurrentVertexList(lCount + 2) As D3DVERTEX
        
            With lpVCurrentVertexList(lCount)
            
                .X = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).X
                .Y = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).Y
                .Z = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).Z
            
                v0.X = .X
                v0.Y = .Y
                v0.Z = .Z
                
            End With
            
            With lpVCurrentVertexList(lCount + 1)
            
                .X = lptpCurrentD3DVectorList(Val(lpstrArguments(5))).X
                .Y = lptpCurrentD3DVectorList(Val(lpstrArguments(5))).Y
                .Z = lptpCurrentD3DVectorList(Val(lpstrArguments(5))).Z
            
                v1.X = .X
                v1.Y = .Y
                v1.Z = .Z
                
            End With
            
            With lpVCurrentVertexList(lCount + 2)
            
                .X = lptpCurrentD3DVectorList(Val(lpstrArguments(7))).X
                .Y = lptpCurrentD3DVectorList(Val(lpstrArguments(7))).Y
                .Z = lptpCurrentD3DVectorList(Val(lpstrArguments(7))).Z
            
                v2.X = .X
                v2.Y = .Y
                v2.Z = .Z
                
            End With
            
            vecNormal = GetNormal(v0, v1, v2)
            
            With vecNormal
            
                .X = -.X
                .Y = -.Y
                .Z = -.Z
                
            End With
            
            With lpVCurrentVertexList(lCount)

                .nX = vecNormal.X
                .nY = vecNormal.Y
                .nZ = vecNormal.Z

            End With

            With lpVCurrentVertexList(lCount + 1)

                .nX = vecNormal.X
                .nY = vecNormal.Y
                .nZ = vecNormal.Z

            End With

            With lpVCurrentVertexList(lCount + 2)

                .nX = vecNormal.X
                .nY = vecNormal.Y
                .nZ = vecNormal.Z

            End With
        
        Case "*MESH_TVERTLIST"
        
            eParserState = ePS_ObjectMeshTVectorList
        
        Case "*MESH_TVERT"
        
            lCount = Val(lpstrArguments(1))
            ReDim Preserve lptpCurrentD3DVectorList(lCount) As D3DVECTOR
            lptpCurrentD3DVectorList(lCount).X = Val(lpstrArguments(2))
            lptpCurrentD3DVectorList(lCount).Y = 1 - Val(lpstrArguments(3))
        
        Case "*MESH_TFACELIST"
        
            eParserState = ePS_ObjectMeshTFaceList

        Case "*MESH_TFACE"
        
            lCount = Val(lpstrArguments(1)) * 3
        
            With lpVCurrentVertexList(lCount)
            
                .tU = lptpCurrentD3DVectorList(Val(lpstrArguments(2))).X
                .tV = lptpCurrentD3DVectorList(Val(lpstrArguments(2))).Y
            
            End With
            
            With lpVCurrentVertexList(lCount + 1)
            
                .tU = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).X
                .tV = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).Y
            
            End With
            
            With lpVCurrentVertexList(lCount + 2)
            
                .tU = lptpCurrentD3DVectorList(Val(lpstrArguments(4))).X
                .tV = lptpCurrentD3DVectorList(Val(lpstrArguments(4))).Y
            
            End With
            
        Case "*MESH_NORMALS"
        
            eParserState = ePS_ObjectMeshNormals

        Case "*MATERIAL_REF"
        
            clCurrentObject.lMaterialIndex = Val(lpstrArguments(1))

    End Select

End Sub

Public Sub ASE_CheckBlockTermination()

Dim lCount As Long
Dim lDataSize As Long

    Select Case eParserState
    
        Case ePS_SceneDefinition
        
            eParserState = ePS_OutsideBlock
            
        Case ePS_MaterialList
        
            eParserState = ePS_OutsideBlock
            
        Case ePS_MaterialDefinition
        
            On Error Resume Next
            
            lCount = 0
            lCount = UBound(lptpMatSceneMaterials) + 1
            
            On Error GoTo 0
            
            ReDim Preserve lptpMatSceneMaterials(lCount) As D3DMATERIAL8
        
            lptpMatSceneMaterials(lCount) = tpCurrentD3DMaterial
            tpCurrentD3DMaterial = tpEmptyD3DMaterial
            eParserState = ePS_MaterialList
            
            ConPrint Const_strConsoleTextLineIndent + "material #" & lCount & " read.[brk]"
            
        Case ePS_MaterialTextureDefinition
        
            On Error Resume Next
            lCount = 0
            lCount = UBound(lptpMatSceneMaterials) + 1
            On Error GoTo 0
            
            gCol_Geo_TexDiffuseTextures.Add clCurrentD3DTexture, "t" & lCount
            Set clCurrentD3DTexture = Nothing
            eParserState = ePS_MaterialDefinition
        
        Case ePS_ShapeDefinition
        
            eParserState = ePS_OutsideBlock
            
            If clCurrentObject.strName = "(track.path)" Then
            
                clScene.VecPlayerStartPosition = lptpCurrentD3DVectorList(UBound(lptpCurrentD3DVectorList) - 1)
            
            ElseIf Left(clCurrentObject.strName, 2) = "ts" And UBound(lptpCurrentD3DVectorList) = 1 Then
            
                Dim clTrackSegment As New Class_TrackSegment
                
                clTrackSegment.SetPoints lptpCurrentD3DVectorList(0), lptpCurrentD3DVectorList(1)
                
                clScene.Col_clTrackSegments.Add clTrackSegment
            
            End If
            
        Case ePS_ShapeNodeDefinition
        
            eParserState = ePS_ShapeDefinition
            
        Case ePS_ShapeLineVertexList
        
            eParserState = ePS_ShapeDefinition
            
        Case ePS_ObjectDefinition

            clScene.Col_clGeoObjects.Add clCurrentObject
            Set clCurrentObject = Nothing
            eParserState = ePS_OutsideBlock
            
            ConPrint "  [c11](object read in " & Benchmark(l1) & " ms)[c15][brk]"

        Case ePS_ObjectNodeDefinition

            eParserState = ePS_ObjectDefinition
        
        Case ePS_ObjectMeshDefinition

            Dim clCurrentVertexBuffer As Direct3DVertexBuffer8
            
            On Error Resume Next
            lCount = 0
            lCount = UBound(lpVCurrentVertexList) + 1
            On Error GoTo 0
            
            clCurrentObject.lVertexCount = lCount
            lVerticesSum = lVerticesSum + lCount
            
            lDataSize = Len(lpVCurrentVertexList(0)) * lCount
            
            Set clCurrentVertexBuffer = clD3DDevice.CreateVertexBuffer(lDataSize, 0, Const_lFVF_Vertex, D3DPOOL_MANAGED)
            
            If clCurrentVertexBuffer Is Nothing Then
            
                ConPrint "[c03]could not create vertex buffer! maybe no adapter memory left.[c15][brk]"
                
            Else
            
                D3DVertexBuffer8SetData clCurrentVertexBuffer, 0, lDataSize, 0, lpVCurrentVertexList(0)
                clCurrentObject.D3DVertexBuffer = clCurrentVertexBuffer
                
            End If
        
            Set clCurrentVertexBuffer = Nothing
            
            If clCurrentObject.strName = "track.ground" Or Left(clCurrentObject.strName, 6) = "street" Then ASE_CreateTrackMap lpVCurrentVertexList, clCurrentObject.sgPositionX, clCurrentObject.sgPositionZ
            
            lpVCurrentVertexList = lpVEmptyVertexList
            eParserState = ePS_ObjectDefinition
            
            ConPrint "ready. (" & clCurrentObject.lVertexCount / 3 & " faces).[brk]"
            
        Case ePS_ObjectMeshVertexList

            eParserState = ePS_ObjectMeshDefinition
            
        Case ePS_ObjectMeshFaceList

            eParserState = ePS_ObjectMeshDefinition
            
        Case ePS_ObjectMeshTVectorList

            eParserState = ePS_ObjectMeshDefinition
            
        Case ePS_ObjectMeshTFaceList

            eParserState = ePS_ObjectMeshDefinition
            
        Case ePS_ObjectMeshNormals

            eParserState = ePS_ObjectMeshDefinition
            
    End Select

End Sub

Private Sub ASE_CreateTrackMap(lpVVertexList() As D3DVERTEX, sgOffsetX As Single, sgOffsetZ As Single)

Dim l As Long
Dim lCount As Long

Dim sgMidX As Single
Dim sgMidY As Single

Dim sgScale As Single

Dim lpPolygonPoints(2) As POINTAPI

    On Error Resume Next
    lCount = 0
    lCount = UBound(lpVCurrentVertexList)
    On Error GoTo 0
    
    sgScale = 1
    
    sgMidX = Form_D3D.Picture_TrackMap.ScaleWidth / 2 ' - sgScale * sgOffsetX
    sgMidY = Form_D3D.Picture_TrackMap.ScaleHeight / 2 ' + sgScale * sgOffsetZ
    
    Form_D3D.Picture_TrackMap.AutoRedraw = True
    
    For l = 0 To lCount Step 3
    
        lpPolygonPoints(0).X = sgMidX - sgScale * lpVCurrentVertexList(l).X
        lpPolygonPoints(0).Y = sgMidY + sgScale * lpVCurrentVertexList(l).Z
        
        lpPolygonPoints(1).X = sgMidX - sgScale * lpVCurrentVertexList(l + 1).X
        lpPolygonPoints(1).Y = sgMidY + sgScale * lpVCurrentVertexList(l + 1).Z
        
        lpPolygonPoints(2).X = sgMidX - sgScale * lpVCurrentVertexList(l + 2).X
        lpPolygonPoints(2).Y = sgMidY + sgScale * lpVCurrentVertexList(l + 2).Z
        
        Polygon Form_D3D.Picture_TrackMap.hdc, lpPolygonPoints(0), 3

    Next l

    Form_Debug.Picture_Debug.Move 0, 0, Form_D3D.Picture_TrackMap.Width + 2, Form_D3D.Picture_TrackMap.Height + 2
    
    With Form_Debug.Picture_Debug
    
        .AutoRedraw = True
        .PaintPicture Form_D3D.Picture_TrackMap.Image, 0, 0
        .AutoRedraw = False
        .ForeColor = RGB(96, 96, 96)
        
    End With
    
End Sub

Public Sub DeleteScene()

    clGame.bSceneLoaded = False
    
    Set clScene = New Class_Scene
    
    Set gCol_Geo_TexDiffuseTextures = New Collection
    lptpMatSceneMaterials = lptpEmptyD3DMaterialList
    
    lVerticesSum = 0

End Sub
1	Attribute VB_Name = "Module_ASE"
2	Option Explicit
3
4	Enum enumParserState
5
6	ePS_OutsideBlock
7	ePS_SceneDefinition
8	ePS_MaterialList
9	ePS_MaterialDefinition
10	ePS_MaterialTextureDefinition
11	ePS_ShapeDefinition
12	ePS_ShapeNodeDefinition
13	ePS_ShapeLineVertexList
14	ePS_ObjectDefinition
15	ePS_ObjectNodeDefinition
16	ePS_ObjectMeshDefinition
17	ePS_ObjectMeshVertexList
18	ePS_ObjectMeshFaceList
19	ePS_ObjectMeshTVectorList
20	ePS_ObjectMeshTFaceList
21	ePS_ObjectMeshNormals
22
23	End Enum
24
25	Dim lptpEmptyD3DMaterialList() As D3DMATERIAL8
26
27	Dim eParserState As enumParserState
28
29	Dim l1 As Long
30
31	Dim lParserLevel As Long
32
33	Dim lVerticesSum As Long
34
35	Dim clCurrentObject As Class_GeoObject
36
37	Dim lpVCurrentVertexList() As D3DVERTEX
38	Dim lpVEmptyVertexList() As D3DVERTEX
39
40	Dim lptpCurrentD3DVectorList() As D3DVECTOR
41	Dim lptpEmptyD3DVectorList() As D3DVECTOR
42
43	Dim tpCurrentD3DMaterial As D3DMATERIAL8
44	Dim tpEmptyD3DMaterial As D3DMATERIAL8
45
46	Dim clCurrentD3DTexture As Direct3DTexture8
47	'
48
49	Public Sub OpenGeometryFromASE2(strFilePath As String)
50
51	Dim iFileNo As Integer
52
53	Dim l As Long
54
55	Dim lArgument As Long
56	Dim lSegCount As Long
57
58	Dim strFileLine As String
59	Dim strSeg As String
60
61	Dim lpstrArguments() As String
62	Dim lpstrSegs() As String
63
64	DeleteScene
65
66	iFileNo = FreeFile
67
68	Open strFilePath For Input As #iFileNo
69
70	ConPrint Const_strConsoleBlockTitlePre + "opening """ + GetFilenameOfFullPath(strFilePath) + """:" + Const_strConsoleBlockTitlePost
71
72	eParserState = ePS_OutsideBlock
73	lParserLevel = 0
74
75	While Not EOF(iFileNo)
76
77	Line Input #iFileNo, strFileLine
78
79	strFileLine = Trim(strFileLine)
80
81	If strFileLine <> "" Then
82
83	strFileLine = Replace(strFileLine, vbTab, " ")
84
85	lpstrSegs = Split(strFileLine, " ")
86
87	lSegCount = UBound(lpstrSegs)
88
89	If lSegCount > -1 Then
90
91	ReDim lpstrArguments(0) As String
92	lArgument = 0
93
94	For l = 0 To lSegCount
95
96	strSeg = Trim(lpstrSegs(l))
97
98	If strSeg <> "" Then
99
100	If strSeg = "{" Then
101
102	lParserLevel = lParserLevel + 1
103
104	ElseIf strSeg = "}" Then
105
106	ASE_CheckBlockTermination
107	lParserLevel = lParserLevel - 1
108
109	End If
110
111	ReDim Preserve lpstrArguments(lArgument) As String
112	lpstrArguments(lArgument) = strSeg
113	lArgument = lArgument + 1
114
115	End If
116
117	Next l
118
119	ASE_ParseArguments lpstrArguments
120
121	End If
122
123	End If
124
125	Wend
126
127	ConPrint "[brk] [c15]file reading complete.[c07][brk] (" & lVerticesSum & " vertices, " & lVerticesSum / 3 & " faces in " & clScene.Col_clGeoObjects.Count & " objects)[brk][brk]"
128
129	Close #iFileNo
130
131	End Sub
132
133	Private Function ASE_CreateD3DVectorFromASE(lpstrArguments() As String) As D3DVECTOR
134
135	With ASE_CreateD3DVectorFromASE
136
137	' .ase saves in -X/-Z/+Y format (seen from our 3d world)
138
139	.X = -Val(lpstrArguments(2))
140	.Y = Val(lpstrArguments(4))
141	.Z = -Val(lpstrArguments(3))
142
143	End With
144
145	End Function
146
147	Private Function ASE_CreateD3DColorValueFromASE(sgAlpha As Single, lpstrArguments() As String) As D3DCOLORVALUE
148
149	With ASE_CreateD3DColorValueFromASE
150
151	.A = sgAlpha
152	.R = Val(lpstrArguments(1))
153	.G = Val(lpstrArguments(2))
154	.B = Val(lpstrArguments(3))
155
156	End With
157
158	End Function
159
160	Private Function ASE_CreateColorValueFromASE(lpstrArguments() As String) As Long
161
162	ASE_CreateColorValueFromASE = RGB(255 * Val(lpstrArguments(3)), 255 * Val(lpstrArguments(2)), 255 * Val(lpstrArguments(1)))
163
164	End Function
165
166	Private Sub ASE_ParseArguments(lpstrArguments() As String)
167
168	Dim lArgumentsCount As Long
169	Dim lCount As Long
170	Dim strTextureFilePath As String
171	Dim vecNormal As D3DVECTOR
172
173	Dim v0 As D3DVECTOR
174	Dim v1 As D3DVECTOR
175	Dim v2 As D3DVECTOR
176
177	lArgumentsCount = UBound(lpstrArguments) + 1
178
179	Select Case lpstrArguments(0)
180
181	Case "*SCENE"
182
183	eParserState = ePS_SceneDefinition
184
185	Case "*SCENE_BACKGROUND_STATIC"
186
187	clScene.lBackgroundColour = ASE_CreateColorValueFromASE(lpstrArguments())
188
189	Case "*SCENE_AMBIENT_STATIC"
190
191	clScene.lAmbientLightColour = ASE_CreateColorValueFromASE(lpstrArguments())
192
193	Case "*MATERIAL_LIST"
194
195	eParserState = ePS_MaterialList
196
197	Case "*MATERIAL"
198
199	eParserState = ePS_MaterialDefinition
200	tpCurrentD3DMaterial = tpEmptyD3DMaterial
201
202	Case "*MATERIAL_AMBIENT"
203
204	tpCurrentD3DMaterial.Ambient = ASE_CreateD3DColorValueFromASE(1, lpstrArguments)
205
206	Case "*MATERIAL_DIFFUSE"
207
208	tpCurrentD3DMaterial.diffuse = ASE_CreateD3DColorValueFromASE(1, lpstrArguments)
209
210	Case "*MATERIAL_SPECULAR"
211
212	tpCurrentD3DMaterial.Specular = ASE_CreateD3DColorValueFromASE(1, lpstrArguments)
213
214	Case "*MAP_DIFFUSE"
215
216	Set clCurrentD3DTexture = Nothing
217	eParserState = ePS_MaterialTextureDefinition
218
219	Case "*BITMAP"
220
221	strTextureFilePath = App.Path + "\Scenes\Textures\" + UnQuote(GetFilenameOfFullPath(lpstrArguments(UBound(lpstrArguments))))
222	Set clCurrentD3DTexture = clSystem.D3DX8.CreateTextureFromFileEx(clD3DDevice, strTextureFilePath, 256, 256, 1, 0, tpUsedDispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
223
224	ConPrint Const_strConsoleTextLineIndent + "reading texture """ + GetFilenameOfFullPath(strTextureFilePath) + """.[brk]"
225
226	Case "*SHAPEOBJECT"
227
228	Set clCurrentObject = New Class_GeoObject
229	eParserState = ePS_ShapeDefinition
230	ConPrint Const_strConsoleTextLineIndent + "reading shape...[brk]"
231
232	Case "*SHAPE_LINE"
233
234	eParserState = ePS_ShapeLineVertexList
235
236	Case "*GEOMOBJECT"
237
238	l1 = Benchmark(0)
239	Set clCurrentObject = New Class_GeoObject
240	eParserState = ePS_ObjectDefinition
241	ConPrint Const_strConsoleTextLineIndent + "reading obj #" & clScene.Col_clGeoObjects.Count + 1 & "...[brk]"
242
243	Case "*NODE_NAME"
244
245	If eParserState = ePS_ObjectDefinition Or eParserState = ePS_ShapeDefinition Then
246
247	clCurrentObject.strName = UnQuote(lpstrArguments(1))
248	ConPrint " name: """ + clCurrentObject.strName + """[brk]"
249
250	End If
251
252	Case "*NODE_TM"
253
254	If eParserState = ePS_ObjectDefinition Then
255
256	eParserState = ePS_ObjectNodeDefinition
257
258	ElseIf eParserState = ePS_ShapeDefinition Then
259
260	eParserState = ePS_ShapeNodeDefinition
261
262	End If
263
264	Case "*TM_POS"
265
266	With clCurrentObject
267
268	.sgPositionX = Val(lpstrArguments(1))
269	.sgPositionY = Val(lpstrArguments(2))
270	.sgPositionZ = Val(lpstrArguments(3))
271
272	End With
273
274	Case "*MESH"
275
276	eParserState = ePS_ObjectMeshDefinition
277	ConPrint " reading mesh data..."
278
279	Case "*MESH_VERTEX_LIST"
280
281	eParserState = ePS_ObjectMeshVertexList
282
283	Case "MESH_VERTEX", "SHAPE_VERTEX_KNOT", "*SHAPE_VERTEX_INTERP"
284
285	lCount = Val(lpstrArguments(1))
286	ReDim Preserve lptpCurrentD3DVectorList(lCount) As D3DVECTOR
287	lptpCurrentD3DVectorList(lCount) = ASE_CreateD3DVectorFromASE(lpstrArguments)
288
289	Case "*MESH_FACE_LIST"
290
291	eParserState = ePS_ObjectMeshFaceList
292
293	Case "*MESH_FACE"
294
295	lCount = Val(lpstrArguments(1)) * 3
296	ReDim Preserve lpVCurrentVertexList(lCount + 2) As D3DVERTEX
297
298	With lpVCurrentVertexList(lCount)
299
300	.X = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).X
301	.Y = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).Y
302	.Z = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).Z
303
304	v0.X = .X
305	v0.Y = .Y
306	v0.Z = .Z
307
308	End With
309
310	With lpVCurrentVertexList(lCount + 1)
311
312	.X = lptpCurrentD3DVectorList(Val(lpstrArguments(5))).X
313	.Y = lptpCurrentD3DVectorList(Val(lpstrArguments(5))).Y
314	.Z = lptpCurrentD3DVectorList(Val(lpstrArguments(5))).Z
315
316	v1.X = .X
317	v1.Y = .Y
318	v1.Z = .Z
319
320	End With
321
322	With lpVCurrentVertexList(lCount + 2)
323
324	.X = lptpCurrentD3DVectorList(Val(lpstrArguments(7))).X
325	.Y = lptpCurrentD3DVectorList(Val(lpstrArguments(7))).Y
326	.Z = lptpCurrentD3DVectorList(Val(lpstrArguments(7))).Z
327
328	v2.X = .X
329	v2.Y = .Y
330	v2.Z = .Z
331
332	End With
333
334	vecNormal = GetNormal(v0, v1, v2)
335
336	With vecNormal
337
338	.X = -.X
339	.Y = -.Y
340	.Z = -.Z
341
342	End With
343
344	With lpVCurrentVertexList(lCount)
345
346	.nX = vecNormal.X
347	.nY = vecNormal.Y
348	.nZ = vecNormal.Z
349
350	End With
351
352	With lpVCurrentVertexList(lCount + 1)
353
354	.nX = vecNormal.X
355	.nY = vecNormal.Y
356	.nZ = vecNormal.Z
357
358	End With
359
360	With lpVCurrentVertexList(lCount + 2)
361
362	.nX = vecNormal.X
363	.nY = vecNormal.Y
364	.nZ = vecNormal.Z
365
366	End With
367
368	Case "*MESH_TVERTLIST"
369
370	eParserState = ePS_ObjectMeshTVectorList
371
372	Case "*MESH_TVERT"
373
374	lCount = Val(lpstrArguments(1))
375	ReDim Preserve lptpCurrentD3DVectorList(lCount) As D3DVECTOR
376	lptpCurrentD3DVectorList(lCount).X = Val(lpstrArguments(2))
377	lptpCurrentD3DVectorList(lCount).Y = 1 - Val(lpstrArguments(3))
378
379	Case "*MESH_TFACELIST"
380
381	eParserState = ePS_ObjectMeshTFaceList
382
383	Case "*MESH_TFACE"
384
385	lCount = Val(lpstrArguments(1)) * 3
386
387	With lpVCurrentVertexList(lCount)
388
389	.tU = lptpCurrentD3DVectorList(Val(lpstrArguments(2))).X
390	.tV = lptpCurrentD3DVectorList(Val(lpstrArguments(2))).Y
391
392	End With
393
394	With lpVCurrentVertexList(lCount + 1)
395
396	.tU = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).X
397	.tV = lptpCurrentD3DVectorList(Val(lpstrArguments(3))).Y
398
399	End With
400
401	With lpVCurrentVertexList(lCount + 2)
402
403	.tU = lptpCurrentD3DVectorList(Val(lpstrArguments(4))).X
404	.tV = lptpCurrentD3DVectorList(Val(lpstrArguments(4))).Y
405
406	End With
407
408	Case "*MESH_NORMALS"
409
410	eParserState = ePS_ObjectMeshNormals
411
412	Case "*MATERIAL_REF"
413
414	clCurrentObject.lMaterialIndex = Val(lpstrArguments(1))
415
416	End Select
417
418	End Sub
419
420	Public Sub ASE_CheckBlockTermination()
421
422	Dim lCount As Long
423	Dim lDataSize As Long
424
425	Select Case eParserState
426
427	Case ePS_SceneDefinition
428
429	eParserState = ePS_OutsideBlock
430
431	Case ePS_MaterialList
432
433	eParserState = ePS_OutsideBlock
434
435	Case ePS_MaterialDefinition
436
437	On Error Resume Next
438
439	lCount = 0
440	lCount = UBound(lptpMatSceneMaterials) + 1
441
442	On Error GoTo 0
443
444	ReDim Preserve lptpMatSceneMaterials(lCount) As D3DMATERIAL8
445
446	lptpMatSceneMaterials(lCount) = tpCurrentD3DMaterial
447	tpCurrentD3DMaterial = tpEmptyD3DMaterial
448	eParserState = ePS_MaterialList
449
450	ConPrint Const_strConsoleTextLineIndent + "material #" & lCount & " read.[brk]"
451
452	Case ePS_MaterialTextureDefinition
453
454	On Error Resume Next
455	lCount = 0
456	lCount = UBound(lptpMatSceneMaterials) + 1
457	On Error GoTo 0
458
459	gCol_Geo_TexDiffuseTextures.Add clCurrentD3DTexture, "t" & lCount
460	Set clCurrentD3DTexture = Nothing
461	eParserState = ePS_MaterialDefinition
462
463	Case ePS_ShapeDefinition
464
465	eParserState = ePS_OutsideBlock
466
467	If clCurrentObject.strName = "(track.path)" Then
468
469	clScene.VecPlayerStartPosition = lptpCurrentD3DVectorList(UBound(lptpCurrentD3DVectorList) - 1)
470
471	ElseIf Left(clCurrentObject.strName, 2) = "ts" And UBound(lptpCurrentD3DVectorList) = 1 Then
472
473	Dim clTrackSegment As New Class_TrackSegment
474
475	clTrackSegment.SetPoints lptpCurrentD3DVectorList(0), lptpCurrentD3DVectorList(1)
476
477	clScene.Col_clTrackSegments.Add clTrackSegment
478
479	End If
480
481	Case ePS_ShapeNodeDefinition
482
483	eParserState = ePS_ShapeDefinition
484
485	Case ePS_ShapeLineVertexList
486
487	eParserState = ePS_ShapeDefinition
488
489	Case ePS_ObjectDefinition
490
491	clScene.Col_clGeoObjects.Add clCurrentObject
492	Set clCurrentObject = Nothing
493	eParserState = ePS_OutsideBlock
494
495	ConPrint " [c11](object read in " & Benchmark(l1) & " ms)[c15][brk]"
496
497	Case ePS_ObjectNodeDefinition
498
499	eParserState = ePS_ObjectDefinition
500
501	Case ePS_ObjectMeshDefinition
502
503	Dim clCurrentVertexBuffer As Direct3DVertexBuffer8
504
505	On Error Resume Next
506	lCount = 0
507	lCount = UBound(lpVCurrentVertexList) + 1
508	On Error GoTo 0
509
510	clCurrentObject.lVertexCount = lCount
511	lVerticesSum = lVerticesSum + lCount
512
513	lDataSize = Len(lpVCurrentVertexList(0)) * lCount
514
515	Set clCurrentVertexBuffer = clD3DDevice.CreateVertexBuffer(lDataSize, 0, Const_lFVF_Vertex, D3DPOOL_MANAGED)
516
517	If clCurrentVertexBuffer Is Nothing Then
518
519	ConPrint "[c03]could not create vertex buffer! maybe no adapter memory left.[c15][brk]"
520
521	Else
522
523	D3DVertexBuffer8SetData clCurrentVertexBuffer, 0, lDataSize, 0, lpVCurrentVertexList(0)
524	clCurrentObject.D3DVertexBuffer = clCurrentVertexBuffer
525
526	End If
527
528	Set clCurrentVertexBuffer = Nothing
529
530	If clCurrentObject.strName = "track.ground" Or Left(clCurrentObject.strName, 6) = "street" Then ASE_CreateTrackMap lpVCurrentVertexList, clCurrentObject.sgPositionX, clCurrentObject.sgPositionZ
531
532	lpVCurrentVertexList = lpVEmptyVertexList
533	eParserState = ePS_ObjectDefinition
534
535	ConPrint "ready. (" & clCurrentObject.lVertexCount / 3 & " faces).[brk]"
536
537	Case ePS_ObjectMeshVertexList
538
539	eParserState = ePS_ObjectMeshDefinition
540
541	Case ePS_ObjectMeshFaceList
542
543	eParserState = ePS_ObjectMeshDefinition
544
545	Case ePS_ObjectMeshTVectorList
546
547	eParserState = ePS_ObjectMeshDefinition
548
549	Case ePS_ObjectMeshTFaceList
550
551	eParserState = ePS_ObjectMeshDefinition
552
553	Case ePS_ObjectMeshNormals
554
555	eParserState = ePS_ObjectMeshDefinition
556
557	End Select
558
559	End Sub
560
561	Private Sub ASE_CreateTrackMap(lpVVertexList() As D3DVERTEX, sgOffsetX As Single, sgOffsetZ As Single)
562
563	Dim l As Long
564	Dim lCount As Long
565
566	Dim sgMidX As Single
567	Dim sgMidY As Single
568
569	Dim sgScale As Single
570
571	Dim lpPolygonPoints(2) As POINTAPI
572
573	On Error Resume Next
574	lCount = 0
575	lCount = UBound(lpVCurrentVertexList)
576	On Error GoTo 0
577
578	sgScale = 1
579
580	sgMidX = Form_D3D.Picture_TrackMap.ScaleWidth / 2 ' - sgScale * sgOffsetX
581	sgMidY = Form_D3D.Picture_TrackMap.ScaleHeight / 2 ' + sgScale * sgOffsetZ
582
583	Form_D3D.Picture_TrackMap.AutoRedraw = True
584
585	For l = 0 To lCount Step 3
586
587	lpPolygonPoints(0).X = sgMidX - sgScale * lpVCurrentVertexList(l).X
588	lpPolygonPoints(0).Y = sgMidY + sgScale * lpVCurrentVertexList(l).Z
589
590	lpPolygonPoints(1).X = sgMidX - sgScale * lpVCurrentVertexList(l + 1).X
591	lpPolygonPoints(1).Y = sgMidY + sgScale * lpVCurrentVertexList(l + 1).Z
592
593	lpPolygonPoints(2).X = sgMidX - sgScale * lpVCurrentVertexList(l + 2).X
594	lpPolygonPoints(2).Y = sgMidY + sgScale * lpVCurrentVertexList(l + 2).Z
595
596	Polygon Form_D3D.Picture_TrackMap.hdc, lpPolygonPoints(0), 3
597
598	Next l
599
600	Form_Debug.Picture_Debug.Move 0, 0, Form_D3D.Picture_TrackMap.Width + 2, Form_D3D.Picture_TrackMap.Height + 2
601
602	With Form_Debug.Picture_Debug
603
604	.AutoRedraw = True
605	.PaintPicture Form_D3D.Picture_TrackMap.Image, 0, 0
606	.AutoRedraw = False
607	.ForeColor = RGB(96, 96, 96)
608
609	End With
610
611	End Sub
612
613	Public Sub DeleteScene()
614
615	clGame.bSceneLoaded = False
616
617	Set clScene = New Class_Scene
618
619	Set gCol_Geo_TexDiffuseTextures = New Collection
620	lptpMatSceneMaterials = lptpEmptyD3DMaterialList
621
622	lVerticesSum = 0
623
624	End Sub
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26