📄 mapp.bas
字号:
G_oD3DDevice.SetTransform D3DTRANSFORMSTATE_VIEW, L_dM
' Listen there
G_oDSListener.SetOrientation L_dV.X, L_dV.Y, L_dV.z, 0, -1, 0, DS3D_IMMEDIATE
G_oDSListener.SetPosition .Position.X, .Position.Y, .Position.z, DS3D_IMMEDIATE
End With
' D3DIM rendering ...
' Clear...
' Clear 3D buffer
G_oD3DViewport.Clear2 1, G_dClearArea, D3DCLEAR_TARGET, 0, 1, 0
' ' Clear backbuffer (Necessary for some 3DFX cards !?)
' 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
' Draw background ...
' Prepare structure to obtain lock
L_dDDSD.dwSize = Len(L_dDDSD)
L_dDDSD.dwFlags = DDSD_LPSURFACE
' Obtain lock to surface, get DC
G_oDDBackBuffer.GetDC L_nSurfaceDC
' Calculate and draw stars ...
' Incorporate altitude offset
L_nAltitudeFactor = (G_dRenderArea.Bottom - G_dRenderArea.Top) / 107
L_nWidthFactor = (G_dRenderArea.Right - G_dRenderArea.Left) / 640
' Run through all stars
For L_nRunStars = 0 To 1999
' Evaluate relative position of star
With G_dScene.Stars(L_nRunStars)
L_nPosX = .Direction - (G_dUser.LookH * 10) * L_nWidthFactor
If L_nPosX < 0 Then L_nPosX = L_nPosX + 3600
L_nPosY = .Altitude - (G_dUser.LookV * L_nAltitudeFactor)
End With
' Draw star if relative position within display area
With G_dRenderArea
If L_nPosX > .Left And L_nPosX < .Right And L_nPosY > .Top And L_nPosY < .Bottom Then
SetPixelV L_nSurfaceDC, L_nPosX, L_nPosY, G_dScene.Stars(L_nRunStars).Color
End If
End With
Next
' Release lock to surface
G_oDDBackBuffer.ReleaseDC L_nSurfaceDC
' Execute polygons onto Direct3DIM...
With G_oD3DDevice
' Start scene
.BeginScene
' Run through vertex data groups
For L_nRunF = 0 To UBound(G_dScene.Faces) - 1
If G_dScene.Faces(L_nRunF).Enabled Then
' Set group render states (material & transform) ...
' Set transform
Select Case L_nRunF
' Rotating eye (constant rotation)
Case 11
MIdentity L_dM
L_dM = MRotate(L_dM, 0, G_nFrameCount Mod 360, 0)
L_dM = MTranslate(L_dM, 115, 44, 35)
' Flame (Decal: Always faces user position)
Case 13
MIdentity L_dM
L_dM = MRotate(L_dM, 0, 180 + Int(Atn((145 - G_dUser.Position.z) / (35 - G_dUser.Position.X)) / PIFactor), 0)
L_dM = MTranslate(L_dM, 47.5, 37, 147.5)
' Statics
Case Else
MIdentity L_dM
End Select
.SetTransform D3DTRANSFORMSTATE_WORLD, L_dM
' Set material to use
.SetLightState D3DLIGHTSTATE_MATERIAL, G_dScene.Materials(G_dScene.Faces(L_nRunF).D3DMaterialIndex).D3DHandle
' Set texture to use
If G_dUser.DisplayOptions.Mapping And Not (G_dScene.Faces(L_nRunF).D3DTextureIndex = -1) Then
'.SetTexture 0, G_dScene.Faces(L_nRunF).D3DTextureObject
.SetRenderState D3DRENDERSTATE_TEXTUREHANDLE, G_dScene.Textures(G_dScene.Faces(L_nRunF).D3DTextureIndex).D3DHandle
Else
'.SetTexture 0, Nothing
.SetRenderState D3DRENDERSTATE_TEXTUREHANDLE, 0
End If
' Enable/disable translucency
If G_dUser.DisplayOptions.Translucent Then
.SetRenderState D3DRENDERSTATE_ALPHABLENDENABLE, IIf(G_dScene.Faces(L_nRunF).Translucent, 1, 0)
Else
.SetRenderState D3DRENDERSTATE_ALPHABLENDENABLE, 0
End If
' Enable/disable transparency
If G_dUser.DisplayOptions.Transparent Then
.SetRenderState D3DRENDERSTATE_COLORKEYENABLE, 1
Else
.SetRenderState D3DRENDERSTATE_COLORKEYENABLE, 0
End If
' Draw group triangles...
.Begin D3DPT_TRIANGLELIST, D3DFVF_VERTEX, 0
For L_nRunV = 0 To G_dScene.Faces(L_nRunF).D3DDataCount - 1
.Vertex G_dScene.Faces(L_nRunF).D3DData(L_nRunV)
Next
.End 0
End If
Next
' End scene
.EndScene
End With
' Draw HUD display
With L_dRenderArea
.Top = 0
.Left = G_dUser.LookH
.Bottom = 20
.Right = .Left + 120
End With
G_oDDBackBuffer.BltFast 260, G_dRenderArea.Top + 5, G_oDDCompassSurface, L_dRenderArea, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
' Redraw primary ...
If G_dDXSelectedDriver.DriverType = EDXDTPlus Then
' Flip DirectDraw buffers by hardware pageflipping
G_oDDPrimary.Flip Nothing, DDFLIP_WAIT
Else
' Flip DirectDraw buffers by blitting backbuffer to primary ...
G_oDDPrimary.BltFast G_dRenderArea.Left, G_dRenderArea.Top, G_oDDBackBuffer, G_dRenderArea, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT
End If
' Various updating operations ...
' Update scrolling text ...
' Reset texture
Set G_dScene.Textures(1).D3DObject = Nothing
' Render new text clip onto texture surface
With L_dRenderArea
.Top = G_nFrameCount Mod 480
.Bottom = IIf(.Top > 352, 480, .Top + 128)
.Left = 0
.Right = 128
End With
G_dScene.Textures(1).DDSurface.BltFast 0, 0, G_oDDTextSurface, L_dRenderArea, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT
' Render upper text clip to lower area if at end
If G_nFrameCount Mod 480 > 352 Then
With L_dRenderArea
.Top = 0
.Bottom = (G_nFrameCount Mod 480) - 352
.Left = 0
.Right = 128
End With
G_dScene.Textures(1).DDSurface.BltFast 0, 128 - (G_nFrameCount Mod 480 - 352), G_oDDTextSurface, L_dRenderArea, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT
End If
' Set texture
Set G_dScene.Textures(1).D3DObject = G_dScene.Textures(1).DDSurface
G_dScene.Textures(1).D3DObject.GetHandle G_oD3DDevice, G_dScene.Textures(1).D3DHandle
' Update water ...
' Reset texture
Set G_dScene.Textures(4).D3DObject = Nothing
' Render new water clip onto texture surface
With L_dRenderArea
.Top = 32 + Sin((G_nFrameCount Mod 360) * PIFactor) * 30
.Bottom = .Top + 64
.Left = 32 + Cos((G_nFrameCount Mod 360) * PIFactor) * 10
.Right = .Left + 64
End With
AdvancedBlit 0, 0, G_dScene.Textures(4).DDSurface, G_oDDWaterSurface, L_dRenderArea
' Set texture
Set G_dScene.Textures(4).D3DObject = G_dScene.Textures(4).DDSurface
G_dScene.Textures(4).D3DObject.GetHandle G_oD3DDevice, G_dScene.Textures(4).D3DHandle
' Update flame ...
' Reset texture
Set G_dScene.Textures(8).D3DObject = Nothing
' Render new flame clip onto texture surface
With L_dRenderArea
.Top = ((G_nFrameCount Mod 16) \ 4) * 32
.Bottom = .Top + 32
.Left = (G_nFrameCount Mod 4) * 32
.Right = .Left + 32
End With
G_dScene.Textures(8).DDSurface.BltFast 0, 0, G_oDDFlameSurface, L_dRenderArea, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT
' Set texture
Set G_dScene.Textures(8).D3DObject = G_dScene.Textures(8).DDSurface
G_dScene.Textures(8).D3DObject.GetHandle G_oD3DDevice, G_dScene.Textures(8).D3DHandle
' Update flame light ...
If G_nFrameCount Mod 2 = 0 Then
G_dScene.Lights(9).D3DData.dcvColor.r = Rnd * 0.5 + 0.2
G_dScene.Lights(9).D3DObject.SetLight G_dScene.Lights(9).D3DData
End If
' React to user input ...
DoEvents
AppInput
' Expire frame time
Do While L_nNextFrametime > timeGetTime
Loop
Loop Until Not G_bAppRunning
' Error handling...
Exit Sub
E_AppLoop:
Resume Next
AppError Err.Number, Err.Description, "AppLoop"
End Sub
' APPINPUT: Processes user input
Public Sub AppInput()
' Enable error handling ...
On Error GoTo E_AppInput
' Setup local variables
Dim L_nNewX As Single ' New user X coordinates
Dim L_nNewZ As Single ' New user Z coordinates
Dim L_nOldAlt As Single ' Old altitude
Dim L_nNewAlt As Single ' New Altitude
Dim L_nAltitudeChange As Single ' Amount of change in altitude
' Process user keyboad input
With G_dUser.InputState
Select Case .KeyCode
' End application
Case vbKeyEscape
AppTerminate
G_bAppRunning = False
G_dUser.InputState.KeyCode = 0
' Move forward
Case vbKeyUp
L_nNewX = G_dUser.Position.X + G_dUser.Speed * Cos(G_dUser.LookH * PIFactor)
L_nNewZ = G_dUser.Position.z + G_dUser.Speed * Sin(G_dUser.LookH * PIFactor)
' Move backwards
Case vbKeyDown
L_nNewX = G_dUser.Position.X - G_dUser.Speed * Cos(G_dUser.LookH * PIFactor)
L_nNewZ = G_dUser.Position.z - G_dUser.Speed * Sin(G_dUser.LookH * PIFactor)
' Step left
Case vbKeyLeft
L_nNewX = G_dUser.Position.X + G_dUser.Speed * Cos(IIf(G_dUser.LookH - 90 < 0, G_dUser.LookH + 270, G_dUser.LookH - 90) * PIFactor)
L_nNewZ = G_dUser.Position.z + G_dUser.Speed * Sin(IIf(G_dUser.LookH - 90 < 0, G_dUser.LookH + 270, G_dUser.LookH - 90) * PIFactor)
' Step right
Case vbKeyRight
L_nNewX = G_dUser.Position.X + G_dUser.Speed * Cos(IIf(G_dUser.LookH + 90 > 359, G_dUser.LookH - 270, G_dUser.LookH + 90) * PIFactor)
L_nNewZ = G_dUser.Position.z + G_dUser.Speed * Sin(IIf(G_dUser.LookH + 90 > 359, G_dUser.LookH - 270, G_dUser.LookH + 90) * PIFactor)
' Increase viewport size
Case vbKeyAdd
If G_dUser.DisplaySize > 10 Then
G_dUser.DisplaySize = G_dUser.DisplaySize - 10
ViewportInitialize G_nDisplayWidth - G_dUser.DisplaySize, G_nDisplayHeight - Int(G_dUser.DisplaySize * 0.75)
End If
' Decrease viewport size
Case vbKeySubtract
If G_dUser.DisplaySize < 380 Then
G_dUser.DisplaySize = G_dUser.DisplaySize + 10
ViewportInitialize G_nDisplayWidth - G_dUser.DisplaySize, G_nDisplayHeight - Int(G_dUser.DisplaySize * 0.75)
End If
End Select
End With
' Process user mouse input
With G_dUser.InputState
' Turn head to right
If .MouseX > 320 Then
G_dUser.LookH = G_dUser.LookH + 2
If G_dUser.LookH > 359 Then G_dUser.LookH = G_dUser.LookH - 360
End If
' Turn head to left
If .MouseX < 320 Then
G_dUser.LookH = G_dUser.LookH - 2
If G_dUser.LookH < 0 Then G_dUser.LookH = G_dUser.LookH + 360
End If
' Look up
If .MouseY > 240 Then
G_dUser.LookV = G_dUser.LookV + 2
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -