Tag Archives: coding

Coding

3D Game of Life in VB.NET and Direct X

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
Coding

LINQ: ‘Week Commencing’ TreeNodes

I needed a way to create a TreeView in VB.NET that contained a node for each month of the year, and each month node had to contain a node for each Monday within that month. A ‘Week Commencing’ type of view. This type of problem always seems better solved with LINQ, so here’s how I did it:

Private Function GenNode() As TreeNode

        Dim rootNode As New TreeNode("Week Commencing")

' Create a list containing every date of the year
        Dim dateList As New List(Of Date)
        Dim dateIterator As New Date(Year(Now), 1, 1)
        Do Until dateIterator.Year <> Year(Now)
            dateList.Add(dateIterator)
            dateIterator = dateIterator.AddDays(1)
        Loop

' Now, using LINQ, create the TreeNodes
        Dim t = From d In dateList Group d By m = d.Month Into Group Select
            New TreeNode(MonthName(m),
                (From d1 In dateList Where d1.Month = m And d1.DayOfWeek = DayOfWeek.Monday Select New TreeNode(d1.ToString("dd-MM-yyyy"))).ToArray) Distinct

        rootNode.Nodes.AddRange(t.ToArray)

        Return rootNode

    End Function

For more information on LINQ, see the following link 🙂

http://msdn.microsoft.com/en-us/library/vstudio/bb397926.aspx

Coding

SQL Trim with Alternative Characters

SQL Trim UDF

.NET strings have a method that allow you to trim characters from the beginning and end of a string. There is also a SQL trim function, but you can only trim the space character, unfortunately you cannot specify which character you want to trim. I sought to rectify this with a UDF:

CREATE FUNCTION TrimSingleChar
(
-- Add the parameters for the function here
@needle nchar(1),
@haystack as nvarchar(max)
)
RETURNS nvarchar(max)
AS
BEGIN
DECLARE @pos as int -- variable to hold the position of @needle

-- Check whether @needle appears at the start of the string
SELECT @pos = CHARINDEX(@needle,@haystack,0)
IF @pos = 1
BEGIN
SELECT @haystack = SUBSTRING(@haystack,2,LEN(@haystack) -1)
END

-- Reverse the string
SELECT @haystack = REVERSE(@haystack)

-- Check again whether @needle appears at the start of the string
SELECT @pos = CHARINDEX(@needle,@haystack,0)
IF @pos = 1
BEGIN
SELECT @haystack = SUBSTRING(@haystack,2,LEN(@haystack) -1)
END

-- Reverse the string to back how it was, and return it
RETURN REVERSE(@haystack)

END
GO

Unfortuantely at the moment this function will only trim a single instance of @needle from the beginning and end, but at the moment that’s all I need.

As .NET has native functions available to perform the above task, a better option would be to use a SQL CLR function. That’s beyond the scope of this article, however. Maybe next time! For more information about SQL CLR functions, you can check out more at this link: http://msdn.microsoft.com/en-us/library/ms131077.aspx

For more information about SQL UDF functions, you can read more here: http://technet.microsoft.com/en-us/library/aa214363(v=sql.80).aspx