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