Imports Microsoft.Xna.Framework
Imports Microsoft.Xna.Framework.Input
Imports Microsoft.Xna.Framework.Graphics
Public Class Game
Inherits Microsoft.Xna.Framework.Game
Private Graphics As GraphicsDeviceManager
Private Batch As SpriteBatch
Private Structure VertexPositionNormalColored
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, System.Runtime.InteropServices.Marshal.SizeOf(GetType(Double)) * 3, VertexElementFormat.Color, VertexElementMethod.Default, VertexElementUsage.Color, 0), _
New VertexElement(0, System.Runtime.InteropServices.Marshal.SizeOf(GetType(Double)) * 4, VertexElementFormat.Vector3, VertexElementMethod.Default, VertexElementUsage.Normal, 0) _
}
End Structure
'Effetti - file: effects.fx
Private Effect As Effect
'Vertici
Private Vertices As VertexPositionNormalColored()
'Dichiarazione vertici. Avverte la scheda grafica del
'tipo di vertice che potrebbe ricevere
Private VDeclaration As VertexDeclaration
Private Angle As Single = 0
Private Indices() As Int32
Private TerrainWidth As Int16 = 4
Private TerrainHeight As Int16 = 3
Private HeightData As Single(,)
Private HeightMap As Texture2D
Private VertexToBuffer As VertexBuffer
Private IndexToBuffer As IndexBuffer
Private ViewMatrix As Matrix
Private ProjectionMatrix As Matrix
Private ReadOnly Property StartupPath() As String
Get
Return My.Application.Info.DirectoryPath
End Get
End Property
Sub New()
Me.Graphics = New GraphicsDeviceManager(Me)
Me.Content.RootDirectory = "content"
End Sub
Protected Overrides Sub Initialize()
Batch = New SpriteBatch(Me.Graphics.GraphicsDevice)
MyBase.Initialize()
End Sub
Protected Overrides Sub LoadContent()
MyBase.LoadContent()
Dim CompiledEffect As CompiledEffect = Microsoft.Xna.Framework.Graphics.Effect.CompileEffectFromFile(Me.StartupPath & "\effects.fx", Nothing, Nothing, CompilerOptions.None, TargetPlatform.Windows)
Effect = New Effect(Me.GraphicsDevice, CompiledEffect.GetEffectCode(), CompilerOptions.None, Nothing)
HeightMap = Texture2D.FromFile(Me.GraphicsDevice, Me.StartupPath & "\heightmap.bmp")
Me.LoadHeightdata(HeightMap)
Me.SetUpVertices()
Me.SetUpCamera()
Me.SetUpIndices()
Me.CalculateNormals()
Me.CopyToBuffer()
End Sub
Protected Overrides Sub UnloadContent()
MyBase.UnloadContent()
End Sub
Protected Overrides Sub Update(ByVal GameTime As GameTime)
Dim KeyState As KeyboardState = Keyboard.GetState
If KeyState.IsKeyDown(Keys.Left) Then
Angle -= 0.05
End If
If KeyState.IsKeyDown(Keys.Right) Then
Angle += 0.05
End If
MyBase.Update(GameTime)
End Sub
Protected Overrides Sub Draw(ByVal gameTime As Microsoft.Xna.Framework.GameTime)
Me.Graphics.GraphicsDevice.Clear(ClearOptions.Target Or ClearOptions.DepthBuffer, Color.CornflowerBlue, 1, 0)
'Seleziona la tecnica da usare
Effect.CurrentTechnique = Effect.Techniques("Colored")
Dim WorldMatrix As Matrix = _
Matrix.CreateTranslation(-Me.TerrainWidth / 2, 0, Me.TerrainHeight / 2) * _
Matrix.CreateRotationY(Angle)
Effect.Parameters("xView").SetValue(ViewMatrix)
Effect.Parameters("xProjection").SetValue(ProjectionMatrix)
Effect.Parameters("xWorld").SetValue(WorldMatrix)
'Imposta la direzione della luce
Dim LightDirection As New Vector3(1, 1.0F, 1.0F)
LightDirection.Normalize()
'Abilita la luce
Effect.Parameters("xEnableLighting").SetValue(True)
'Imposta il vettore luce negli effetti
Effect.Parameters("xLightDirection").SetValue(LightDirection)
'Introduce un po' di luce d'ambiente. Questo evita che triangoli non
'colpiti direttamente dalla luce sia invisibili
Effect.Parameters("xAmbient").SetValue(0.1F)
'Con questa opzione, verranno disegnati tutti i triangoli.
'Normalmente, quando CullMode è impostata diversamente, solo
'i triangoli rivolti verso la telecamera vengono visualizzati.
'Per sapere se un tringolo lo è, i suoi vertici devono essere definiti
'in senso orario rispetto alla telecamera
Me.GraphicsDevice.RenderState.CullMode = CullMode.None
'Me.GraphicsDevice.RenderState.FillMode = FillMode.WireFrame
'Inizia il rendering
Effect.Begin()
'Itera in ogni passo della tecnica usata
For Each Pass As EffectPass In Effect.CurrentTechnique.Passes
Pass.Begin()
Me.GraphicsDevice.VertexDeclaration = VDeclaration
Me.GraphicsDevice.Indices = IndexToBuffer
Me.GraphicsDevice.Vertices(0).SetSource(VertexToBuffer, 0, VertexPositionNormalColored.SizeInBytes)
Me.GraphicsDevice.DrawIndexedPrimitives(PrimitiveType.TriangleList, 0, 0, Vertices.Length, 0, Indices.Length / 3)
'Me.GraphicsDevice.DrawUserIndexedPrimitives(PrimitiveType.TriangleList, Vertices, 0, Vertices.Length, Indices, 0, Indices.Length / 3)
Pass.End()
Next
Effect.End()
MyBase.Draw(gameTime)
End Sub
Private Sub SetUpVertices()
ReDim Vertices(TerrainWidth * TerrainHeight)
'Minima e massima altezza rilevate nella texture
Dim MinHeight, MaxHeight As Int16
MaxHeight = 0
MinHeight = 255
For X As Int16 = 0 To Me.TerrainWidth - 1
For Y As Int16 = 0 To Me.TerrainHeight - 1
If HeightData(X, Y) > MaxHeight Then
MaxHeight = HeightData(X, Y)
End If
If HeightData(X, Y) < MinHeight Then
MinHeight = HeightData(X, Y)
End If
Next
Next
Dim StepVal As Single = (MaxHeight - MinHeight) / 4
For X As Int16 = 0 To TerrainWidth - 1
For Y As Int16 = 0 To TerrainHeight - 1
With Me.Vertices(X + Y * TerrainWidth)
.Position = New Vector3(X, Me.HeightData(X, Y), -Y)
'Colora il vertice a seconda della sua altezza
If HeightData(X, Y) < MinHeight + StepVal Then
.Color = Color.LightBlue
ElseIf HeightData(X, Y) < MinHeight + StepVal * 2 Then
.Color = New Color(115, 171, 58)
ElseIf HeightData(X, Y) < MinHeight + StepVal * 3 Then
.Color = New Color(125, 85, 49)
Else
.Color = Color.White
End If
End With
Next
Next
VDeclaration = New VertexDeclaration(Me.GraphicsDevice, VertexPositionNormalColored.VertexElements)
End Sub
Private Sub SetUpCamera()
'Crea la matrice per la telecamera:
'argomento 1: posizione della telecamera
'argomento 2: posizione dell'oggetto che si sta guardando
'argomento 3: asse verticale
ViewMatrix = Matrix.CreateLookAt(New Vector3(0, 100, 100), New Vector3(0, 0, 0), New Vector3(0, 1, 0))
'Crea la matrice per il "modo di guardare" della telecamera
'arg 1: angolo di inclinazione della telecamera (radianti)
'arg 2: proporzione tra larghezza e altezza della finestra
'arg 3: valore single che determina il "near clipping plane". Oggetti meno distanti
' dalla telecamera di questo valore non verranno disegnati
'arg 4: valore single che determina il "far clipping plane". Oggetto più distanti
' dalla telecamera di questo valore non verranno disegnati
ProjectionMatrix = Matrix.CreatePerspectiveFieldOfView(MathHelper.PiOver4, Me.GraphicsDevice.Viewport.AspectRatio, 1.0, 300.0F)
End Sub
Private Sub SetUpIndices()
ReDim Indices((Me.TerrainHeight - 1) * (Me.TerrainWidth - 1) * 6)
Dim Counter As Int32 = 0
For X As Int16 = 0 To Me.TerrainWidth - 2
For Y As Int16 = 0 To Me.TerrainHeight - 2
Dim lowerLeft As Int16 = X + Y * TerrainWidth
Dim lowerRight As Int16 = (X + 1) + Y * TerrainWidth
Dim topLeft As Int16 = X + (Y + 1) * TerrainWidth
Dim topRight As Int16 = (X + 1) + (Y + 1) * TerrainWidth
'1° triangolo
Indices(Counter) = topLeft
Indices(Counter + 1) = lowerRight
Indices(Counter + 2) = lowerLeft
Counter += 3
'2° triangolo
Indices(Counter) = topLeft
Indices(Counter + 1) = topRight
Indices(Counter + 2) = lowerRight
Counter += 3
Next
Next
End Sub
Private Sub LoadHeightdata(ByVal HeightMap As Texture2D)
Me.TerrainWidth = HeightMap.Width
Me.TerrainHeight = HeightMap.Height
Dim Colors(Me.TerrainHeight * Me.TerrainWidth - 1) As Color
HeightMap.GetData(Colors)
ReDim HeightData(Me.TerrainWidth, Me.TerrainHeight)
For I As Int16 = 0 To Me.TerrainWidth
ReDim HeightData(I, Me.TerrainHeight)
Next
For X As Int16 = 0 To Me.TerrainWidth - 1
For Y As Int16 = 0 To Me.TerrainHeight - 1
HeightData(X, Y) = Colors(X + Y * Me.TerrainWidth).R / 5
Next
Next
End Sub
Private Sub CalculateNormals()
'Calcola le normali di ogni vertice
'Prima le azzera tutte
For Each V As VertexPositionNormalColored In Vertices
V.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)
'Calcola i vettori che rappresentano due lati del triangolo
Dim Side1 As Vector3 = Vertices(Index1).Position - Vertices(Index3).Position
Dim Side2 As Vector3 = Vertices(Index1).Position - Vertices(Index2).Position
'Esegue un prodotto vettoriale, che restituisce un momento,
'perpendicolare al piano di giacenza degli altri due: la normale
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 VertexPositionNormalColored In Vertices
V.Normal.Normalize()
Next
End Sub
Private Sub CopyToBuffer()
Me.VertexToBuffer = New VertexBuffer(Me.GraphicsDevice, Vertices.Length * VertexPositionNormalColored.SizeInBytes, BufferUsage.WriteOnly)
Me.VertexToBuffer.SetData(Vertices)
Me.IndexToBuffer = New IndexBuffer(Me.GraphicsDevice, GetType(Int32), Indices.Length, BufferUsage.WriteOnly)
Me.IndexToBuffer.SetData(Indices)
End Sub
End Class
