3D Game of Life

This time its the Game of Life 3D I created in VB.NET & DirectX.

You can check out the full solution here:

https://launchpad.net/gameoflife3d

Here’s the full source:

Public Class mainForm

#Region "Decl"

    Private xRes As Integer = 32                ' This is how many cells across
    Private yRes As Integer = 32                ' This is how many cells down
    Private meshes(xRes, yRes) As MeshInfo      ' This is the mesh (cell) array
    Private dev As Device = Nothing             ' This is our directx device
    Private WithEvents surface As New DXSurface ' This is our directx surface
    Private WithEvents tmrCamera As New Timer   ' Camera movement timer
    Private WithEvents frameTimer As New Timer  ' Evolution (lifecycle) timer
    Private WithEvents renderTimer As New Timer

    Private render As Boolean = False           ' Render logic switch
    Private evolve As Boolean = False           ' Evolve logic switch (lifecycle)
    Private mouseDownSw As Boolean = False      ' Mouse Down logic switch
    Private t1 As Texture                       ' Our mesh texture

    Private angle As Single = 1

    ' Inital camera position and target
    Private Const startingCamPosX As Single = 0
    Private Const startingCamPosY As Single = 5
    Private Const startingCamPosZ As Single = 50
    Private Const startingCamTarX As Single = 0
    Private Const startingcamTarY As Single = 0
    Private Const startingcamTarZ As Single = 0

#End Region

#Region "Camera Position and Target Properties"

    Private currentCamPosX As Single = startingCamPosX
    Private currentCamPosY As Single = startingCamPosY
    Private currentCamPosZ As Single = startingCamPosZ
    Private currentCamTarX As Single = startingCamTarX
    Private currentcamTarY As Single = startingcamTarY
    Private currentcamTarZ As Single = startingcamTarZ

    Private destiCamPosX As Single = startingCamPosX
    Private destiCamPosY As Single = startingCamPosY
    Private destiCamPosZ As Single = startingCamPosZ
    Private destiCamTarX As Single = startingCamTarX
    Private destiCamTarY As Single = startingcamTarY
    Private destiCamTarZ As Single = startingcamTarZ

    Private ReadOnly Property CurrentCameraPosition() As Vector3
        Get
            Return New Vector3(currentCamPosX, currentCamPosY, currentCamPosZ)
        End Get
    End Property

    Private ReadOnly Property CurrentCameraTarget() As Vector3
        Get
            Return New Vector3(currentCamTarX, currentcamTarY, currentcamTarZ)
        End Get
    End Property

    Private ReadOnly Property DestinationCameraPosition() As Vector3
        Get
            Return New Vector3(destiCamPosX, destiCamPosY, destiCamPosZ)
        End Get
    End Property

    Private ReadOnly Property DestinationCameraTarget() As Vector3
        Get
            Return New Vector3(destiCamTarX, destiCamTarY, destiCamTarZ)
        End Get
    End Property

#End Region

    ''' <summary>
    ''' Event handler
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub Me_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Me.WindowState = FormWindowState.Maximized

        ' Add the DirectX 3D surface to this form within the panel
        surface.Dock = DockStyle.Fill
        pnlSurface.Controls.Add(surface)

        ' Set up DirectX
        InitializeGraphics()
        SetupCamera()

        ' Set up cameramovement timer
        With tmrCamera
            .Interval = 1
            .Enabled = True
            .Start()
        End With

        ' Set up frame timer
        With frameTimer
            .Interval = 1
            .Enabled = True
            .Start()
        End With

        With renderTimer
            .Interval = 1
            .Enabled = True
            .Start()
        End With

    End Sub

    ''' <summary>
    ''' This is where we initialise the graphics device
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub InitializeGraphics()

        ' Set our presentation parameters
        Dim presentParams As New PresentParameters()

        presentParams.Windowed = True
        presentParams.SwapEffect = SwapEffect.Discard

        ' Create our device
        dev = New Device(0, DeviceType.Hardware, surface, CreateFlags.SoftwareVertexProcessing, presentParams)

        ' t1 = New Texture(dev, My.Resources.bm, 0, Pool.Managed)
        t1 = TextureLoader.FromFile(dev, "c:\bm.bmp")

        ' Set up mesh info data
        Dim r As New Random
        For x As Integer = 1 To xRes
            For y As Integer = 1 To yRes

                Dim mi As New MeshInfo
                Dim rv As Integer = r.Next(0, 10)

                If rv = 1 Then
                    mi.Alive = True
                Else
                    mi.Alive = False
                End If

                With mi
                    .Mesh = Mesh.Sphere(dev, 0.5, 20, 5)
                    .X = x
                    .Y = y
                    .Z = 1
                End With

                meshes(x, y) = mi

            Next

        Next

    End Sub

    ''' <summary>
    ''' Render the scene OnPaint
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub surface_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles surface.Paint

        angle = CSng(angle + 0.01)

        With dev
            .Clear(ClearFlags.Target, Color.Black, 1.0F, 0)
            SetupCamera()
            .BeginScene()
            .VertexFormat = CustomVertex.PositionTextured.Format

            ' Draw our boxes
            For Each mi As MeshInfo In meshes
                If mi IsNot Nothing AndAlso mi.Alive = True Then
                    DrawBox(0, 0, 0, CSng(mi.X - (xRes / 2)), CSng(mi.Y - (yRes / 2)), mi.Z, mi)
                End If
            Next

            .EndScene()
            .Present()

        End With

    End Sub

    ''' <summary>
    ''' Move the camera gradually from the current to the destination camera position
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub mTmr_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrCamera.Tick

        Dim movementX As Single = (Math.Abs(currentCamPosX - destiCamPosX) / 6)
        Dim movementY As Single = (Math.Abs(currentCamPosY - destiCamPosY) / 5)
        Dim movementZ As Single = (Math.Abs(currentCamPosZ - destiCamPosZ) / 10)

        If currentCamPosX < destiCamPosX Then
            currentCamPosX += movementX
        ElseIf currentCamPosX > destiCamPosX Then
            currentCamPosX -= movementX
        End If

        If currentCamPosY < destiCamPosY Then
            currentCamPosY += movementY
        ElseIf currentCamPosY > destiCamPosY Then
            currentCamPosY -= movementY
        End If

        If currentCamPosZ < destiCamPosZ Then
            currentCamPosZ += movementZ
        ElseIf currentCamPosZ > destiCamPosZ Then
            currentCamPosZ -= movementZ
        End If

        If currentCamTarX < destiCamTarX Then
            currentCamTarX += movementX
        ElseIf currentCamTarX > destiCamTarX Then
            currentCamTarX -= movementX
        End If

        If currentcamTarY < destiCamTarY Then
            currentcamTarY += movementY
        ElseIf currentcamTarY > destiCamTarY Then
            currentcamTarY -= movementY
        End If

        If currentcamTarZ < destiCamTarZ Then
            currentcamTarZ += movementZ
        ElseIf currentcamTarZ > destiCamTarZ Then
            currentcamTarZ -= movementZ
        End If

    End Sub

    ''' <summary>
    ''' Setup camera and lights
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub SetupCamera()

        dev.Transform.Projection = Matrix.PerspectiveFovLH(System.Convert.ToSingle(Math.PI) / 4, CSng(surface.Width / surface.Height), 1.0F, 300.0F)
        dev.Transform.View = Matrix.LookAtLH(CurrentCameraPosition, CurrentCameraTarget, New Vector3(0, 1, 0))
        dev.RenderState.Lighting = True

        With dev.Lights(0)
            .Type = LightType.Directional
            .Diffuse = Color.Yellow
            .Direction = New Vector3(0, -1, 10)
            .Enabled = True
            .Update()
        End With

        With dev.Lights(1)
            .Type = LightType.Directional
            .Diffuse = Color.Yellow
            .Direction = New Vector3(0, -1, -10)
            .Enabled = True
            .Update()
        End With

        With dev.Lights(2)
            .Type = LightType.Directional
            .Diffuse = Color.Blue
            .Direction = New Vector3(25, 0, 0)
            .Enabled = True
            .Update()
        End With

        With dev.Lights(3)
            .Type = LightType.Directional
            .Diffuse = Color.Blue
            .Direction = New Vector3(-25, 0, 0)
            .Enabled = True
            .Update()
        End With

        currentCamPosZ = CSng(Math.Sin(angle) * 50)
        currentCamPosX = CSng(Math.Cos(angle) * 50)

    End Sub

    ''' <summary>
    ''' Draw the mesh
    ''' </summary>
    ''' <param name="yaw"></param>
    ''' <param name="pitch"></param>
    ''' <param name="roll"></param>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <param name="z"></param>
    ''' <param name="MI"></param>
    ''' <remarks></remarks>
    Private Sub DrawBox(ByVal yaw As Single, ByVal pitch As Single, ByVal roll As Single, ByVal x As Single, ByVal y As Single, ByVal z As Single, ByVal MI As MeshInfo)

        MI.World = Matrix.Multiply(Matrix.RotationYawPitchRoll(yaw, pitch, roll), Matrix.Translation(x, y, z))
        dev.Transform.World = MI.World

        Dim mat As New Material
        mat.Ambient = Color.White
        mat.Diffuse = Color.White
        dev.Material = mat
        dev.SetTexture(0, t1)
        MI.Mesh.DrawSubset(0)

    End Sub

    ''' <summary>
    ''' Event handler
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub frameTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles frameTimer.Tick

        For x As Integer = 1 To xRes - 1
            For y As Integer = 1 To yRes - 1
                Dim mi As MeshInfo = meshes(x, y)
                Dim nc As Integer = getNeighbourCount(x, y)
                If mi.Alive Then
                    If nc < 2 Then
                        mi.Alive = False

                    ElseIf nc > 3 Then
                        mi.Alive = False
                    End If
                Else
                    If nc = 3 Then
                        mi.Alive = True
                    End If
                End If

            Next
        Next

    End Sub

    Private Function getNeighbourCount(ByVal x As Integer, ByVal y As Integer) As Integer

        Dim tl As MeshInfo = meshes(x - 1, y - 1)
        Dim tc As MeshInfo = meshes(x, y - 1)
        Dim tr As MeshInfo = meshes(x + 1, y - 1)
        Dim cl As MeshInfo = meshes(x - 1, y)
        Dim cr As MeshInfo = meshes(x + 1, y)
        Dim bl As MeshInfo = meshes(x - 1, y + 1)
        Dim bc As MeshInfo = meshes(x, y + 1)
        Dim br As MeshInfo = meshes(x + 1, y + 1)

        Dim c As Integer = 0

        If tl IsNot Nothing AndAlso tl.Alive = True Then c += 1
        If tc IsNot Nothing AndAlso tc.Alive = True Then c += 1
        If tr IsNot Nothing AndAlso tr.Alive = True Then c += 1
        If cl IsNot Nothing AndAlso cl.Alive = True Then c += 1
        If cr IsNot Nothing AndAlso cr.Alive = True Then c += 1
        If bl IsNot Nothing AndAlso bl.Alive = True Then c += 1
        If bc IsNot Nothing AndAlso bc.Alive = True Then c += 1
        If br IsNot Nothing AndAlso br.Alive = True Then c += 1

        Return c

    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim r As New Random
        For x As Integer = 1 To xRes
            For y As Integer = 1 To yRes
                Dim mi As MeshInfo = meshes(x, y)

                Dim rv As Integer = r.Next(0, 10)

                If rv = 1 Then

                    mi.Alive = True
                Else
                    mi.Alive = False
                End If
            Next
        Next

    End Sub

    Private Sub renderTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles renderTimer.Tick
        surface.Refresh()
    End Sub
End Class