mapp.bas

游戏常见三为场景

Attribute VB_Name = "mApp"
Option Explicit

 
' APPINITIALIZE: Setup and start
Public Sub AppInitialize()
    
    ' Enable error handling
        On Error GoTo E_AppInitialize
        
    ' Setup local variables ...
    
        Dim L_dDDViewportArea As D3DRECT            ' Area of viewport object for generation of viewport
        Dim L_dDDSurfaceDesc As DDSURFACEDESC2      ' DirectDraw surface description for generation of surfaces
        Dim L_dDDSCAPS As DDSCAPS2                  ' DDCAPS type for backbuffer creation
        Dim L_dM As D3DMATRIX                       ' Matrix for setting up transforms
            
    ' Application specific initialization ...
    
        ' State that initialization is in progress
        G_bAppInitialized = True
        
        ' Initialize statistics
        G_dUser.Stats.Frametime = 0
        
    ' Initialize DirectDraw Instance ...
    
        ' Create instance of DirectDraw
         DirectDrawCreate G_dDXSelectedDriver.GUID, G_oDDInstance, Nothing
        
        ' Check instance existance, terminate if missing
        If G_oDDInstance Is Nothing Then
           AppError 0, "Could not create DirectDraw instance", "AppInitialize"
           Exit Sub
        End If
        
        ' Set DirectDraw cooperative level
        G_oDDInstance.SetCooperativeLevel fApp.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
    
        ' Set display mode
        G_oDDInstance.SetDisplayMode G_nDisplayWidth, G_nDisplayHeight, 16, 0, 0
        
    ' Create primary and backbuffer...
        
        ' For 3DFX, we need a flipping chain ...
        If G_dDXSelectedDriver.DriverType = EDXDTPlus Then
        
            ' Fill surface description
            With L_dDDSurfaceDesc
                .dwSize = Len(L_dDDSurfaceDesc)
                .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
                .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_VIDEOMEMORY Or DDSCAPS_3DDEVICE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
                .dwBackBufferCount = 1
            End With
            
            ' Create surface
            G_oDDInstance.CreateSurface L_dDDSurfaceDesc, G_oDDPrimary, Nothing
                                
            ' Check surface existance, terminate if missing
            If G_oDDPrimary Is Nothing Then
               AppError 0, "Could not create primary surface", "AppInitialize"
               Exit Sub
            End If
            
            ' Fill surface description
            With L_dDDSCAPS
                .dwCaps = DDSCAPS_BACKBUFFER
            End With
            
            ' Add surface
            G_oDDPrimary.GetAttachedSurface L_dDDSCAPS, G_oDDBackBuffer

            ' Check surface existance, terminate if missing
            If G_oDDBackBuffer Is Nothing Then
               AppError 0, "Could not create backbuffer surface", "AppInitialize"
               Exit Sub
            End If
            
        ' ... while for standard adapters or accellerators, blitting is enough
        Else
            
            ' Fill surface description
            With L_dDDSurfaceDesc
                .dwSize = Len(L_dDDSurfaceDesc)
                .dwFlags = DDSD_CAPS
                .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or IIf(G_dDXSelectedDriver.DriverType = EDXDTSoft, DDSCAPS_SYSTEMMEMORY, DDSCAPS_VIDEOMEMORY)
            End With
            
            ' Create surface
            G_oDDInstance.CreateSurface L_dDDSurfaceDesc, G_oDDPrimary, Nothing
                                
            ' Check surface existance, terminate if missing
            If G_oDDPrimary Is Nothing Then
               AppError 0, "Could not create primary surface", "AppInitialize"
               Exit Sub
            End If
            
            ' Create surface
            Set G_oDDBackBuffer = CreateSurface(640, 480, DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE)

            ' Check surface existance, terminate if missing
            If G_oDDBackBuffer Is Nothing Then
               AppError 0, "Could not create backbuffer surface", "AppInitialize"
               Exit Sub
            End If
               
        End If
        
    ' Create Direct3DIM environment ...
    
        ' Query DirectDraw for D3D interface
        Set G_oD3DInstance = G_oDDInstance
        
        ' Check instance existance, terminate if missing
        If G_oD3DInstance Is Nothing Then
           AppError 0, "Could not create Direct3D instance", "AppInitialize"
           Exit Sub
        End If
        
        ' Create device using driver found
        G_oD3DInstance.CreateDevice G_dDXSelectedDriver.D3DDriver.GUID, G_oDDBackBuffer, G_oD3DDevice, Nothing
        
        ' Check device existance, terminate if missing
        If G_oD3DDevice Is Nothing Then
           AppError 0, "Could not create Direct3D Device", "AppInitialize"
           Exit Sub
        End If
        
    ' Initialize render viewport ...
    
        ' Create viewport
        G_oD3DInstance.CreateViewport G_oD3DViewport, Nothing
        
        ' Check viewport existance, terminate if missing
        If G_oD3DViewport Is Nothing Then
           AppError 0, "Could not create Direct3D Viewport", "AppInitialize"
           Exit Sub
        End If
        
        ' Add viewport to device
        G_oD3DDevice.AddViewport G_oD3DViewport
        
        ' Set viewport properties
        Call ViewportInitialize(G_nDisplayWidth - G_dUser.DisplaySize, G_nDisplayHeight - G_dUser.DisplaySize)
        
        ' Make viewport current
        G_oD3DDevice.SetCurrentViewport G_oD3DViewport
        
        ' Prepare and set projection transform
        MIdentity L_dM
        L_dM = MProject(1, 130, 60)
        G_oD3DDevice.SetTransform D3DTRANSFORMSTATE_PROJECTION, L_dM
        
        ' Prepare and set world transform
        MIdentity L_dM
        G_oD3DDevice.SetTransform D3DTRANSFORMSTATE_WORLD, L_dM
        
        ' Prepare render and light states
        With G_oD3DDevice
            ' Set perspective correction for textures
            .SetRenderState D3DRENDERSTATE_TEXTUREPERSPECTIVE, IIf(G_dUser.DisplayOptions.Correct, 1, 0)
            ' Set use of specular lighting off
            .SetRenderState D3DRENDERSTATE_SPECULARENABLE, IIf(G_dUser.DisplayOptions.Specular, 1, 0)
            ' Set filtering for textels appearing larger than one pixel
            .SetRenderState D3DRENDERSTATE_TEXTUREMAG, IIf(G_dUser.DisplayOptions.Filtering, D3DFILTER_LINEAR, D3DFILTER_NEAREST)
            ' Set filtering for textels appearing at pixel size or smaller
            .SetRenderState D3DRENDERSTATE_TEXTUREMIN, IIf(G_dUser.DisplayOptions.Filtering, D3DFILTER_LINEAR, D3DFILTER_NEAREST)
            ' Set texure blending options to combine material with texture
            .SetRenderState D3DRENDERSTATE_TEXTUREMAPBLEND, D3DTBLEND_MODULATE
            ' Set alpha blending options
            .SetRenderState D3DRENDERSTATE_SRCBLEND, IIf(G_dUser.DisplayOptions.Translucent, D3DBLEND_BOTHSRCALPHA, D3DBLEND_ONE)
            ' Set texture color key transparency
            .SetRenderState D3DRENDERSTATE_COLORKEYENABLE, IIf(G_dUser.DisplayOptions.Transparent, 1, 0)
            ' Set ambient light level
            .SetLightState D3DLIGHTSTATE_AMBIENT, D3DRMCreateColorRGBA(0.5, 0.5, 0.5, 1)
            ' Set RGB color model ... just to make sure
            .SetLightState D3DLIGHTSTATE_COLORMODEL, D3DCOLOR_RGB
            ' Set shading mode ... just to make sure
            .SetRenderState D3DRENDERSTATE_SHADEMODE, IIf(G_dUser.DisplayOptions.Phong, D3DSHADE_PHONG, D3DSHADE_GOURAUD)
            ' Set fog properties and enable fogging if desired
            .SetLightState D3DLIGHTSTATE_FOGMODE, D3DFOG_NONE
        End With
        
    ' Initialize DirectSound ...
    
        ' Create DirectSound Instance
        DirectSoundCreate ByVal 0&, G_oDSInstance, Nothing
        
        ' Create primary sound buffer
        Set G_oDSBPrimary = CreatePrimaryAudio
        
        ' Play primary buffer
        G_oDSBPrimary.Play ByVal 0&, ByVal 0&, DSBPLAY_LOOPING
        
        ' Get listener
        Set G_oDSListener = G_oDSBPrimary
        
        ' Set listener properties
        G_oDSListener.SetRolloffFactor 1, DS3D_IMMEDIATE
        
    ' Initialize scene data (graphical and audio) ...
        Call SceneInitialize
                
    ' Hide mouse ...
        ShowCursor 0
        
    ' Error handling ...
       
        Exit Sub

E_AppInitialize:
    Resume Next
        AppError Err.Number, Err.Description, "AppInitialize"
        
End Sub

' APPTERMINATE: Cleanup and termination
Public Sub AppTerminate()
    
    ' Enable error handling
        On Error Resume Next
    
    ' Restore from exclusive fullscreen mode ...
        
        ' Restore old resolution and depth
        G_oDDInstance.RestoreDisplayMode
    
        ' Return control to windows
        G_oDDInstance.SetCooperativeLevel fApp.hwnd, DDSCL_NORMAL
        
        ' Show cursor
        ShowCursor 1
            
    ' Clean up graphical data...
        
        Call SceneTerminate
        
    ' Clean up Direct3D...
        
        Set G_oD3DViewport = Nothing
        Set G_oD3DDevice = Nothing
        Set G_oD3DInstance = Nothing
        
    ' Clean up DirectSound...
        G_oDSBPrimary.Stop
        Set G_oDSListener = Nothing
        Set G_oDSBPrimary = Nothing
        Set G_oDSInstance = Nothing
        
    ' Clean up DirectDraw...
    
        Set G_oDDBackBuffer = Nothing
        Set G_oDDPrimary = Nothing
        Set G_oDDInstance = Nothing

    ' Disable error handling
        On Error GoTo 0

End Sub

' APPLOOP: Main program loop
Public Sub AppLoop()

    ' Enable error handling
        On Error GoTo E_AppLoop
        
    ' Setup local variables ...
        Dim L_nRunF As Integer          ' Variable to run through all faces within mesh data
        Dim L_nRunV As Integer          ' Variable to run through vertices within faces
        Dim L_nWaterFactor As Single    ' Texture factor for water texture
        Dim L_dM As D3DMATRIX           ' Matrix to hold various transforms
        Dim L_dV As D3DVECTOR           ' Vector for camera calculation
        Dim L_dDDBLTFX As DDBLTFX       ' FX Blit descriptor
        Dim L_dRenderArea As RECT       ' Blitting area for various blits
        Dim L_dSourceArea As RECT       ' Blitting area for various blits
        Dim L_dDDSD As DDSURFACEDESC2   ' Description of surface to be obtained by lock
        Dim L_nSurfaceDC As Long        ' Pointer to the surface for locking
        
        Dim L_nRunStars As Integer      ' Variable to run through star array
        Dim L_nPosX As Integer          ' Star position after calculations
        Dim L_nPosY As Integer          ' Star position after calculations
        Dim L_nAltitudeFactor As Single ' Altitude factor to correct  star position
        Dim L_nWidthFactor As Single    ' Width Factor to correct star position
       
        Dim L_nCurrentTime As Double    ' Current time for frame timing
        Dim L_nNextSecond As Double     ' Next update time for frame timing monitoring
        Dim L_nNextFrametime As Double  ' Next update time for frame timing monitoring
        Dim L_nFrameCount As Double     ' Frames within update period for frame time monitoring
        
    ' Main application loop ...
        
        ' Set app status to running
        G_bAppRunning = True
        
        Do
    
            ' Do frame timing and statistics ...
            
                ' Increase global frame counter
                G_nFrameCount = G_nFrameCount + 1
            
                ' Get frame start time
                L_nCurrentTime = timeGetTime
                
                ' Increase frame count for avg frametime calculation
                L_nFrameCount = L_nFrameCount + 1
                
                ' Protocol frame time: Count frames and write out average frame count every second
                If L_nNextSecond < L_nCurrentTime Then
                    L_nNextSecond = L_nCurrentTime + 1000
                    G_dUser.Stats.Frametime = L_nFrameCount
                    L_nFrameCount = 0
                End If
            
                ' Prepare timing: Set next frame time to current time plus minimum frame duration (50fps , makes for ~20ms, is max.)
                L_nNextFrametime = L_nCurrentTime + 20
                
            ' D3DIM preparing ...
            
                ' Prepare view transform ...
                    
                    With G_dUser
                    
                        ' Set camera lookat to camera position plus viewing data
                        L_dV.X = .Position.X + Int(Cos(.LookH * PIFactor) * 100)
                        L_dV.z = .Position.z + Int(Sin(.LookH * PIFactor) * 100)
                        L_dV.Y = .Position.Y + 5 + .LookV
                        
                        ' Look there
                        L_dM = MLookAt(.Position, L_dV)