Totem's Lair: Guida a Visual Basic.Net + XNA (3D), Aggiungere il cielo

B13. Aggiungere il cielo

Ora conosciamo tutti i segreti delle tecniche fin'ora usate, abbiamo un paesaggio texturizzato di alta qualità, ma mancano ancora molte cose prima di finire. La prima di queste è il cielo.

Come simulare il cielo: Cube Map

La tecniche usate per simulare il cielo in un'applicazione 3D sono principalmente. La prima prevede ci caricare una gigantesca smisfera sulla quale si applica un'immagine del cielo; la seconda, invece, usa un enorme cubo, e ad ogni faccia associa un'immagine di una direzione differente. Nonostante possa apparire migliore la prima, noi useremo la seconda, principalmente per questi motivi:

La prima tecnica non copre tutto la spazio 3D, ma si posizione generalmente sopra il centro del terreno. Per questo motivo, quando introdurremo la tecnica dell'acqua, potrebbero esserci delle riflessioni errate, poiché riflettono una parte di spazio che non è la volta celeste
Usando un cubo, possiamo anche limitare l'estensione dell'acqua e ottimizzare le riflessioni
Bastano otto vertici per definire un cubo, ma ce ne voglio molti di più per una (semi)sfera
Caricare modelli 3D con visual basic, senza un gestore integrato come quello di C#, è abbastanza complesso

Ora potreste anche avere delle domande, ad esempio: se usiamo un cubo, non c'è pericolo che le facce non combacino? No, poiché useremo delle texture fatte apposta (Cube Map) per essere usate in situazioni come queste. E ancora: ma gli spigoli verrebbero comunque evidenziati dalla luce! No, poiché solo le superfici provviste di normali rientrano nel calcolo della luce: se noi lasciamo le facce del cubo senza normale, verranno disegnate esattamente come accadeva nella tecnica Colored.

Costruire il cubo

Per definire un cubo servono, come accennato prima, otto vertici, che definiscono 10 triangoli (non usiamo la parete inferiore, perchè non si vede ed è inutile) e perciò 30 indici. Potrebbe sembrare un lavoretto semplice semplice, ma bisogna tenere conto di un fattore non da poco: ogni faccia ha una texture diversa, quindi bisognerà usare parametri diversi nello shader e perciò sarà necessario renderizzarne una alla volta. Questo implica che dovremo definire ogni faccia separatemente dalle altre. Per semplificare il compito, creiamo una nuova struttura:

    'Rappresenta una parete del cubo
    Private Structure SkyCubeFace
        'Vertici della parete (4)
        Public Vertices() As VertexPositionTexture
        'Indici da usare per disegnare i triangoli (6).
        'Ricordate che un quadrato è formato da due
        'triangoli e per ognuno di questi occorrono 3 indici.
        Public Indices() As Int32
        'Immagine da applicare a questa parete
        Public Texture As Texture2D
    End Structure

Dichiariamo, inoltre, altre tre variabili (se siete dei perfezionisti, potete ridurle a due):

Private SDeclaration As VertexDeclaration
    '...
    'Un array di 5 texture, una per ogni parete
    Private SkyFaces(4) As Texture2D
    'Un array di 5 SkyCubeFace
    Private SkyCube(4) As SkyCubeFace

Ora, prima di continuare, fermiamoci ad analizzare questo schema:

Cube map

Per ogni vertice ho indicato un numero: questo numero verrà usato nel codice successivo, e potrete meglio visualizzare il ragionamento che seguo io. Ammettiamo che il centro della faccia inferiore del cubo sia il punto (0,0,0) dello spazio 3D. Ammettiamo anche che ogni lato sia lungo K. Sotto questa ipotesi, avremo che ogni vertice di destra (0, 1, 4 e 5) avrà una coordinata X pari a -K/2, mentre ogni vertice di sinistra (2, 3, 6 e 7) avrà una coordinata X pari a +K/2. Allo stesso modo, i vertici 1, 3, 5 e 7 avranno una Z pari a -K/2, mentre i vertici 0, 2, 4 e 6 avranno una Z pari a +K/2. Quelli alla base, li considereremo con Y = 0, mentre quelli più in alto avranno un'altezza arbitraria che possiamo impostare a 200. Inoltre, bisogna considerare un'altra importante premessa: le coordinate texture devono essere esatte per ottenere il risultato voluto. Quindi, dovremo assegnare una coordinata texture (0,0) all'angolo superiore sinistro e (1,1) all'angolo inferiore destro.
Ora possiamo passare al codice vero e proprio:

Public Class Game
    
    '...
    
#Region "Cielo"

    'Questa funzione generic serve solo da aiuto. Dato un array di
    'qualsiasi tipo, la funzione restituisce gli elementi
    'con gli indici desiderati. Non confondete il significato
    'di indice di un elemento in un array con quello di indice
    'usato per disegnare una primitiva.
    Private Function GetElements(Of T)(ByVal Sources() As T, _ 
        ByVal ParamArray Indices() As Int32) As T()
        Dim Result(Indices.Length - 1) As T

        For I As Int16 = 0 To Indices.Length - 1
            Result(I) = Sources(Indices(I))
        Next

        Return Result
    End Function

    'Carica la volta celeste
    Private Sub LoadSkyDome()
        'Array che conterrà gli otto vertici del cubo. È
        'vero che ogni faccia dovrà avere i suoi quattro, ma
        'se noi li dichiariamo prima tutti e poi li copiamo
        'a quattro a quattro in una parete alla volta, il tutto
        'diventa molto più semplice, e anche molto più
        'ordinato. Notare che utilizziamo un tipo VertexPositionTexture.
        'Questa struttura contiene dati solo sulla posizione
        'e sulle coordinate texture e non sulla normale.
        Dim SkyVertices(7) As VertexPositionTexture
        'HalfSize rappresenta il K/2 di cui parlavamo prima
        Dim HalfSize As Int16 = 200

        'Guardate la figura del cubo inserita qua sopra
        'per sapere quale vertice sto definendo
        SkyVertices(0).Position = New Vector3(-HalfSize, 200, HalfSize)
        SkyVertices(1).Position = New Vector3(-HalfSize, 200, -HalfSize)
        SkyVertices(2).Position = New Vector3(HalfSize, 200, HalfSize)
        SkyVertices(3).Position = New Vector3(HalfSize, 200, -HalfSize)

        SkyVertices(4).Position = New Vector3(-HalfSize, 0, HalfSize)
        SkyVertices(5).Position = New Vector3(-HalfSize, 0, -HalfSize)

        SkyVertices(6).Position = New Vector3(HalfSize, 0, HalfSize)
        SkyVertices(7).Position = New Vector3(HalfSize, 0, -HalfSize)

        'La prima faccia (quella superiore) è formata dai vertici
        '0, 1, 2 e 3. Con la funzione GetElements li preleviamo direttamente
        'dall'array testé dichiarato, senza fare troppa fatica
        SkyCube(0).Vertices = GetElements(SkyVertices, 0, 1, 2, 3)
        'Faccia sinistra
        SkyCube(1).Vertices = GetElements(SkyVertices, 5, 1, 4, 0)
        'Faccia anteriore
        SkyCube(2).Vertices = GetElements(SkyVertices, 4, 0, 6, 2)
        'Faccia destra
        SkyCube(3).Vertices = GetElements(SkyVertices, 6, 2, 7, 3)
        'Faccia posteriore
        SkyCube(4).Vertices = GetElements(SkyVertices, 7, 3, 5, 1)

        'Dichiaro la prima faccia separata per un semplice motivo.
        'Tutte le altre parti della cube map hanno un'immagine che
        'rappresenta per metà la terra e per metà il
        'cielo (è il meglio che sono riuscito a trovare).
        'Per questo motivo, le loro coordinate texture andranno da
        '0 a 1 in larghezza, ma da 0 a solo 0.5 in altezza. Invece,
        'la faccia superiore ospita solo cielo e non c'è 
        'bisogno di togliere niente.
        With SkyCube(0)
            .Indices = New Int32() {0, 1, 2, 2, 1, 3}
            .Texture = SkyFaces(0)
            .Vertices(0).TextureCoordinate = New Vector2(0, 1)
            .Vertices(1).TextureCoordinate = New Vector2(0, 0)
            .Vertices(2).TextureCoordinate = New Vector2(1, 1)
            .Vertices(3).TextureCoordinate = New Vector2(1, 0)
        End With
        'Inizializza le altre facce
        For I As Byte = 1 To 4
            With SkyCube(I)
                .Indices = New Int32() {0, 1, 2, 2, 1, 3}
                .Texture = SkyFaces(I)
                .Vertices(0).TextureCoordinate = New Vector2(0, 0.5)
                .Vertices(1).TextureCoordinate = New Vector2(0, 0)
                .Vertices(2).TextureCoordinate = New Vector2(1, 0.5)
                .Vertices(3).TextureCoordinate = New Vector2(1, 0)
            End With
        Next

        'Poiché stiamo utilizzando un diverso tipo di vertici
        'rispetto al programma principale, occorre una diversa
        'definizione:
        SDeclaration = New VertexDeclaration(Me.GraphicsDevice, _ 
            VertexPositionTexture.VertexElements)
    End Sub

    'Disegna il cielo
    Private Sub DrawSky()
        'È la prima volta che usiamo due tecniche
        'contemporaneamente!
        For I As Byte = 0 To 4
            'Notare che qui usiamo una semplice tecnica Textured...
            Shader.CurrentTechnique = Shader.Techniques("Textured")
            Shader.Parameters("View").SetValue(ViewMatrix)
            Shader.Parameters("Projection").SetValue(ProjectionMatrix)
            Shader.Parameters("World").SetValue(Matrix.Identity)
            '... senza calcolo della luce
            Shader.Parameters("LightEnabled").SetValue(False)
            Shader.Parameters("ATexture").SetValue(SkyFaces(I))

            Me.GraphicsDevice.RenderState.CullMode = CullMode.None
            Shader.Begin()
            For Each Pass As EffectPass In Shader.CurrentTechnique.Passes
                Pass.Begin()
                With Me.GraphicsDevice
                    'Cambia la dichiarazione
                    .VertexDeclaration = SDeclaration
                    .DrawUserIndexedPrimitives(PrimitiveType.TriangleList, _ 
                        SkyCube(I).Vertices, 0, SkyCube(I).Vertices.Length, _ 
                        SkyCube(I).Indices, 0, SkyCube(I).Indices.Length / 3)
                End With
                Pass.End()
            Next
            Shader.End()
        Next
    End Sub
#End Region

    '...

    Protected Overrides Sub Draw(ByVal gameTime As GameTime)
        Me.Graphics.GraphicsDevice.Clear(Color.CornflowerBlue)

        'Disegna il cielo prima del resto
        DrawSky()
        'Ora che abbiamo utilizzato il metodo 
        'DrawUserIndexedPrimivites, dobbiamo per forza aggiornare
        'i buffer se vogliamo che funzioni tutto come prima
        Me.CopyToBuffer()

        Shader.CurrentTechnique = Shader.Techniques("MultiTextured")

        Shader.Parameters("View").SetValue(ViewMatrix)
        Shader.Parameters("Projection").SetValue(ProjectionMatrix)
        Shader.Parameters("World").SetValue( _
            Matrix.CreateTranslation( _
            New Vector3(-TerrainWidth / 2, 0, TerrainLength / 2)))

        Dim LightDirection As New Vector3(27.73, -17.67, 6.14)
        LightDirection.Normalize()
        Shader.Parameters("LightEnabled").SetValue(True)
        Shader.Parameters("LightDirection").SetValue(LightDirection)
        Shader.Parameters("AmbientFactor").SetValue(0.3F)

        Shader.Parameters("Texture0").SetValue(Sand)
        Shader.Parameters("Texture1").SetValue(Grass)
        Shader.Parameters("Texture2").SetValue(Rock)
        Shader.Parameters("Texture3").SetValue(Snow)

        Shader.Begin()
        For Each Pass As EffectPass In Shader.CurrentTechnique.Passes
            Pass.Begin()
            With Me.GraphicsDevice
                .VertexDeclaration = VDeclaration
                Me.GraphicsDevice.DrawIndexedPrimitives( _
                    PrimitiveType.TriangleList, 0, 0, _
                    Vertices.Length, 0, Indices.Length / 3)
            End With
            Pass.End()
        Next
        Shader.End()

        MyBase.Draw(gameTime)
    End Sub
End Class

L'unica cosa che manca ora, sono le immagini. Potete scaricarle da qui (il sito originale da dove le ho prese è questo). Sono numerate da uno a cinque, e per questo è facile caricarle:

Protected Overrides Sub LoadContent()
        Shader = GetEffect(AppPath & "\SimpleShader.fx")
        Grass = GetTexture(AppPath & "\grass.dds")
        Sand = GetTexture(AppPath & "\sand.dds")
        Rock = GetTexture(AppPath & "\rock.dds")
        Snow = GetTexture(AppPath & "\snow.dds")

        For I As Byte = 0 To 4
            SkyFaces(I) = GetTexture(AppPath & "\skyface" & (I + 1) & ".png")
        Next

        LoadHeightMap(GetTexture(AppPath & "\HeightMap.bmp"))
        LoadSkyDome()
        SetVertices()
        SetIndices()
        SetNormals()
        CopyToBuffer()

        ProjectionMatrix = Matrix.CreatePerspectiveFieldOfView( _
            MathHelper.PiOver4, _
            Me.GraphicsDevice.Viewport.AspectRatio, _
            1, 500)

        CameraPosition = New Vector3(0, 40, TerrainLength / 2)
        Mouse.SetPosition(Me.GraphicsDevice.Viewport.Width / 2, _
                Me.GraphicsDevice.Viewport.Height / 2)
        PrevMouseState = Mouse.GetState
        UpdateView()

        MyBase.LoadContent()
    End Sub

Ed ecco il risultato:

Terra e cielo

Questo screenshot è stato preso con particolare attenzione, ma so già che non sarete soddisfatti dal risultato reale:

Un buco azzurro

Vedremo di compesare questa imprecisione con l'introduzione dell'acqua.

Imports Microsoft.Xna.Framework
Imports Microsoft.Xna.Framework.Input
Imports Microsoft.Xna.Framework.Graphics
Imports System.Runtime.InteropServices

Public Class Game
    Inherits Microsoft.Xna.Framework.Game

#Region "Strutture aggiuntive"
    Private Shared DoubleSize As Byte = Marshal.SizeOf(GetType(Double))

    Private Structure VertexPositionNormalColor
        Public Position As Vector3
        Public Normal As Vector3
        Public Color As Color

        Public Shared SizeInBytes As Int16 = 7 * 4
        Public Shared VertexElements() As VertexElement = New VertexElement() _
        { _
            New VertexElement(0, 0, VertexElementFormat.Vector3, _
                VertexElementMethod.Default, _
                VertexElementUsage.Position, 0), _
            New VertexElement(0, DoubleSize * 3, _
                VertexElementFormat.Color, _
                VertexElementMethod.Default, _
                VertexElementUsage.Color, 0), _
            New VertexElement(0, DoubleSize * 4, _
                VertexElementFormat.Vector3, _
                VertexElementMethod.Default, _
                VertexElementUsage.Normal, 0) _
        }
    End Structure

    Private Structure VertexPositionNormalMultitexture
        Public Position As Vector3
        Public Normal As Vector3
        Public TextureCoordinate As Vector4
        Public TextureWeight As Vector4

        Public Shared SizeInBytes As Int16 = (3 + 3 + 4 + 4) * 4
        Public Shared VertexElements As VertexElement() = New VertexElement() _
          { _
            New VertexElement(0, 0, VertexElementFormat.Vector3, _
                VertexElementMethod.Default, _
                VertexElementUsage.Position, 0), _
            New VertexElement(0, 4 * 3, _
                VertexElementFormat.Vector3, _
                VertexElementMethod.Default, _
                VertexElementUsage.Normal, 0), _
            New VertexElement(0, 4 * 6, _
                VertexElementFormat.Vector4, _
                VertexElementMethod.Default, _
                VertexElementUsage.TextureCoordinate, 0), _
            New VertexElement(0, 4 * 10, _
                VertexElementFormat.Vector4, _
                VertexElementMethod.Default, _
                VertexElementUsage.TextureCoordinate, 1) _
          }
    End Structure

    Private Structure SkyCubeFace
        Public Vertices() As VertexPositionTexture
        Public Indices() As Int32
        Public Texture As Texture2D
    End Structure
#End Region

#Region "Variabili globali"

    Private AppPath As String = _
        My.Application.Info.DirectoryPath

    Private Graphics As GraphicsDeviceManager

    'VERTICI, INDICI E BUFFER ------------------------
    Private Shader As Effect
    Private Vertices() As VertexPositionNormalMultitexture
    Private Indices() As Int32
    Private VBuffer As VertexBuffer
    Private IBuffer As IndexBuffer
    Private VDeclaration As VertexDeclaration
    Private SDeclaration As VertexDeclaration

    'MATRICI -----------------------------------------
    Private ViewMatrix As Matrix
    Private ProjectionMatrix As Matrix
    Private WorldMatrix As Matrix


    'HEIGHTDATA --------------------------------------
    Private HeightData(,) As Single
    Private Const MinHeight As Single = 0
    Private Const MaxHeight As Single = 30
    Private TerrainWidth, TerrainLength As Int32

    'TELECAMERA -------------------------------------
    Private PrevMouseState As MouseState
    Private LeftRightRotation As Single = MathHelper.PiOver2
    Private UpDownRotation As Single = -MathHelper.Pi / 10.0F
    Private CameraPosition As Vector3
    Private RotationSpeed As Single = 0.3
    Private MoveSpeed As Single = 1

    'TEXTURE ----------------------------------------
    Private Grass As Texture2D
    Private Sand As Texture2D
    Private Rock As Texture2D
    Private Snow As Texture2D

    'CIELO ------------------------------------------
    Private SkyFaces(4) As Texture2D
    Private SkyCube(4) As SkyCubeFace
#End Region

#Region "Funzioni utili"

    Private Function GetEffect(ByVal FileName As String) As Effect
        Dim CompEffect As CompiledEffect = _
            Effect.CompileEffectFromFile(FileName, _
            Nothing, Nothing, _
            CompilerOptions.None, _
            TargetPlatform.Windows)

        Return New Effect(Me.GraphicsDevice, _
            CompEffect.GetEffectCode, _
            CompilerOptions.None, Nothing)
    End Function

    Private Function GetTexture(ByVal FileName As String)
        Return Texture2D.FromFile(Me.GraphicsDevice, FileName)
    End Function

#End Region

#Region "Caricamento Heightmap"

    Private Sub LoadHeightMap(ByVal HeightMap As Texture2D)
        TerrainWidth = HeightMap.Width
        TerrainLength = HeightMap.Height

        Dim Colors(TerrainWidth * TerrainLength - 1) As Color
        HeightMap.GetData(Colors)

        For I As Int32 = 0 To TerrainWidth - 1
            ReDim HeightData(I, TerrainLength - 1)
        Next

        For X As Int32 = 0 To TerrainWidth - 1
            For Z As Int32 = 0 To TerrainLength - 1
                HeightData(X, Z) = MinHeight + _
                    (Colors(X + Z * TerrainWidth).R / 255) * _
                    (MaxHeight - MinHeight)
            Next
        Next

        VDeclaration = New VertexDeclaration(Me.GraphicsDevice, _
            VertexPositionNormalMultitexture.VertexElements)
    End Sub

    Private Sub SetVertices()
        ReDim Vertices(TerrainWidth * TerrainLength - 1)

        Dim Strip As Single = (MaxHeight - MinHeight) / 4
        For X As Int32 = 0 To TerrainWidth - 1
            For Z As Int32 = 0 To TerrainLength - 1
                With Vertices(X + Z * TerrainWidth)
                    Dim Y As Single = HeightData(X, Z)

                    .Position = New Vector3(X, Y, -Z)
                    .TextureCoordinate.X = X / 32
                    .TextureCoordinate.Y = Z / 32

                    .TextureWeight.X = MathHelper.Clamp(1.0F - Math.Abs(Y - 0) / 8.0F, 0, 1)
                    .TextureWeight.Y = MathHelper.Clamp(1.0F - Math.Abs(Y - 12) / 6.0F, 0, 1)
                    .TextureWeight.Z = MathHelper.Clamp(1.0F - Math.Abs(Y - 20) / 6.0F, 0, 1)
                    .TextureWeight.W = MathHelper.Clamp(1.0F - Math.Abs(Y - 30) / 6.0F, 0, 1)

                    Dim Total As Single = .TextureWeight.X
                    Total += .TextureWeight.Y
                    Total += .TextureWeight.Z
                    Total += .TextureWeight.W

                    .TextureWeight.X /= Total
                    .TextureWeight.Y /= Total
                    .TextureWeight.Z /= Total
                    .TextureWeight.W /= Total
                End With
            Next
        Next
    End Sub

    Private Sub SetIndices()
        ReDim Indices((TerrainWidth - 1) * (TerrainLength - 1) * 6 - 1)

        Dim Counter As Int32 = 0

        For X As Int32 = 0 To TerrainWidth - 2
            For Z As Int32 = 0 To TerrainLength - 2
                Dim LowerLeft As Int16 = X + Z * TerrainWidth
                Dim LowerRight As Int16 = (X + 1) + Z * TerrainWidth
                Dim TopLeft As Int16 = X + (Z + 1) * TerrainWidth
                Dim TopRight As Int16 = (X + 1) + (Z + 1) * TerrainWidth

                Indices(Counter) = TopLeft
                Indices(Counter + 1) = LowerRight
                Indices(Counter + 2) = LowerLeft
                Counter += 3

                Indices(Counter) = TopLeft
                Indices(Counter + 1) = TopRight
                Indices(Counter + 2) = LowerRight
                Counter += 3
            Next
        Next
    End Sub

    Private Sub SetNormals()
        For I As Int32 = 0 To Vertices.Length - 1
            Vertices(I).Normal = New Vector3(0, 0, 0)
        Next

        For I As Int16 = 0 To (Indices.Length / 3) - 1
            Dim Index1 As Int16 = Indices(I * 3)
            Dim Index2 As Int16 = Indices(I * 3 + 1)
            Dim Index3 As Int16 = Indices(I * 3 + 2)

            Dim Side1 As Vector3 = _
                Vertices(Index1).Position - Vertices(Index3).Position
            Dim Side2 As Vector3 = _
                Vertices(Index1).Position - Vertices(Index2).Position
            Dim Normal As Vector3 = Vector3.Cross(Side1, Side2)

            Vertices(Index1).Normal += Normal
            Vertices(Index2).Normal += Normal
            Vertices(Index3).Normal += Normal
        Next

        For Each V As VertexPositionNormalMultitexture In Vertices
            V.Normal.Normalize()
        Next
    End Sub

    Private Sub CopyToBuffer()
        VBuffer = New VertexBuffer(Me.GraphicsDevice, _
            Vertices.Length * VertexPositionNormalMultitexture.SizeInBytes, _
            BufferUsage.WriteOnly)
        VBuffer.SetData(Vertices)

        IBuffer = New IndexBuffer(Me.GraphicsDevice, _
            GetType(Int32), Indices.Length, BufferUsage.WriteOnly)
        IBuffer.SetData(Indices)

        Me.GraphicsDevice.Indices = IBuffer
        Me.GraphicsDevice.Vertices(0).SetSource( _
            VBuffer, 0, VertexPositionNormalMultitexture.SizeInBytes)
    End Sub

#End Region

#Region "Cielo"

    Private Function GetElements(Of T)(ByVal Sources() As T, ByVal ParamArray Indices() As Int32) As T()
        Dim Result(Indices.Length - 1) As T

        For I As Int16 = 0 To Indices.Length - 1
            Result(I) = Sources(Indices(I))
        Next

        Return Result
    End Function

    Private Sub LoadSkyDome()
        Dim SkyVertices(7) As VertexPositionTexture
        Dim HalfSize As Int16 = 200
        Dim HalfHeight As Int16 = 150

        SkyVertices(0).Position = New Vector3(-HalfSize, 200, HalfSize)
        SkyVertices(1).Position = New Vector3(-HalfSize, 200, -HalfSize)
        SkyVertices(2).Position = New Vector3(HalfSize, 200, HalfSize)
        SkyVertices(3).Position = New Vector3(HalfSize, 200, -HalfSize)

        SkyVertices(4).Position = New Vector3(-HalfSize, 0, HalfSize)
        SkyVertices(5).Position = New Vector3(-HalfSize, 0, -HalfSize)

        SkyVertices(6).Position = New Vector3(HalfSize, 0, HalfSize)
        SkyVertices(7).Position = New Vector3(HalfSize, 0, -HalfSize)

        SkyCube(0).Vertices = GetElements(SkyVertices, 0, 1, 2, 3)
        SkyCube(1).Vertices = GetElements(SkyVertices, 5, 1, 4, 0)
        SkyCube(2).Vertices = GetElements(SkyVertices, 4, 0, 6, 2)
        SkyCube(3).Vertices = GetElements(SkyVertices, 6, 2, 7, 3)
        SkyCube(4).Vertices = GetElements(SkyVertices, 7, 3, 5, 1)

        With SkyCube(0)
            .Indices = New Int32() {0, 1, 2, 2, 1, 3}
            .Texture = SkyFaces(0)
            .Vertices(0).TextureCoordinate = New Vector2(0, 1)
            .Vertices(1).TextureCoordinate = New Vector2(0, 0)
            .Vertices(2).TextureCoordinate = New Vector2(1, 1)
            .Vertices(3).TextureCoordinate = New Vector2(1, 0)
        End With
        For I As Byte = 1 To 4
            With SkyCube(I)
                .Indices = New Int32() {0, 1, 2, 2, 1, 3}
                .Texture = SkyFaces(I)
                .Vertices(0).TextureCoordinate = New Vector2(0, 0.5)
                .Vertices(1).TextureCoordinate = New Vector2(0, 0)
                .Vertices(2).TextureCoordinate = New Vector2(1, 0.5)
                .Vertices(3).TextureCoordinate = New Vector2(1, 0)
            End With
        Next

        SDeclaration = New VertexDeclaration(Me.GraphicsDevice, VertexPositionTexture.VertexElements)
    End Sub

    Private Sub DrawSky()
        For I As Byte = 0 To 4
            Shader.CurrentTechnique = Shader.Techniques("Textured")
            Shader.Parameters("View").SetValue(ViewMatrix)
            Shader.Parameters("Projection").SetValue(ProjectionMatrix)
            Shader.Parameters("World").SetValue(Matrix.Identity)
            Shader.Parameters("LightEnabled").SetValue(False)
            Shader.Parameters("ATexture").SetValue(SkyFaces(I))

            Me.GraphicsDevice.RenderState.CullMode = CullMode.None
            Shader.Begin()
            For Each Pass As EffectPass In Shader.CurrentTechnique.Passes
                Pass.Begin()
                With Me.GraphicsDevice
                    .VertexDeclaration = SDeclaration
                    .DrawUserIndexedPrimitives(PrimitiveType.TriangleList, SkyCube(I).Vertices, 0, SkyCube(I).Vertices.Length, SkyCube(I).Indices, 0, SkyCube(I).Indices.Length / 3)
                End With
                Pass.End()
            Next
            Shader.End()
        Next
    End Sub
#End Region

#Region "Gestione telecamera"

    Private Sub ProcessMouseInput(ByVal ElapsedTime As Single)
        Dim CurrentMouseState As MouseState = Mouse.GetState

        If CurrentMouseState <> PrevMouseState Then
            Dim DX As Single = _
                CurrentMouseState.X - PrevMouseState.X
            Dim DY As Single = _
                CurrentMouseState.Y - PrevMouseState.Y

            LeftRightRotation -= DX * RotationSpeed * ElapsedTime
            UpDownRotation -= DY * RotationSpeed * ElapsedTime

            Mouse.SetPosition(Me.GraphicsDevice.Viewport.Width / 2, _
                Me.GraphicsDevice.Viewport.Height / 2)
            UpdateView()
        End If
    End Sub

    Private Sub ProcessKeyboardInput()
        Dim Motion As New Vector3(0, 0, 0)
        Dim KeyState As KeyboardState = Keyboard.GetState

        If KeyState.IsKeyDown(Keys.W) Then
            Motion += New Vector3(0, 0, -1)
        End If

        If KeyState.IsKeyDown(Keys.S) Then
            Motion += New Vector3(0, 0, 1)
        End If

        If KeyState.IsKeyDown(Keys.D) Then
            Motion += New Vector3(1, 0, 0)
        End If

        If KeyState.IsKeyDown(Keys.A) Then
            Motion += New Vector3(-1, 0, 0)
        End If

        If KeyState.IsKeyDown(Keys.Up) Then
            Motion += New Vector3(0, 1, 0)
        End If

        If KeyState.IsKeyDown(Keys.Down) Then
            Motion += New Vector3(0, -1, 0)
        End If

        UpdatePosition(Motion)
    End Sub

    Private Sub UpdateView()
        Dim Rotation As Matrix = _
            Matrix.CreateRotationX(UpDownRotation) * _
            Matrix.CreateRotationY(LeftRightRotation)

        Dim Forward As New Vector3(0, 0, -1)
        Dim Up As New Vector3(0, 1, 0)

        Dim RotForward As Vector3 = _
            Vector3.Transform(Forward, Rotation)
        Dim RotUp As Vector3 = Vector3.Transform(Up, Rotation)

        Dim Target As Vector3 = CameraPosition + RotForward
        ViewMatrix = Matrix.CreateLookAt(CameraPosition, Target, RotUp)
    End Sub

    Private Sub UpdatePosition(ByVal Motion As Vector3)
        Dim Rotation As Matrix = _
            Matrix.CreateRotationX(UpDownRotation) * _
            Matrix.CreateRotationY(LeftRightRotation)
        Dim RotMotion As Vector3 = Vector3.Transform(Motion, Rotation)

        CameraPosition += RotMotion * MoveSpeed
        UpdateView()
    End Sub

#End Region

#Region "Gestione risorse"

    Sub New()
        Me.Graphics = New GraphicsDeviceManager(Me)
        Me.Content.RootDirectory = "content"
    End Sub

    Protected Overrides Sub Initialize()
        MyBase.Initialize()
    End Sub

    Protected Overrides Sub LoadContent()
        Shader = GetEffect(AppPath & "\SimpleShader.fx")
        Grass = GetTexture(AppPath & "\grass.dds")
        Sand = GetTexture(AppPath & "\sand.dds")
        Rock = GetTexture(AppPath & "\rock.dds")
        Snow = GetTexture(AppPath & "\snow.dds")

        For I As Byte = 0 To 4
            SkyFaces(I) = GetTexture(AppPath & "\skyface" & (I + 1) & ".png")
        Next

        LoadHeightMap(GetTexture(AppPath & "\HeightMap.bmp"))
        LoadSkyDome()
        SetVertices()
        SetIndices()
        SetNormals()
        CopyToBuffer()

        ProjectionMatrix = Matrix.CreatePerspectiveFieldOfView( _
            MathHelper.PiOver4, _
            Me.GraphicsDevice.Viewport.AspectRatio, _
            1, 500)

        CameraPosition = New Vector3(0, 40, TerrainLength / 2)
        Mouse.SetPosition(Me.GraphicsDevice.Viewport.Width / 2, _
                Me.GraphicsDevice.Viewport.Height / 2)
        PrevMouseState = Mouse.GetState
        UpdateView()

        MyBase.LoadContent()
    End Sub

    Protected Overrides Sub UnloadContent()
        MyBase.UnloadContent()
    End Sub

#End Region

#Region "Aggiornamento mondo 3D"

    Protected Overrides Sub Update(ByVal GameTime As GameTime)
        ProcessMouseInput(GameTime.ElapsedGameTime.TotalSeconds)
        ProcessKeyboardInput()

        MyBase.Update(GameTime)
    End Sub

    Protected Overrides Sub Draw(ByVal gameTime As GameTime)
        Me.Graphics.GraphicsDevice.Clear(Color.CornflowerBlue)

        DrawSky()
        Me.CopyToBuffer()

        Shader.CurrentTechnique = Shader.Techniques("MultiTextured")

        Shader.Parameters("View").SetValue(ViewMatrix)
        Shader.Parameters("Projection").SetValue(ProjectionMatrix)
        Shader.Parameters("World").SetValue( _
            Matrix.CreateTranslation( _
            New Vector3(-TerrainWidth / 2, 0, TerrainLength / 2)))

        Dim LightDirection As New Vector3(27.73, -17.67, 6.14)
        LightDirection.Normalize()
        Shader.Parameters("LightEnabled").SetValue(True)
        Shader.Parameters("LightDirection").SetValue(LightDirection)
        Shader.Parameters("AmbientFactor").SetValue(0.3F)

        Shader.Parameters("Texture0").SetValue(Sand)
        Shader.Parameters("Texture1").SetValue(Grass)
        Shader.Parameters("Texture2").SetValue(Rock)
        Shader.Parameters("Texture3").SetValue(Snow)

        Shader.Begin()
        For Each Pass As EffectPass In Shader.CurrentTechnique.Passes
            Pass.Begin()
            With Me.GraphicsDevice
                .VertexDeclaration = VDeclaration
                Me.GraphicsDevice.DrawIndexedPrimitives( _
                    PrimitiveType.TriangleList, 0, 0, _
                    Vertices.Length, 0, Indices.Length / 3)
            End With
            Pass.End()
        Next
        Shader.End()

        MyBase.Draw(gameTime)
    End Sub
#End Region
End Class

The Totem's Lair - Copyright (C) 2009
È vietata la riproduzione sia totale che parziale del sito.