330 lines
13 KiB
VB.net
330 lines
13 KiB
VB.net
Public Class SkyDome
|
|
|
|
Private SkydomeModel As Model
|
|
Public TextureUp As Texture2D
|
|
Public TextureDown As Texture2D
|
|
Dim TextureSun As Texture2D
|
|
Dim TextureMoon As Texture2D
|
|
|
|
Public Yaw As Single = 0
|
|
|
|
Const FASTTIMECYCLE As Boolean = False
|
|
|
|
Public Sub New()
|
|
SkydomeModel = Core.Content.Load(Of Model)("SkyDomeResource\SkyDome")
|
|
|
|
TextureUp = TextureManager.GetTexture("SkyDomeResource\Sky_Day")
|
|
TextureDown = TextureManager.GetTexture("SkyDomeResource\Stars")
|
|
TextureSun = TextureManager.GetTexture("SkyDomeResource\sun")
|
|
TextureMoon = TextureManager.GetTexture("SkyDomeResource\moon")
|
|
|
|
SetLastColor()
|
|
End Sub
|
|
|
|
Public Sub Update()
|
|
Yaw += 0.0002F
|
|
While Yaw > MathHelper.TwoPi
|
|
Yaw -= MathHelper.TwoPi
|
|
End While
|
|
SetLastColor()
|
|
|
|
If FASTTIMECYCLE = True Then
|
|
Second += 60
|
|
If Second = 60 Then
|
|
Second = 0
|
|
Minute += 1
|
|
If Minute = 60 Then
|
|
Minute = 0
|
|
Hour += 1
|
|
If Hour = 24 Then
|
|
Hour = 0
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Dim Hour As Integer = 0
|
|
Dim Minute As Integer = 0
|
|
Dim Second As Integer = 0
|
|
|
|
Private Function GetUniversePitch() As Single
|
|
If FASTTIMECYCLE = True Then
|
|
Dim progress As Integer = Hour * 3600 + Minute * 60 + Second
|
|
Return CSng((MathHelper.TwoPi / 100) * (progress / 86400 * 100))
|
|
Else
|
|
Dim progress As Integer = World.SecondsOfDay
|
|
Return CSng((MathHelper.TwoPi / 100) * (progress / 86400 * 100))
|
|
End If
|
|
End Function
|
|
|
|
Public Sub Draw(ByVal FOV As Single)
|
|
If Core.GameOptions.GraphicStyle = 1 Then
|
|
If Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Outside Then
|
|
If World.GetWeatherFromWeatherType(Screen.Level.WeatherType) <> World.Weathers.Fog Then ' Don't render the sky if the weather is set to Fog.
|
|
RenderHalf(FOV, Yaw, 0.0F, True, GetSkyTexture(), 16, 1.0F) ' Draw the sky
|
|
RenderHalf(FOV, MathHelper.TwoPi, 0.0F, True, TextureDown, 14, GetStarsAlpha()) ' Draw the stars.
|
|
RenderHalf(FOV, MathHelper.TwoPi, 0.0F, True, TextureSun, 12, GetSunAlpha()) ' Draw the Sun.
|
|
RenderHalf(FOV, MathHelper.TwoPi, 0.0F, True, TextureMoon, 12, GetMoonAlpha()) ' Draw the Moon.
|
|
RenderHalf(FOV, MathHelper.TwoPi - Yaw, 0.0F, True, GetCloudsTexture(), 8, GetCloudAlpha) ' Draw the clouds.
|
|
End If
|
|
Else
|
|
If Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Cave Or Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Forest Then
|
|
RenderHalf(FOV, MathHelper.TwoPi, 0.0F, True, TextureUp, 16, 1.0F) ' Draw the sky
|
|
Else
|
|
RenderHalf(FOV, Yaw, 0.0F, True, TextureUp, 16, 1.0F) ' Draw the sky
|
|
RenderHalf(FOV, MathHelper.TwoPi, 0.0F, True, TextureSun, 12, GetSunAlpha()) ' Draw the Sun.
|
|
RenderHalf(FOV, MathHelper.TwoPi - Yaw, 0.0F, True, TextureManager.GetTexture("SkyDomeResource\Clouds_Day"), 8, GetCloudAlpha()) ' Draw the clouds.
|
|
End If
|
|
If Not TextureDown Is Nothing Then
|
|
RenderHalf(FOV, Yaw, 0.0F, False, TextureDown, 16, 1.0F)
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub RenderHalf(ByVal FOV As Single, ByVal useYaw As Single, ByVal usePitch As Single, ByVal up As Boolean, ByVal texture As Texture2D, ByVal scale As Single, ByVal alpha As Single)
|
|
Dim Roll As Single = 0.0F
|
|
If up = False Then
|
|
Roll = Math.PI
|
|
End If
|
|
|
|
Dim previousBlendState = Core.GraphicsDevice.BlendState
|
|
Core.GraphicsDevice.BlendState = BlendState.NonPremultiplied
|
|
|
|
For Each ModelMesh As ModelMesh In SkydomeModel.Meshes
|
|
For Each BasicEffect As BasicEffect In ModelMesh.Effects
|
|
BasicEffect.World = Matrix.CreateScale(scale) * Matrix.CreateTranslation(New Vector3(Screen.Camera.Position.X, -2, Screen.Camera.Position.Z)) * Matrix.CreateFromYawPitchRoll(useYaw, usePitch, Roll)
|
|
|
|
BasicEffect.View = Screen.Camera.View
|
|
BasicEffect.Projection = Matrix.CreatePerspectiveFieldOfView(MathHelper.ToRadians(FOV), Core.GraphicsDevice.Viewport.AspectRatio, 0.01, 10000)
|
|
|
|
BasicEffect.TextureEnabled = True
|
|
BasicEffect.Texture = texture
|
|
BasicEffect.Alpha = alpha
|
|
|
|
Select Case Screen.Level.World.CurrentMapWeather
|
|
Case World.Weathers.Clear, World.Weathers.Sunny
|
|
BasicEffect.DiffuseColor = New Vector3(1)
|
|
Case World.Weathers.Rain
|
|
BasicEffect.DiffuseColor = New Vector3(0.4, 0.4, 0.7)
|
|
Case World.Weathers.Snow
|
|
BasicEffect.DiffuseColor = New Vector3(0.8)
|
|
Case World.Weathers.Underwater
|
|
BasicEffect.DiffuseColor = New Vector3(0.1, 0.3, 0.9)
|
|
Case World.Weathers.Fog
|
|
BasicEffect.DiffuseColor = New Vector3(0.7, 0.7, 0.8)
|
|
Case World.Weathers.Sandstorm
|
|
BasicEffect.DiffuseColor = New Vector3(0.8, 0.5, 0.2)
|
|
Case World.Weathers.Ash
|
|
BasicEffect.DiffuseColor = New Vector3(0.5, 0.5, 0.5)
|
|
Case World.Weathers.Blizzard
|
|
BasicEffect.DiffuseColor = New Vector3(0.6, 0.6, 0.6)
|
|
End Select
|
|
|
|
If BasicEffect.DiffuseColor <> New Vector3(1) Then
|
|
BasicEffect.DiffuseColor = GetWeatherColorMultiplier(BasicEffect.DiffuseColor)
|
|
End If
|
|
Next
|
|
|
|
ModelMesh.Draw()
|
|
Next
|
|
|
|
Core.GraphicsDevice.BlendState = previousBlendState
|
|
|
|
End Sub
|
|
|
|
Shared DaycycleTextureData() As Color = Nothing
|
|
Shared DaycycleTexture As Texture2D = Nothing
|
|
Shared LastSkyColor As Color = New Color(0, 0, 0, 0)
|
|
Shared LastEntityColor As Color = New Color(0, 0, 0, 0)
|
|
|
|
Public Shared Function GetDaytimeColor(ByVal shader As Boolean) As Color
|
|
If shader = True Then
|
|
Return LastEntityColor
|
|
Else
|
|
If World.IsAurora = True Then
|
|
Return New Color(64, 101, 164)
|
|
End If
|
|
Select Case Screen.Level.DayTime
|
|
Case 1
|
|
Return New Color(48, 200, 248)
|
|
Case 2
|
|
Return New Color(40, 88, 136)
|
|
Case 3
|
|
Return New Color(168, 224, 248)
|
|
Case 4
|
|
Return New Color(192, 152, 184)
|
|
End Select
|
|
End If
|
|
End Function
|
|
|
|
Private Sub SetLastColor()
|
|
If DaycycleTextureData Is Nothing Then
|
|
Dim DaycycleTexture As Texture2D = TextureManager.GetTexture("SkyDomeResource\daycycle")
|
|
DaycycleTextureData = New Color(DaycycleTexture.Width * DaycycleTexture.Height - 1) {}
|
|
DaycycleTexture.GetData(DaycycleTextureData)
|
|
SkyDome.DaycycleTexture = DaycycleTexture
|
|
End If
|
|
|
|
Dim pixel As Integer = GetTimeValue()
|
|
|
|
Dim pixelColor As Color = DaycycleTextureData(pixel)
|
|
If pixelColor <> LastSkyColor Then
|
|
LastSkyColor = pixelColor
|
|
LastEntityColor = DaycycleTextureData((pixel + DaycycleTexture.Width).Clamp(0, DaycycleTexture.Width * DaycycleTexture.Height - 1))
|
|
End If
|
|
End Sub
|
|
|
|
Private Function GetCloudAlpha() As Single
|
|
If Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Outside And World.IsAurora = False Then
|
|
Return 1.0F
|
|
Else
|
|
Return 0.0F
|
|
End If
|
|
End Function
|
|
|
|
Private Function GetMoonAlpha() As Single
|
|
If Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Outside And World.IsAurora = False Then
|
|
Select Case Screen.Level.DayTime
|
|
Case 1
|
|
Return 0.0F
|
|
Case 2
|
|
Return 1.0F
|
|
Case 3
|
|
Return 0.0F
|
|
Case 4
|
|
Return 1.0F
|
|
Case Else
|
|
Return 0.0F
|
|
End Select
|
|
Else
|
|
Return 0.0F
|
|
End If
|
|
End Function
|
|
|
|
Private Function GetStarsAlpha() As Single
|
|
If Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Outside And World.IsAurora = False Then
|
|
Select Case Screen.Level.DayTime
|
|
Case 1
|
|
Return 0.0F
|
|
Case 2
|
|
Return 1.0F
|
|
Case 3
|
|
Return 0.0F
|
|
Case 4
|
|
Return 0.0F
|
|
Case Else
|
|
Return 0.0F
|
|
End Select
|
|
Else
|
|
Return 0.0F
|
|
End If
|
|
End Function
|
|
|
|
Private Function GetSunAlpha() As Single
|
|
If Screen.Level.World.EnvironmentType = World.EnvironmentTypes.Outside And World.IsAurora = False Then
|
|
Select Case Screen.Level.DayTime
|
|
Case 1
|
|
Return 1.0F
|
|
Case 2
|
|
Return 0.0F
|
|
Case 3
|
|
Return 1.0F
|
|
Case 4
|
|
Return 0.0F
|
|
Case Else
|
|
Return 0.0F
|
|
End Select
|
|
Else
|
|
Return 0.0F
|
|
End If
|
|
End Function
|
|
|
|
Private Function GetCloudsTexture() As Texture2D
|
|
Dim time As World.DayTime = World.GetTime
|
|
|
|
Select Case Screen.Level.World.CurrentMapWeather
|
|
Case World.Weathers.Rain, World.Weathers.Blizzard, World.Weathers.Thunderstorm, World.Weathers.Snow
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Weather")
|
|
Case World.Weathers.Clear
|
|
Select Case Screen.Level.DayTime
|
|
Case 1
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Day")
|
|
Case 2
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Night")
|
|
Case 3
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Morning")
|
|
Case 4
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Evening")
|
|
End Select
|
|
If time = World.DayTime.Morning Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Morning")
|
|
ElseIf time = World.DayTime.Day Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Day")
|
|
ElseIf time = World.DayTime.Evening Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Evening")
|
|
Else
|
|
Return TextureManager.GetTexture("SkyDomeResource\Clouds_Night")
|
|
End If
|
|
End Select
|
|
Return Nothing
|
|
End Function
|
|
Private Function GetSkyTexture() As Texture2D
|
|
If World.IsAurora Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\AuroraBorealis")
|
|
End If
|
|
Select Case Screen.Level.DayTime
|
|
Case 1
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Day")
|
|
Case 2
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Night")
|
|
Case 3
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Morning")
|
|
Case 4
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Evening")
|
|
End Select
|
|
Dim time As World.DayTime = World.GetTime
|
|
Select Case Screen.Level.World.CurrentMapWeather
|
|
Case World.Weathers.Clear
|
|
If time = World.DayTime.Morning Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Morning")
|
|
ElseIf time = World.DayTime.Day Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Day")
|
|
ElseIf time = World.DayTime.Evening Then
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Evening")
|
|
Else
|
|
Return TextureManager.GetTexture("SkyDomeResource\Sky_Night")
|
|
End If
|
|
End Select
|
|
Return TextureUp
|
|
End Function
|
|
|
|
Public Function GetWeatherColorMultiplier(ByVal v As Vector3) As Vector3
|
|
Dim progress As Integer = GetTimeValue()
|
|
|
|
Dim p As Single = 0.0F
|
|
|
|
If progress < 720 Then
|
|
p = CSng((720 - progress) / 720)
|
|
Else
|
|
p = CSng((progress - 720) / 720)
|
|
End If
|
|
|
|
Return New Vector3(v.X + ((1 - v.X) * p),
|
|
v.Y + ((1 - v.Y) * p),
|
|
v.Z + ((1 - v.Z) * p))
|
|
End Function
|
|
|
|
Private Function GetTimeValue() As Integer
|
|
If FASTTIMECYCLE = True Then
|
|
Return Hour * 60 + Minute
|
|
Else
|
|
If World.IsMainMenu Then
|
|
Return 720
|
|
End If
|
|
Return World.MinutesOfDay
|
|
End If
|
|
End Function
|
|
|
|
End Class |