Zak's HLSL Sky Demo in VB.NET (Download)

[EagleEye]

I, too, am having a problem with the sun and moon textures showing up.

The sky looks AMAZING, but the sun and moon are not showing up at all.  I took Taneas' code fixes and applied them, but still no go.

I took some screen shots of what it looks like: http://www.vermund.com/news.php?readmore=7

If I rotate my camera around, I can see the polygons of the dome's mesh, and behind it, I can catch glimpses of the sun and moon... but they are quickly overlayed with the sky's color.

Any help would be appreciated...

ETA: I think what I'm really seeing is the GLOW from the sun and moon that's only showing up when I rotate the camera...

The sun and moon textures aren't showing up at all.

[EagleEye]

I figured it out...

In my main loop, I had "TVScene.RenderAllMeshes(True)" being called after everything else... I had it in there because I saw that was how the demo did it... removing that fixed all problems.

[JohnB]

Hi all,

I'm the one who was supposed to send Zaknafein the VB.NET code for his sky demo a while back.

Sorry for the delay - I've just been tied up for the last few months fixing up my old house to sell (cause making two house payments really sucks).  Then, just when I got that under control, we had a death in the family and to be honest, I just didn't feel like coding much for a while.

Now I'm trying to get back into my project but it's amazing how fast you forget stuff.  The current build isn't running because I was trying to integrate some of the OO concepts from this article:

http://www.devmaster.net/articles/oo-game-design/

Despite the problems it's caused me, I still feel like there are some very interesting ideas in that article and that the effort to get them working  will be worth it in the end.

Anyway, I was trying to get caught up on the TV forums today when I saw this thread and remembered that I never sent Zaknafein  that code.  Even though the current version is in pieces,  I have an older build that works just fine and isn't overly dependant on the rest of my framework to run.  It uses more or less a straight VB.Net port of the sky and math code from Zaknafeins demo.  The only thing I did at all different was to combine the math lib and sky code into one class.  In case it's useful to anyone, I'll include this code below.  You might have to make some adjustments such as renaming the variables for the TVEngine, MaterialFactory, etc. but that should be easy enough.  It will also need  the media, shaders, etc. from Zaknafein's sky demo in the same relative locations. All you need to do to use it is create an instance of the class, initialize it then alternate updates and renders.  It does expect to use some specific time values every update - you can either use mine or modify it to use your own.

Oh well, gotta run for now.  I'lll try to contribute some more code after I get my framework put back together.  I hope someone finds this useful in the mean time.

Ciao,

John B.

Code:

    ' Time Update Declarations
    Public Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef X As Long) As Short
    Public Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef X As Long) As Short

    ' Sky Global Path Variables
    Public PATH_BASE As String = System.AppDomain.CurrentDomain.BaseDirectory()
    Public PATH_MEDIA As String = PATH_BASE & "Media\"
    Public PATH_HEIGHTMAP As String = PATH_MEDIA & "Heightmaps\"
    Public PATH_TEXTURES As String = PATH_MEDIA & "Textures\"
    Public PATH_DETAILTEXTURES As String = PATH_TEXTURES & "Detail Textures\"
    Public PATH_STARS As String = PATH_TEXTURES & "Stars\"
    Public PATH_SKYSCAPES As String = PATH_TEXTURES & "Skyscapes\"
    Public PATH_LANDSCAPES As String = PATH_TEXTURES & "Landscapes\"
    Public PATH_LENSES As String = PATH_TEXTURES & "Lenses\"
    Public PATH_LOOKUP As String = PATH_TEXTURES & "Lookup\"
    Public PATH_MODELS As String = PATH_MEDIA & "Models\"
    Public PATH_SHADERS As String = PATH_MEDIA & "Shaders\"

    ' Time Global Variables
    Public StartTime As Long
    Public EndTime As Long
    Public ElapsedTime As Single
    Public GameTime As DateTime
    Public Frequency As Single = 0.0F
    Public TimeFactor As Single = 750.0

    '===============================================================================
    ' Update the Time
    '===============================================================================
    Sub UpdateTime()

        StartTime = EndTime

        QueryPerformanceCounter(EndTime)

        ElapsedTime = (CType((EndTime - StartTime), Single) / GetFrequency * 1000.0)
        GameTime = GameTime.AddMilliseconds(ElapsedTime * TimeFactor)

    End Sub

    '===============================================================================
    ' Get the System Frequency
    '===============================================================================
    Public Function GetFrequency() As Single

        If (Frequency = 0) Then

            Dim tmpLong As Long = 0

            QueryPerformanceFrequency(tmpLong)

            Frequency = tmpLong

        End If

        Return Frequency

    End Function

    '===============================================================================
    ' Create the Sky
    '===============================================================================
    Public Sub CreateSky()

        GameTime = "2/14/1968"
        QueryPerformanceCounter(EndTime)

        Sky = New clsZaknafeinSky

        Sky.initialize()

    End Sub

'###############################################################################
' Class - Zaknafein Sky
'###############################################################################
Option Strict Off
Option Explicit On

Imports MTV3D65

'###############################################################################
Public Class clsZaknafeinSky

    Public AccumulatedTime As Single
    Public UpdateDelay As Single = 45

    Public SkyShader As TVShader
    Public CloudsShader As TVShader
    Public SkyHemisphere As TVMesh
    Public CloudsDome As TVMesh
    Public Sun As TVMesh
    Public Moon As TVMesh
    Public SunLight As clsLight
    Public JulianDay As Single
    Public SunPosition As TV_3DVECTOR
    Public MoonPosition As TV_3DVECTOR
    Public Sun2DPos As TV_2DVECTOR
    Public Moon2DPos As TV_2DVECTOR
    Public SunFlareColl As Boolean
    Public MoonFlareColl As Boolean
    Public SunFlareFrustrum As Boolean
    Public MoonFlareFrustrum As Boolean
    Public SunHalfFlareSize As Single
    Public MoonIntensity As Single
    Public Turbidity As Single = 2.25F
    Public WindPower As TV_2DVECTOR = New TV_2DVECTOR(0.00001F, 0.00001F)
    Public CloudsSize As TV_2DVECTOR = New TV_2DVECTOR(0.6F, 1.25F)
    Public LayersOpacity As TV_2DVECTOR = New TV_2DVECTOR(1.0F, 0.85F)
    Public CloudsTranslationOuter As TV_2DVECTOR = New TV_2DVECTOR(0.0F, 0.0F)
    Public CloudsTranslationInner As TV_2DVECTOR = New TV_2DVECTOR(0.0F, 0.0F)

    Public LATITUDE As Single = 0.6981317F
    Public SKY_RADIUS As Single = 180.0F
    Public FOG_NIGHT_COLOR As TV_3DVECTOR = New TV_3DVECTOR(0.08F, 0.08F, 0.12F)
    Public CLOUDS_NIGHT_COLOR As TV_3DVECTOR = New TV_3DVECTOR(0.175F, 0.175F, 0.2F)
    Public CLOUDS_DAY_COLOR As TV_3DVECTOR = New TV_3DVECTOR(0.9F, 0.9F, 0.9F)
    Public SUN_RISE As Single = CType((Math.PI * 1 / 12), Single)
    Public SUN_SET As Single = CType((Math.PI * 1 / -10), Single)

    Const HALF_PI As Single = CType((Math.PI / 2), Single)
    Const TWO_PI As Single = CType((Math.PI * 2), Single)

    Shared XZenithCoeff(,) As Single = {{0.00165F, -0.00375F, 0.00209F, 0.0F}, {-0.02903F, 0.06377F, -0.03202F, 0.00394F}, {0.11693F, -0.21196F, 0.06052F, 0.25886F}}
    Shared YZenithCoeff As Single(,) = {{0.00275F, -0.0061F, 0.00317F, 0.0F}, {-0.04214F, 0.0897F, -0.04153F, 0.00516F}, {0.15346F, -0.26756F, 0.0667F, 0.26688F}}
    Shared XDistribCoeff As Single(,) = {{-0.0193F, -0.2592F}, {-0.0665F, 0.0008F}, {-0.0004F, 0.2125F}, {-0.0641F, -0.8989F}, {-0.0033F, 0.0452F}}
    Shared Y1DistribCoeff As Single(,) = {{-0.0167F, -0.2608F}, {-0.095F, 0.0092F}, {-0.0079F, 0.2102F}, {-0.0441F, -1.6537F}, {-0.0109F, 0.0529F}}
    Shared Y2DistribCoeff As Single(,) = {{0.1787F, -1.463F}, {-0.3554F, 0.4275F}, {-0.0227F, 5.3251F}, {0.1206F, -2.5771F}, {-0.067F, 0.3703F}}
    Shared XYZtoRGBconv As Single(,) = {{3.24079F, -1.53715F, -0.49853F}, {-0.969256F, 1.875991F, 0.041556F}, {0.055648F, -0.204043F, 1.057311F}}

    '===============================================================================
    ' Intitialize the Sky
    '===============================================================================
    Public Sub Initialize()

        SkyShader = Scene.CreateShader("SkyShader")
        CloudsShader = Scene.CreateShader("CloudsShader")
        SkyHemisphere = Scene.CreateMeshBuilder("SkyHemisphere")
        CloudsDome = Scene.CreateMeshBuilder("CloudsDome")

        MaterialFactory.CreateMaterialQuick(0.0F, 0.0F, 0.0F, 0.0F, "Moon")

        LoadTextures()

        SkyShader.CreateFromEffectFile(PATH_SHADERS + "\SkyShader.fx")
        CloudsShader.CreateFromEffectFile(PATH_SHADERS + "\CloudsShader.fx")

        CloudsShader.SetEffectParamTexture("texCubeNormalizer", TVUtils.GetTex("CubeNormalizationMap"))

        InitDomes()
        InitStars()

        Atmosphere.Fog_Enable(True)
        Atmosphere.Fog_SetType(CONST_TV_FOG.TV_FOG_EXP2, CONST_TV_FOGTYPE.TV_FOGTYPE_PIXEL)

        SunLight = LightFactory.CreateLight("SunLight", "NONE", MTV3D65.CONST_TV_LIGHTTYPE.TV_LIGHT_DIRECTIONAL, True)
        SunLight.SetColor(1.0, 1.0, 1.0)
        SunLight.SetIntensity(1.0)

        Screen2dImmediate.Settings_SetTextureFilter(CONST_TV_TEXTUREFILTER.TV_FILTER_BILINEAR)
        Screen2dImmediate.Settings_SetAlphaTest(False, 0)
        Screen2dImmediate.Settings_SetAlphaBlending(True, CONST_TV_BLENDINGMODE.TV_BLEND_ADD)

        Dim a As Integer = (14 - GameTime.Month) / 12
        Dim y As Integer = 1975 + 4800 - a
        Dim m As Integer = GameTime.Month + 12 * a - 3

        JulianDay = GameTime.DayOfYear + (153 * m + 2) / 5 + y * 365 + y / 4 - y / 100 + y / 400 - 32045
        JulianDay -= 2442414
        JulianDay -= 1.0 / 24.0

    End Sub

    '===============================================================================
    ' Update the Sky
    '===============================================================================
    Public Sub Update()

        Dim camPos As TV_3DVECTOR

        AccumulatedTime = AccumulatedTime + ElapsedTime

        camPos = Camera_Test.TVCamera.GetPosition

        SkyHemisphere.SetPosition(camPos.x, 0.0F, camPos.z)

        CloudsDome.SetPosition(camPos.x, 0.0F, camPos.z)

        SunFlareFrustrum = MathLibrary.Project3DPointTo2D(SunPosition, Sun2DPos.x, Sun2DPos.y, True)

        MoonFlareFrustrum = MathLibrary.Project3DPointTo2D(MoonPosition, Moon2DPos.x, Moon2DPos.y, True)

        If (AccumulatedTime < UpdateDelay) Then
            Exit Sub
        End If

        Dim camPosXZ As TV_3DVECTOR

        AccumulatedTime = 0

        camPos = Camera_Test.TVCamera.GetPosition
        camPosXZ = camPos
        camPosXZ.y = 0.0

        Dim sunAngles As AltAzAngles = CalculateSunPosition(JulianDay + CType(GameTime.TimeOfDay.TotalDays, Single), LATITUDE)

        SunPosition = MathLibrary.MoveAroundPoint(camPosXZ, 12500.0, sunAngles.azimuth, -sunAngles.altitude)
        Sun.SetPosition(SunPosition.x, SunPosition.y, SunPosition.z)

        MoonPosition = SunPosition
        MoonPosition.y -= 9000.0

        MathLibrary.TVVec3Normalize(MoonPosition, MoonPosition)
        MathLibrary.TVVec3Scale(MoonPosition, MoonPosition, -9000.0)

        Moon.SetPosition(MoonPosition.x, MoonPosition.y, MoonPosition.z)

        SunFlareColl = SunFlareFrustrum AndAlso Not Scene.Collision(camPos, SunPosition, CType(CONST_TV_OBJECT_TYPE.TV_OBJECT_LANDSCAPE, Integer))
        MoonFlareColl = MoonFlareFrustrum AndAlso Not Scene.Collision(camPos, MoonPosition, CType(CONST_TV_OBJECT_TYPE.TV_OBJECT_LANDSCAPE, Integer))

        Dim sunNormedPos As TV_3DVECTOR = New TV_3DVECTOR

        MathLibrary.TVVec3Subtract(sunNormedPos, SunPosition, camPosXZ)
        MathLibrary.TVVec3Normalize(sunNormedPos, sunNormedPos)

        Dim sunTheta As Single = VectorToTheta(sunNormedPos)

        SkyShader.SetEffectParamFloat("_sunTheta", sunTheta)
        SkyShader.SetEffectParamVector3("_sunVector", sunNormedPos)

        Dim tempMatrix As TV_3DMATRIX = Camera_Test.TVCamera.GetRotationMatrix
        Dim normedLookAt As TV_3DVECTOR = New TV_3DVECTOR(tempMatrix.m31, tempMatrix.m32, tempMatrix.m33)
        Dim dotProduct As Single = MathLibrary.TVVec3Dot(normedLookAt, sunNormedPos)

        ' TODO : Use a variable for the width here
        SunHalfFlareSize = TrueVision.GetViewport.GetWidth / 5.0 * (dotProduct * dotProduct * dotProduct)

        Dim sunDirection As TV_3DVECTOR = New TV_3DVECTOR

        MathLibrary.TVVec3Subtract(sunDirection, SunPosition, camPosXZ)
        MathLibrary.TVVec3Normalize(SunLight.Direction, sunDirection)

        If SunLight.Direction.y < 1.0 / 9.0 Then
            SunLight.Direction.y = 1.0 / 9.0
        End If

        MathLibrary.TVVec3Scale(SunLight.Direction, SunLight.Direction, -1.0)

        Dim sunIntensity As Single = Saturate(Lerp(sunAngles.altitude, SUN_SET, SUN_RISE))

        MoonIntensity = Saturate(Lerp(sunAngles.altitude, 0.0, SUN_SET)) * 0.95
        SkyShader.SetEffectParamFloat("_starsIntensity", MoonIntensity)
        MoonIntensity = MoonIntensity + 0.05
        MaterialFactory.SetEmissive(TVUtils.GetMat("Moon"), MoonIntensity, MoonIntensity, MoonIntensity, 0.0)

        Dim ambientColorRG As Single = -0.05 * (1.0 - sunIntensity) + 0.21

        MaterialFactory.SetAmbient(TVUtils.GetMat("Matte"), ambientColorRG, ambientColorRG, 0.2, 1.0)
        SkyShader.SetEffectParamFloat("_nightDarkness", 1.0 - (MoonIntensity - 0.05))

        Dim zenithColors As XYYColor = SkyZenithColor(Turbidity, sunTheta)
        Dim distribCoeffs As xyYCoeffs = DistributionCoefficients(Turbidity)

        SkyShader.SetEffectParamVector3("_zenithColor", zenithColors.AsVector3)

        Dim i As Integer = 0

        While (i < 5)
            SkyShader.SetEffectParamFloat("_xDistribCoeffs[" & i & "]", distribCoeffs.x(i))
            SkyShader.SetEffectParamFloat("_yDistribCoeffs[" & i & "]", distribCoeffs.y1(i))
            SkyShader.SetEffectParamFloat("_YDistribCoeffs[" & i & "]", distribCoeffs.Y2(i))
            Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
        End While

        Dim gamma As Single = 1.0 / (1.6 + (Turbidity - 2.0) * 0.1)

        SkyShader.SetEffectParamFloat("_invGammaCorrection", 1.5 * gamma)
        SkyShader.SetEffectParamFloat("_invPowLumFactor", gamma)
        SkyShader.SetEffectParamFloat("_invNegMaxLum", -1.25 / MaximumLuminance(Turbidity, sunTheta, zenithColors, distribCoeffs))

        Dim windEffectInner As TV_2DVECTOR = New TV_2DVECTOR(WindPower.x * AccumulatedTime, WindPower.y * AccumulatedTime)

        MathLibrary.TVVec2Add(CloudsTranslationInner, CloudsTranslationInner, windEffectInner)

        Dim windEffectOuter As TV_2DVECTOR = New TV_2DVECTOR(WindPower.x / 2.0 * AccumulatedTime, WindPower.y / 2.0 * AccumulatedTime)

        MathLibrary.TVVec2Add(CloudsTranslationOuter, CloudsTranslationOuter, windEffectOuter)

        CloudsShader.SetEffectParamVector2("_cloudsTranslation[0]", CloudsTranslationOuter)
        CloudsShader.SetEffectParamVector2("_cloudsTranslation[1]", CloudsTranslationInner)

        Dim atmoCol As TV_COLOR = AtmosphereColor(Turbidity, sunTheta, zenithColors, distribCoeffs)
        Dim atmoColVec As TV_3DVECTOR = New TV_3DVECTOR(atmoCol.r, atmoCol.g, atmoCol.b)
        Dim dayState As Single = Saturate(Lerp(sunAngles.altitude, CType((Math.PI * 1.0 / (6.0 - Turbidity / 2.0)), Single), SUN_RISE))

        MathLibrary.TVVec3Lerp(atmoColVec, CLOUDS_NIGHT_COLOR, atmoColVec, sunIntensity)
        MathLibrary.TVVec3Lerp(atmoColVec, CLOUDS_DAY_COLOR, atmoColVec, dayState)

        CloudsShader.SetEffectParamVector3("_cloudsColor", atmoColVec)

        SunLight.SetIntensity(sunIntensity)
        SunLight.SetColor(atmoColVec.x, atmoColVec.y, atmoColVec.z)
        SunLight.Update()

        Atmosphere.Fog_SetColor(atmoColVec.x / 2.0, atmoColVec.y / 2.0, atmoColVec.z / 2.0)
        Atmosphere.Fog_SetParameters(0.0, 0.0, CType((Turbidity / 8500), Single))

        CloudsShader.SetEffectParamVector2("_cloudsSize", CloudsSize)
        CloudsShader.SetEffectParamVector2("_layersOpacity", LayersOpacity)

    End Sub

    '===============================================================================
    ' Render the Sky
    '===============================================================================
    Public Sub Render()

        Atmosphere.Fog_Enable(False)

        SkyHemisphere.Render()
        Sun.Render()
        Moon.Render()
        CloudsDome.Render()

        Atmosphere.Fog_Enable(True)

        Screen2dImmediate.Action_Begin2D()

        If SunFlareFrustrum AndAlso SunFlareColl Then

            Dim color As Integer = TVUtils.RGBA(0.325, 0.31, 0.28, 1.0)

            Screen2dImmediate.Draw_Texture(TVUtils.GetTex("Glow"), Sun2DPos.x - SunHalfFlareSize, Sun2DPos.y - SunHalfFlareSize, Sun2DPos.x + SunHalfFlareSize, Sun2DPos.y + SunHalfFlareSize, color, color, color, color)
            color = TVUtils.RGBA(0.05, 0.05, 0.05, 1.0)
            Screen2dImmediate.Draw_Texture(TVUtils.GetTex("Rays"), Sun2DPos.x - SunHalfFlareSize * 2.0, Sun2DPos.y - SunHalfFlareSize * 2.0, Sun2DPos.x + SunHalfFlareSize * 2.0, Sun2DPos.y + SunHalfFlareSize * 2.0, color, color, color, color)
        End If

        If MoonFlareFrustrum AndAlso MoonFlareColl Then

            Dim color As Integer = TVUtils.RGBA(0.15 * MoonIntensity, 0.15 * MoonIntensity, 0.225 * MoonIntensity, 1.0)
            Dim halfSize As Single = TrueVision.GetViewport.GetWidth / 9.0

            Screen2dImmediate.Draw_Texture(TVUtils.GetTex("Glow"), Moon2DPos.x - halfSize, Moon2DPos.y - halfSize, Moon2DPos.x + halfSize, Moon2DPos.y + halfSize, color, color, color, color)
        End If

        Screen2dImmediate.Action_End2D()

    End Sub

    '===============================================================================
    ' Load the Textures
    '===============================================================================
    Sub LoadTextures()

        TextureFactory.TV.LoadTexture(PATH_SKYSCAPES + "\Starmap.dds", "StarMap")
        TextureFactory.TV.LoadTexture(PATH_SKYSCAPES + "\CloudsLots.dds", "CloudLots")
        TextureFactory.TV.LoadTexture(PATH_SKYSCAPES + "\CloudsLess.dds", "CloudLess")
        TextureFactory.TV.LoadTexture(PATH_STARS + "\Sun.dds", "Sun")
        TextureFactory.TV.LoadTexture(PATH_STARS + "\Moon.dds", "Moon")
        TextureFactory.TV.LoadCubeTexture(PATH_LOOKUP + "\CubeNormalizer_ULQ.dds", "CubeNormalizationMap", 256, CONST_TV_COLORKEY.TV_COLORKEY_NO, False)
        TextureFactory.TV.LoadTexture(PATH_LENSES + "\Glow.dds", "Glow")
        TextureFactory.TV.LoadTexture(PATH_LENSES + "\Rays.dds", "Rays")

    End Sub

    '===============================================================================
    ' Initialize the Domes
    '===============================================================================
    Sub InitDomes()

        SkyHemisphere.LoadTVM(PATH_MODELS + "Hemisphere.tvm", False)
        SkyHemisphere.SetMeshFormat(CType((CONST_TV_MESHFORMAT.TV_MESHFORMAT_TEX1 Or CONST_TV_MESHFORMAT.TV_MESHFORMAT_NOLIGHTING), Integer))
        SkyHemisphere.SetCollisionEnable(False)
        SkyHemisphere.SetScale(SKY_RADIUS, SKY_RADIUS, SKY_RADIUS)
        SkyHemisphere.SetTextureEx(0, TVUtils.GetTex("StarMap"))
        SkyHemisphere.SetShader(SkyShader)

        CloudsDome.LoadTVM(PATH_MODELS + "Dome.tvm", False)
        CloudsDome.SetTextureEx(0, TVUtils.GetTex("CloudLots"))
        CloudsDome.SetTextureEx(1, TVUtils.GetTex("CloudLess"))
        CloudsDome.SetMeshFormat(CType((CONST_TV_MESHFORMAT.TV_MESHFORMAT_TEX1 Or CONST_TV_MESHFORMAT.TV_MESHFORMAT_TEX2), Integer))
        CloudsDome.SetScale(SKY_RADIUS * 0.99, SKY_RADIUS * 0.99, SKY_RADIUS * 0.99)
        CloudsDome.SetShader(CloudsShader)

    End Sub

    '===============================================================================
    ' Initialize the Stars
    '===============================================================================
    Sub InitStars()

        Sun = Scene.CreateBillboard(TVUtils.GetTex("Sun"), 0.0, 0.0, 0.0, 1200.0, 1200.0, "Sun", True)
        Sun.SetBillboardType(CONST_TV_BILLBOARDTYPE.TV_BILLBOARD_FREEROTATION)
        Sun.SetBlendingMode(CONST_TV_BLENDINGMODE.TV_BLEND_ADD)
        Sun.SetLightingMode(CONST_TV_LIGHTINGMODE.TV_LIGHTING_NONE)
        Sun.SetAlphaTest(False, 0, False)
        Sun.SetCollisionEnable(False)

        Moon = Sun.Duplicate("Moon", True)
        Moon.SetLightingMode(CONST_TV_LIGHTINGMODE.TV_LIGHTING_MANAGED)
        Moon.SetScale(0.5, 0.5, 0.5)
        Moon.SetTexture(TVUtils.GetTex("Moon"))
        Moon.SetMaterial(TVUtils.GetMat("Moon"))

    End Sub

    '===============================================================================
    ' Get the Zenith Color
    '===============================================================================
    Friend Function SkyZenithColor(ByVal turbidity As Single, ByVal sunTheta As Single) As XYYColor

        Dim zenith As XYYColor
        Dim chi As Single = (4.0 / 9.0 - turbidity / 120.0) * (CType(Math.PI, Single) - 2.0 * sunTheta)

        zenith.Y2 = (4.0453 * turbidity - 4.971) * CType(Math.Tan(chi), Single) - 0.2155 * turbidity + 2.4192

        If zenith.Y2 < 0.0 Then

            zenith.Y2 = -zenith.Y2
        End If

        zenith.x = Chromaticity(XZenithCoeff, turbidity, sunTheta)
        zenith.Y1 = Chromaticity(YZenithCoeff, turbidity, sunTheta)

        Return zenith

    End Function

    '===============================================================================
    ' Get the Maximum Luminance
    '===============================================================================
    Friend Function MaximumLuminance(ByVal turbidity As Single, ByVal sunTheta As Single, ByVal zenith As XYYColor, ByVal coeffs As xyYCoeffs) As Single

        Dim theta As Single = sunTheta

        If sunTheta >= HALF_PI Then
            theta = HALF_PI - 0.01
        End If

        Return Distribution(coeffs.Y2, theta, zenith.Y2, 0.0) * 1.5

    End Function

    '===============================================================================
    ' Get the Atmosphere Color
    '===============================================================================
    Friend Function AtmosphereColor(ByVal turbidity As Single, ByVal sunTheta As Single, ByVal zenith As XYYColor, ByVal coeffs As xyYCoeffs) As TV_COLOR

        Dim theta As Single = Math.Min(sunTheta + 0.15, HALF_PI - 0.01)
        Dim skyColor As XYYColor

        skyColor.x = Distribution(coeffs.x, theta, zenith.x, 0.2)
        skyColor.Y1 = Distribution(coeffs.y1, theta, zenith.Y1, 0.2)
        skyColor.Y2 = 0.5

        Dim ret As TV_COLOR = xyYtoRGB(skyColor)

        Return ret

    End Function

    '===============================================================================
    ' Get the Distribution Coefficients
    '===============================================================================
    Friend Function DistributionCoefficients(ByVal turbidity As Single) As xyYCoeffs

        Dim ret As xyYCoeffs

        ret.x = New Single(5) {}
        ret.y1 = New Single(5) {}
        ret.Y2 = New Single(5) {}

        Dim i As Integer = 0

        While i < 5
            ret.x(i) = XDistribCoeff(i, 0) * turbidity + XDistribCoeff(i, 1)
            ret.y1(i) = Y1DistribCoeff(i, 0) * turbidity + Y1DistribCoeff(i, 1)
            ret.Y2(i) = Y1DistribCoeff(i, 0) * turbidity + Y1DistribCoeff(i, 1)
            Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
        End While

        Return ret

    End Function

    '===============================================================================
    ' Convert Vector to Theta
    '===============================================================================
    Public Function VectorToTheta(ByVal vec As TV_3DVECTOR) As Single

        Return HALF_PI - CType(Math.Atan2(vec.y, Math.Sqrt(vec.x * vec.x + vec.z * vec.z)), Single)

    End Function

    '===============================================================================
    ' Convert XXY to RGB
    '===============================================================================
    Friend Function xyYtoRGB(ByVal xyY As XYYColor) As TV_COLOR

        Dim Yony As Single = xyY.Y2 / xyY.Y1
        Dim XYZ As XYZColor = New XYZColor(xyY.x * Yony, xyY.Y2, (1.0F - xyY.x - xyY.Y1) * Yony)
        Dim XYZf3 As Single() = XYZ.AsFloat3
        Dim ret(3) As Single
        Dim i As Integer = 0

        While i < 3

            ret(i) = 0.0F

            Dim j As Integer = 0

            While j < 3

                'ret(i) += (XYZf3(j) * XYZtoRGBconv(i, j))
                ret(i) = ret(i) + (XYZf3(j) * XYZtoRGBconv(i, j))
                Math.Min(System.Threading.Interlocked.Increment(j), j - 1)

            End While

            Math.Min(System.Threading.Interlocked.Increment(i), i - 1)

        End While

        Return New TV_COLOR(ret(0), ret(1), ret(2), 1.0)

    End Function

    '===============================================================================
    ' Calculate the Sun's Position
    '===============================================================================
    Friend Function CalculateSunPosition(ByVal julianDate As Single, ByVal latitude As Single) As AltAzAngles

        Dim angles As AltAzAngles
        Dim gamma As Single = 4.930738
        Dim meanAnomaly As Single = 6.239842 + 0.01720197F * julianDate
        Dim eccAnomaly As Single = 2.0F * CType(Math.Atan(1.016862146 * Math.Tan(meanAnomaly / 2)), Single)

        eccAnomaly = meanAnomaly + 0.01672 * CType(Math.Sin(eccAnomaly), Single)

        Dim trueAnomaly As Single = 2.0 * CType(Math.Atan(1.016862146 * Math.Tan(eccAnomaly / 2)), Single)
        Dim lambda As Single = gamma + trueAnomaly
        Dim dec As Single = CType(Math.Asin(Math.Sin(lambda) * 0.39778375791855), Single)
        Dim ra As Single = CType(Math.Atan(Math.Tan(lambda) * 0.917479), Single)

        If Math.Cos(lambda) < 0 Then
            ra = ra + CType(Math.PI, Single)
        End If

        Dim gha As Single = 1.7457 + 6.300388 * julianDate
        Dim latSun As Single = dec
        Dim lonSun As Single = ra - gha
        Dim cosLonSun As Single = CType(Math.Cos(lonSun), Single)
        Dim sinLonSun As Single = CType(Math.Sin(lonSun), Single)
        Dim cosLatSun As Single = CType(Math.Cos(latSun), Single)
        Dim sinLatSun As Single = CType(Math.Sin(latSun), Single)
        Dim sinLat As Single = CType(Math.Sin(latitude), Single)
        Dim cosLat As Single = CType(Math.Cos(latitude), Single)

        angles.altitude = CType(Math.Asin(sinLat * sinLatSun + cosLat * cosLatSun * cosLonSun), Single)

        Dim west As Single = cosLatSun * sinLonSun
        Dim south As Single = -cosLat * sinLatSun + sinLat * cosLatSun * cosLonSun

        angles.azimuth = CType(Math.Atan(west / south), Single)

        If south >= 0.0 Then
            angles.azimuth = CType(Math.PI, Single) - angles.azimuth
        End If

        If south < 0.0 Then
            angles.azimuth = -angles.azimuth
        End If

        If angles.azimuth < 0.0 Then
            angles.azimuth = angles.azimuth + TWO_PI
        End If

        Return angles

    End Function

    '===============================================================================
    ' Saturate
    '===============================================================================
    Public Function Saturate(ByVal value As Single) As Single

        If value > 1.0 Then
            value = 1.0
        End If

        If value < 0.0 Then
            value = 0.0
        End If

        Return value

    End Function

    '===============================================================================
    ' Saturate
    '===============================================================================
    Public Function Saturate(ByVal value As TV_COLOR) As TV_COLOR

        value.r = Saturate(value.r)
        value.g = Saturate(value.g)
        value.b = Saturate(value.b)

        Return value

    End Function

    '===============================================================================
    ' Lerp
    '===============================================================================
    Public Function Lerp(ByVal value As Single, ByVal min As Single, ByVal max As Single) As Single

        Return (value - min) / (max - min)

    End Function

    '===============================================================================
    ' Perez Function
    '===============================================================================
    Shared Function PerezFunction(ByVal A As Single, ByVal B As Single, ByVal C As Single, ByVal D As Single, ByVal E As Single, ByVal theta As Single, ByVal gamma As Single) As Single

        Dim cosGamma As Single = CType(Math.Cos(gamma), Single)

        Return CType(((1.0 + A * Math.Exp(B / Math.Cos(theta))) * (1.0 + C * Math.Exp(D * gamma) + E * cosGamma * cosGamma)), Single)

    End Function

    '===============================================================================
    ' Distribution
    '===============================================================================
    Shared Function Distribution(ByVal coeffs As Single(), ByVal theta As Single, ByVal zenith As Single, ByVal gamma As Single) As Single

        Dim A As Single = coeffs(0)
        Dim B As Single = coeffs(1)
        Dim C As Single = coeffs(2)
        Dim D As Single = coeffs(3)
        Dim E As Single = coeffs(4)

        Return (zenith * PerezFunction(A, B, C, D, E, theta, gamma) / PerezFunction(A, B, C, D, E, 0.0, theta))

    End Function

    Shared Function Chromaticity(ByVal ZC As Single(,), ByVal turbidity As Single, ByVal sunTheta As Single) As Single

        Dim sunThetaSquared As Single = sunTheta * sunTheta
        Dim sunThetaCubed As Single = sunThetaSquared * sunTheta
        Dim turbiditySquared As Single = turbidity * turbidity
        Dim turbidityVector As Single() = {turbiditySquared, turbidity, 1.0}
        Dim sunThetaVector As Single() = {sunThetaCubed, sunThetaSquared, sunTheta, 1.0}

        Return MulChromaticityMatrices(turbidityVector, ZC, sunThetaVector)

    End Function

    '===============================================================================
    ' Mul Chromacity Matrices
    '===============================================================================
    Shared Function MulChromaticityMatrices(ByVal lv As Single(), ByVal mat As Single(,), ByVal cv As Single()) As Single

        Dim inter(4) As Single
        Dim i As Integer = 0

        While i < 4
            inter(i) = 0.0
            Dim j As Integer = 0

            While j < 3
                'inter(i) += lv(j) * mat(j, i)
                inter(i) = inter(i) + (lv(j) * mat(j, i))
                Math.Min(System.Threading.Interlocked.Increment(j), j - 1)
            End While

            Math.Min(System.Threading.Interlocked.Increment(i), i - 1)

        End While

        Dim ret As Single = 0.0
        i = 0

        While i < 4
            'ret += inter(i) * cv(i)
            ret = ret + (inter(i) * cv(i))
            Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
        End While

        Return ret

    End Function

End Class

[Raine]

Great job JohnB, now I can check what went wrong with my own conversion!
Thanks again for the code.

Edit: I tried to run it within my project, I properly modified it, I added the missing structures (well, I couldn't find them, perhaps I'm totally blind) but nothing renders to screen. TV's log is fine, my app's log is fine, I just don't know what's happening ç_ç

[JohnB]

Ok - I'll see if I can post a complete project in the next day or so.  Gotta find someplace to host the files first though.

John B.

[EagleEye]

I can host them for you... If you want, we could put up a wiki page for it, and link directly to the download.

[Raine]

A few things:
a) I had a bug in the engine init which kept the engine from rendering properly. Now it renders.
b) I still have ye olde "matrix effect" (garbage, text garbage instead of clouds - do a forum search for it, I've already encountered this error and I can't get rid of it)
c) sky's static, doesn't move, doesn't update. Frequency functions seem to work correctly, though, I have a timer on screen which shows it.

I think we could really use an example project, John B. Thanks in advance!

[JohnB]

I'm still working on the complete project.  Sorry it's taking so long but it's just been yet another busy week.  It's comming along though and I should be able to post it soon.  In the mean time, I thought I'd go ahead and post the missing structures for the code in my earlier reply.  I think that's all of them - sorry I forgot to include them  the first time around.

John B.

Code:

    Public Structure XYYColor

        Public x As Single
        Public Y1 As Single
        Public Y2 As Single

        Public ReadOnly Property AsVector3() As TV_3DVECTOR

            Get
                Return New TV_3DVECTOR(x, Y1, Y2)

            End Get

        End Property

    End Structure

    Public Structure XYZColor

        Public X As Single
        Public Y As Single
        Public Z As Single

        Public Sub New(ByVal X As Single, ByVal Y As Single, ByVal Z As Single)

            Me.X = X
            Me.Y = Y
            Me.Z = Z

        End Sub

        Public ReadOnly Property AsFloat3() As Single()

            Get
                Dim tmpSingle(3) As Single

                tmpSingle(0) = X
                tmpSingle(1) = Y
                tmpSingle(2) = Z

                Return tmpSingle

            End Get

        End Property

    End Structure

    Public Structure xyYCoeffs

        Public x As Single()
        Public y1 As Single()
        Public Y2 As Single()

    End Structure

    Public Structure AltAzAngles

        Public Sub New(ByVal altitude As Single, ByVal azimuth As Single)

            Me.altitude = altitude
            Me.azimuth = azimuth

        End Sub

        Public Function Invert() As AltAzAngles

            Dim tmpAltAzAngles As New AltAzAngles(-Me.altitude, -Me.azimuth)

            Return tmpAltAzAngles

        End Function

        Public altitude As Single
        Public azimuth As Single

    End Structure

[Raine]

Thanks John!

[JohnB]

I got some unexpected time to work on this today so here's a complete project for you to look at.  Please let me know if it doesn't work for you and  I'll do what I can to help you get it running.

http://members.cox.net/squadracorse/ZakSkyVB_V3.rar

It's a fairly basic example but should include a fully functioning version of Zaknafein's sky in VB.NET 2005.  You'll have to fill in your TV beta user name & key in frmMain and maybe re-add the reference to wherever the MTV3D65.DLL is on your system before it will run.  The controls for moving around are the mouse & WASD keys, the F key toggles fly mode and while flying, SPACE ascends and LSHIFT descends.  I included all the necessary media in the bin folder - I hope Zaknafein doesn't mind since most of that is his.

Well, I guess that's about it - I hope someone finds this helpful.

John B.


[EDIT] The original project seems to have been corrupt.  I tried to fix it and eventually just built a new one and then updated this link to the new file.  I'm still not sure if the new file fixes the problem or not though.

[EDIT] Updated the link to the latest version of the .rar file.

[Taneas]

hmm

Wont run..

"The specified module could not be found. (Exception from HRESULT: 0x8007007E)"

And it points to frmMain

[JohnB]

That's interesting since there's almost no code in frmMain.  All it does is set the beta user name & key then call procedures in other modules from the main loop.  Where is the error when you run it in the IDE?

John B.

[Taneas]

Code:

Partial Class frmMain
    Inherits System.Windows.Forms.Form

    'Form overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing AndAlso components IsNot Nothing Then
            components.Dispose()
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
        Me.SuspendLayout()
        '
        'frmZakSkyVB
        '
        Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.ClientSize = New System.Drawing.Size(632, 453)
        Me.Name = "frmZakSkyVB"
        Me.Text = "Zaknafein's Sky in VB.NET"
        Me.ResumeLayout(False)

    End Sub
End Class

Right on the Frmmain at the top

[JohnB]

Ah - I renamed the form at some point - it's prolly just confused about that.

Try Changing this line:

Code:

Me.Name = "frmZakSkyVB"

To this:

Code:

Me.Name = "frmMain"

That's a guess but I'll go ahead and change it in the .rar file in case that's it.

John B.


PS - Might want to change that comment too - not sure if it uses that or not.

[Taneas]

nope didnt do it

[Taneas]

how come frmMain.designer.vb shows up when you run it, but its not in the solution :|

[JohnB]

Maybe something elsewhere in the project got corrupted - as much as I like .NET, I hate how it hides and embeds so much stuff.  I deleted the form out of the project, created a new one from scratch then pasted the 2 events  back in and rebuilt the .rar file.  It worked for me when i uncompressed it but so did the last one.  Try downloading it again and let me know.

John B.


PS - It's the file that the graphical form designer builds for you.  You're not really supposed to edit it by hand so they don't show it in the IDE but if you try to open it from the project folder while the project is open in the IDE, it will open in the IDE.

PS PS - If this doesn't get it, I'll try building a new project and cutting and pasting the code into it.  The fact that the error is in a file the IDE built for me makes me think something just got messed up in one of the solution or project files.

[Taneas]

nope

[JohnB]

If anything is going to fix the project being corrupt its got to be starting an new one so I just did that and uploaded a new .rar file.  This time I created a whole new solution from scratch and then created new forms, modules & classes  within it and pasted the code from the other project into them.  Sorry it's being troublesome - we'll get it figured out though.

John B.

[Taneas]

same thing.. maybe someone else should try it..

It might just be me...

But its error on thatone thing...

Just a question, why do you have a seperate .designer.vb...

My designer code for my forms is included in the main form...

I dont have any partial class's in any of my .net apps