/[cvs]/rabit/RaBit's Rapid Racers/Module_ASE.bas
ViewVC logotype

Contents of /rabit/RaBit's Rapid Racers/Module_ASE.bas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Tue Mar 12 21:23:10 2002 UTC (22 years, 9 months ago) by cvsrabit
Branch: NFO, MAIN
CVS Tags: v034a, HEAD
Changes since 1.1: +0 -0 lines
Initial project import

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 RSS 2.0 feed