Mathemathics Framework

Imports System
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D


Public Class Form1
    Inherits System.Windows.Forms.Form

    Private device As Device
    Private t1 As Texture
    Private t2 As Texture
    Private effect As Effect
    Public Shared viewMatrix As Matrix
    Public Shared projMatrix As Matrix
    Private t As Terrain
    Private FullScreen As Boolean = False
    Private rand As New Random()
    Private ambient As Single = 0.5F
    Private ElapsedTime As Single
    Private camMode As Boolean
    Private CamPoint As New Vector3()

#Region "EffectHandles"
    ''' <summary>
    ''' Percentage Ambient light
    ''' </summary>
    Private handle1 As EffectHandle
    ''' <summary>
    ''' The world view projection Matrix
    ''' </summary>
    Private handle2 As EffectHandle
    ''' <summary>
    ''' The location of the light
    ''' </summary>
    Private handle3 As EffectHandle

#End Region

    Private intFont As Microsoft.DirectX.Direct3D.Font

    Public Sub New()
        Me.Size = New Size(640, 480)
        AddHandler MyBase.KeyUp, AddressOf On_keyup
        Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.Opaque, True)
    End Sub

    Private Sub InitializeGraphics()
        'Windows.Forms.Cursor.Hide()
        Dim presentParams As New PresentParameters()
        presentParams.Windowed = Not FullScreen
        presentParams.SwapEffect = SwapEffect.Discard
        presentParams.AutoDepthStencilFormat = DepthFormat.D24X8
        presentParams.EnableAutoDepthStencil = True
        ' If we want a Fullscreen device we need to set up a backbuffer
        If FullScreen Then
            presentParams.BackBufferCount = 1
            presentParams.BackBufferFormat = Format.X8R8G8B8
            presentParams.BackBufferWidth = 800
            presentParams.BackBufferHeight = 600
        End If
        Dim hardware As Caps = Manager.GetDeviceCaps(0, DeviceType.Hardware)
        Dim flags As CreateFlags = CreateFlags.SoftwareVertexProcessing
        If hardware.DeviceCaps.SupportsHardwareTransformAndLight Then
            flags = CreateFlags.HardwareVertexProcessing
        End If
        If hardware.DeviceCaps.SupportsPureDevice Then
            flags = flags Or CreateFlags.PureDevice
        End If
        ' Pixelshader 2.0 is required
        ' If not available create a Reference device ( must have SDK installed )
        If hardware.PixelShaderVersion >= New Version(2, 0) AndAlso hardware.VertexShaderVersion >= New Version(1, 1) Then
            device = New Device(0, DeviceType.Hardware, Me, flags, presentParams)
        Else
            device = New Device(0, DeviceType.Reference, Me, flags, presentParams)
        End If

        Dim s As String
        effect = Direct3D.Effect.FromFile(device, "..\..\shader.fx", Nothing, "", ShaderFlags.None, Nothing, s)
        If s IsNot Nothing Then
            ' There are Compilation errors show them and then close app
            Windows.Forms.Cursor.Show()
            device.Dispose()
            Me.Visible = False
            MessageBox.Show(s)
            Return
        End If
        effect.Technique = "TransformTexture"
        projMatrix = Matrix.PerspectiveFovLH(CType(Math.PI, Single) / 4.0F, CType(Me.Width / Me.Height, Single), 1.0F, 250.0F)
        t1 = TextureLoader.FromFile(device, "..\..\grass.bmp")
        t2 = TextureLoader.FromFile(device, "..\..\rock.bmp")
        effect.SetValue("Texture1", t1)
        effect.SetValue("Texture2", t2)
        handle1 = effect.GetParameter(Nothing, "ambient")
        handle2 = effect.GetParameter(Nothing, "WorldViewProj")
        handle3 = effect.GetParameter(Nothing, "light")
        t = New Terrain(device, 0, 28)
        intFont = New Microsoft.DirectX.Direct3D.Font(device, New System.Drawing.Font("Arial", 18))
    End Sub

    Protected Overloads Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
        If device.Disposed Then
            Return
        End If
        ' Get elapsed time to calculate FPS
        ElapsedTime = DXUtil.Timer(DirectXTimer.GetElapsedTime)
        device.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.CornflowerBlue, 1.0F, 0)
        device.BeginScene()
        Draw()
        ' Drawing multiple lines of text on the same sprite is more efficient
        Using s As New Sprite(device)
            s.Begin(SpriteFlags.AlphaBlend)
            Dim y As Integer = 5
            intFont.DrawText(s, String.Format("FPS: {0}", (CType((1.0F / ElapsedTime), Integer)).ToString()), New Rectangle(4, y, 0, 0), DrawTextFormat.NoClip, Color.FromArgb(64, 255, 255, 255))
            y += 22
            intFont.DrawText(s, String.Format("Ambient light: {0}%", CType((ambient * 100), Integer)), New Rectangle(4, y, 0, 0), DrawTextFormat.NoClip, Color.FromArgb(64, 255, 255, 255))
            s.[End]()
        End Using
        device.EndScene()
        device.Present()
        ' The onPaint event must be called again 
        Me.Invalidate()
    End Sub

    Private Sub Draw()
        Dim AppTime As Single = DXUtil.Timer(DirectXTimer.GetApplicationTime)
        Dim campos As New Vector3(80.0F * CType(Math.Cos(AppTime), Single), 38, 80.0F * CType(Math.Sin(AppTime), Single))
        If camMode Then
            campos = New Vector3(0, 200, -30)
        End If
        viewMatrix = Matrix.LookAtLH(campos, New Vector3(), New Vector3(0, 1, 0))
        Dim worldViewProj As Matrix = viewMatrix * projMatrix
        ' Update the effect's variables
        effect.SetValue(handle1, ambient)
        effect.SetValue(handle2, worldViewProj)
        effect.SetValue(handle3, New Single() {Terrain.size * 0.5F * CType(Math.Sin(AppTime), Single), 80, Terrain.size * 0.5F * CType(Math.Cos(AppTime), Single)})
        ' Begin rendering with the effect
        effect.Begin(0)
        ' There's only one pass
        effect.BeginPass(0)
        t.Draw()
        effect.EndPass()
        effect.[End]()
    End Sub

    Public Shared Sub Main()
        Using frm As New Form1()
            frm.InitializeGraphics()
            Application.Run(frm)
        End Using
    End Sub

    Private Sub On_keyup(ByVal sender As Object, ByVal e As KeyEventArgs)
        If e.KeyCode = Keys.Escape Then
            Me.Close()
        End If
        If e.KeyCode = Keys.Up Then
            ambient += 0.1F
        End If
        If e.KeyCode = Keys.Down Then
            ambient -= 0.1F
        End If
        If e.KeyCode = Keys.[Return] Then
            t.renderNormals = Not t.renderNormals
        End If
        If e.KeyCode = Keys.Space Then
            camMode = Not camMode
        End If
        If ambient < 0 Then
            ambient = 0
        End If
        If ambient > 1 Then
            ambient = 1
        End If
    End Sub

End Class