rabit/RaBit%27s%20Rapid%20Racers/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	cvsrabit	1.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