mapp.bas

游戏常见三为场景

        
        ' Set viewport properties
        G_oD3DViewport.SetViewport2 L_dD3DViewportDesc

        ' Setup render area for rendering loop
        With G_dRenderArea
            .Top = (G_nDisplayHeight - nHeight) / 2
            .Left = (G_nDisplayWidth - nWidth) / 2
            .Right = .Left + nWidth
            .Bottom = .Top + nHeight
        End With
        With G_dClearArea
            .X1 = 0
            .Y1 = 0
            .X2 = G_nDisplayWidth
            .Y2 = G_nDisplayHeight
        End With
        
    ' Clear buffer
        With L_dDDBLTFX
            .dwSize = Len(L_dDDBLTFX)
            .dwFillColor = 0
        End With
        G_oDDBackBuffer.Blt G_dClearArea, ByVal Nothing, ByVal 0&, DDBLT_COLORFILL Or DDBLT_WAIT, L_dDDBLTFX
        G_oDDPrimary.Blt G_dClearArea, ByVal Nothing, ByVal 0&, DDBLT_COLORFILL Or DDBLT_WAIT, L_dDDBLTFX
        
    ' Error handling ...
        
        Exit Sub
        
E_ViewportInitialize:

    AppError Err.Number, Err.Description, "ViewportInitialize"

End Sub

' SCENEINITIALIZE: Loads 3D data from text file and sets up environment
Public Sub SceneInitialize()

    ' Enable Error handling ...
        
        On Error GoTo E_SceneInitialize
    
    ' Setup local variables ...
        
        Dim L_nRunStar As Integer               ' Variable to run through all stars
        Dim L_nStarColor As Integer             ' Current star color
        Dim L_nRunX As Integer                  ' Variable to run through X coordinates
        Dim L_nRunY As Integer                  ' Variable to run through X coordinates
        Dim L_sInString As String               ' String to read from file
        Dim L_nRunV As Integer                  ' Variable to run through all vertices
        Dim L_nMaterialIndex As Integer         ' Index of current material
        Dim L_nTransformIndex As Integer        ' Index of current transform group
        Dim L_nTranslucent As Integer           ' Translucency flag
        Dim L_nItemCount As Integer             ' Counter for input from file
        Dim L_nRunItem As Integer               ' Variable to run through file input
        Dim L_nTransparent As Integer           ' Transparency flagg
        Dim L_dDDCK As DDCOLORKEY               ' Color key for transparency
        
    ' Load scene data ...
            
        ' Open scene data file
        Open App.Path + "\scene.dat" For Input As #1
        
        ' Input lights ...
        
            ' Get light count, size light array
            Input #1, L_nItemCount
            ReDim G_dScene.Lights(L_nItemCount)
            
            ' Load all lights
            For L_nRunItem = 0 To L_nItemCount - 1
                            
                ' Read light data
                With G_dScene.Lights(L_nRunItem).D3DData
                    .dwSize = Len(G_dScene.Lights(L_nRunItem).D3DData)
                    Input #1, .dltType, .dcvColor.r, .dcvColor.g, .dcvColor.b, .dcvColor.a, .dvRange, .dvPosition.X, .dvPosition.Y, .dvPosition.z, .dvDirection.X, .dvDirection.Y, .dvDirection.z, .dvPhi, .dvTheta, .dvFalloff, .dvAttenuation0, .dvAttenuation1, .dvAttenuation2, .dwFlags
                End With

                ' Create light object, add it to viewport
                With G_dScene.Lights(L_nRunItem)
                    G_oD3DInstance.CreateLight .D3DObject, Nothing
                    .D3DObject.SetLight .D3DData
                    G_oD3DViewport.AddLight .D3DObject
                End With
                
            Next
            
        ' Input textures ...
            
            ' Get texture count, resize texture array
            Input #1, L_nItemCount
            ReDim G_dScene.Textures(L_nItemCount)
            
            ' Load all textures
            For L_nRunItem = 0 To L_nItemCount - 1
                With G_dScene.Textures(L_nRunItem)
                    
                    ' Read texture data
                    Input #1, .Filename, .Width, .Height, L_nTransparent
                    .Transparent = IIf(L_nTransparent = 1, True, False)
                    
                    
                    ' Create/Load texture objects
                    If .Filename = "NONE" Then
                        Set .DDSurface = CreateTexture(.Width)
                    Else
                        Set .DDSurface = LoadTexture(App.Path + "\" + .Filename)
                    End If
                    
                    ' Set color key if transparency enabled
                    If .Transparent Then
                        L_dDDCK.dwColorSpaceLowValue = 0
                        L_dDDCK.dwColorSpaceHighValue = 0
                        .DDSurface.SetColorKey DDCKEY_SRCBLT, L_dDDCK
                    End If
                    
                    ' Get texture handle
                    Set .D3DObject = .DDSurface
                    .D3DObject.GetHandle G_oD3DDevice, .D3DHandle
                    
                End With
            Next
                    
        ' Input materials ...
        
            ' Get material count, size material array
            Input #1, L_nItemCount
            ReDim G_dScene.Materials(L_nItemCount)
            
            ' Load all materials
            For L_nRunItem = 0 To L_nItemCount - 1
                            
                ' Read material data
                With G_dScene.Materials(L_nRunItem).D3DData
                    .dwSize = Len(G_dScene.Materials(L_nRunItem).D3DData)
                    Input #1, G_dScene.Materials(L_nRunItem).D3DTextureIndex, .Ambient.r, .Ambient.g, .Ambient.b, .Ambient.a, .diffuse.r, .diffuse.g, .diffuse.b, .diffuse.a, .Specular.r, .Specular.g, .Specular.b, .Specular.a, .emissive.r, .emissive.g, .emissive.b, .emissive.a, .power
                End With

                ' Create material object
                With G_dScene.Materials(L_nRunItem)
                    G_oD3DInstance.CreateMaterial .D3DObject, Nothing
                    .D3DObject.SetMaterial .D3DData
                    .D3DObject.GetHandle G_oD3DDevice, .D3DHandle
                End With
                
            Next
        
        ' Input meshdata ...
            ReDim G_dScene.Faces(19)
            
            ' Go through records
            Do While Not EOF(1)
                
                ' Read index of transform group and material
                Input #1, L_nTransformIndex, L_nMaterialIndex, L_nItemCount, L_nTranslucent
                
                ' Set properties of face group
                With G_dScene.Faces(L_nTransformIndex)
                    ' Set face group to enabled
                    .Enabled = True
                    ' Set face group translucency status
                    .Translucent = IIf(L_nTranslucent = 1, True, False)
                    ' Set face group vertex count
                    .D3DDataCount = L_nItemCount * 3
                    ' Reference material of group
                    .D3DMaterialIndex = L_nMaterialIndex
                    ' Reference texture of group
                    .D3DTextureIndex = G_dScene.Materials(.D3DMaterialIndex).D3DTextureIndex
                    ' Reference material
                    MIdentity .D3DTransform
                End With
                
                ' Read in vertices
                For L_nRunV = 0 To L_nItemCount - 1
                    With G_dScene.Faces(L_nTransformIndex)
                        Input #1, .D3DData(L_nRunV * 3).X, .D3DData(L_nRunV * 3).Y, .D3DData(L_nRunV * 3).z, .D3DData(L_nRunV * 3).nx, .D3DData(L_nRunV * 3).ny, .D3DData(L_nRunV * 3).nz, .D3DData(L_nRunV * 3).tu, .D3DData(L_nRunV * 3).tv, .D3DData(L_nRunV * 3 + 1).X, .D3DData(L_nRunV * 3 + 1).Y, .D3DData(L_nRunV * 3 + 1).z, .D3DData(L_nRunV * 3 + 1).nx, .D3DData(L_nRunV * 3 + 1).ny, .D3DData(L_nRunV * 3 + 1).nz, .D3DData(L_nRunV * 3 + 1).tu, .D3DData(L_nRunV * 3 + 1).tv, .D3DData(L_nRunV * 3 + 2).X, .D3DData(L_nRunV * 3 + 2).Y, .D3DData(L_nRunV * 3 + 2).z, .D3DData(L_nRunV * 3 + 2).nx, .D3DData(L_nRunV * 3 + 2).ny, .D3DData(L_nRunV * 3 + 2).nz, .D3DData(L_nRunV * 3 + 2).tu, .D3DData(L_nRunV * 3 + 2).tv
                    End With
                Next
                
            Loop
            
        ' Finish...
        
        Close #1
        
    ' Load terrain altitude data
    
        ' Open file ...
        Open App.Path + "\terrain.dat" For Input As #1
        
        ' Read data ...
        For L_nRunX = 0 To 149
            Input #1, L_sInString
            For L_nRunY = 0 To 149
                G_dScene.Terrain(L_nRunX, L_nRunY) = Val(Mid(L_sInString, L_nRunY + 1, 1))
            Next
        Next
        
        ' Finish ...
        Close #1
        
    
    ' Load miscellaneous data (bitmaps)
    
        ' Load text bitmap
        Set G_oDDTextSurface = LoadSurface(App.Path + "\texturetext.bmp")
        
        ' Load water bitmap
        Set G_oDDWaterSurface = LoadSurface(App.Path + "\texturewater.bmp")
        
        ' Load flame bitmap
        Set G_oDDFlameSurface = LoadSurface(App.Path + "\textureflame.bmp")
        
        ' Create color key for compass
        With L_dDDCK
            .dwColorSpaceHighValue = 0
            .dwColorSpaceLowValue = 0
        End With
        
        ' Load compass bitmap
        Set G_oDDCompassSurface = LoadSurface(App.Path + "\texturecompass.bmp")
        G_oDDCompassSurface.SetColorKey DDCKEY_SRCBLT, L_dDDCK
        
    ' Setup star-sprenkled sky (cylinder-projection of 2d-points) ...
    
        For L_nRunStar = 0 To 1999
            With G_dScene.Stars(L_nRunStar)
                .Altitude = Int(Rnd * 1000) - 500
                .Direction = Int(Rnd * 3600)
                L_nStarColor = 125 - .Altitude \ 5 + IIf(Rnd > 0.66, Rnd * 100 - 50, 0)
                If L_nStarColor < 10 Then L_nStarColor = 10
                If L_nStarColor > 250 Then L_nStarColor = 250
                .Color = RGB(L_nStarColor, L_nStarColor, L_nStarColor)
            End With
        Next
        
    ' Initialize 3D sound ...
        
        ' Load wave into sound buffer
        Set G_oDSBDisplaySound = LoadWaveAudio(App.Path + "\Display.wav", True)
        
        ' Create 3D sound buffer, set properties
        Set G_oDS3DBDisplaySound = G_oDSBDisplaySound
        With G_oDS3DBDisplaySound
            .SetMinDistance 1, DS3D_IMMEDIATE
            .SetMaxDistance 50, DS3D_IMMEDIATE
            .SetMode DS3DMODE_NORMAL, DS3D_IMMEDIATE
            .SetPosition 35, 48, 50, DS3D_IMMEDIATE         '(Display)
        End With
        
        ' Start playing sound
        G_oDSBDisplaySound.Play ByVal 0&, ByVal 0&, DSBPLAY_LOOPING
            
    ' Initialize other sound ...
    
        ' Load wave into sound buffer
        Set G_oDSBStepHard = LoadWaveAudio(App.Path + "\stephard.wav")
        Set G_oDSBStepSoft = LoadWaveAudio(App.Path + "\stepsoft.wav")

    ' Error handling ...
        
        Exit Sub
        
E_SceneInitialize:

    Close #1
    AppError Err.Number, Err.Description, "SceneInitialize"
    
End Sub

' SCENETERMINATE: Releases all 3D data
Public Sub SceneTerminate()

    ' Enable Error handling ...
        
        On Error Resume Next
    
    ' Setup local variables ...
        
        Dim nRun As Integer             ' Variable to run through various arrays
        Dim nMaterialIndex As Integer   ' Current Material index
        Dim nTransformIndex As Integer  ' Index of current transform group
        Dim nVertexCount As Integer     ' Number of vertices
        
    ' Remove lights ...
        
        For nRun = 0 To UBound(G_dScene.Lights)
            Set G_dScene.Lights(nRun).D3DObject = Nothing
        Next
    
    ' Remove materials ...
        
        For nRun = 0 To UBound(G_dScene.Materials)
            Set G_dScene.Materials(nRun).D3DObject = Nothing
        Next
        
    ' Remove textures  ...
        
        For nRun = 0 To UBound(G_dScene.Textures)
            Set G_dScene.Textures(nRun).D3DObject = Nothing
            Set G_dScene.Textures(nRun).DDSurface = Nothing
        Next
    
    ' Remove miscellaneos ...
        Set G_oDDTextSurface = Nothing
        Set G_oDDWaterSurface = Nothing
        Set G_oDDFlameSurface = Nothing
        Set G_oDDCompassSurface = Nothing
        
    ' Remove sounds ...
       
        G_oDSBDisplaySound.Stop
        Set G_oDS3DBDisplaySound = Nothing
        Set G_oDSBDisplaySound = Nothing
    
        G_oDSBStepSoft.Stop
        Set G_oDSBStepSoft = Nothing
        
        G_oDSBStepHard.Stop
        Set G_oDSBStepHard = Nothing
        
    ' Error handling ...
        
        On Error GoTo 0
    
End Sub