Question Almost-Completed Sub - Need Help with Ending

[quddusaliquddus]

Hi ,
I am trying to implement an Algorithm called "Diamond-Square Algorithm" ().

I am having trouble ending it so that it retiurns the required result. So far I have the folloiwng.

Imports System.Windows.Media.Media3D
Imports System.Math

'http://gameprogrammer.com/fractal.html

Class Window1

    Private Sub btnAddTerrain_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles btnAddTerrain.Click

        Dim PointList As New Point3DCollection

        Dim Rand As New Random(1234)

        For z = 0 To 3

            For x = 0 To 3

                PointList.Add(New Point3D(x, Rand.Next(0, 4), z))

            Next

        Next

        Dim P As Point3DCollection = DiamondSquare(PointList, 10)

    End Sub

    Function DiamondSquare(ByVal PointsColl As Point3DCollection, ByVal R As Integer) As Point3DCollection

        Dim SquareSize As Integer = Sqrt(PointsColl.Count)

        If PointsColl.Count > 4 Then

            'Variables

            Dim RandomRange As Integer = R

            Dim Rand As New Random(1234)


            'Diamond Step

            Dim SqrCorner1 As Integer = 1

            Dim SqrCorner2 As Integer = SquareSize

            Dim SqrCorner3 As Integer = (SquareSize - 1) * SquareSize + 1

            Dim SqrCorner4 As Integer = SquareSize * SquareSize

            Dim SqrCentre As Integer = (SquareSize / 2) ^ 2


            'Assign Diamond Centre value

            Dim SqrCentreValue As Double = PointsColl(SqrCorner1 - 1).Y + PointsColl(SqrCorner2 - 1).Y + PointsColl(SqrCorner3 - 1).Y + PointsColl(SqrCorner4 - 1).Y + Rand.Next(0, RandomRange)

            PointsColl(SqrCentre) = New Point3D(PointsColl(SqrCentre).X, SqrCentreValue, PointsColl(SqrCentre).Z)


            'Square Step

            Dim DiamCorner1 As Integer = SquareSize / 2

            Dim DiamCorner2 As Integer = DiamCorner1 + SquareSize

            Dim DiamCorner3 As Integer = DiamCorner2 + SquareSize

            Dim DiamCorner4 As Integer = DiamCorner3 + SquareSize


            'Assign Diamond Centre Values to Diamond Corners

            PointsColl(DiamCorner1) = New Point3D(PointsColl(DiamCorner1).X, SqrCentreValue, PointsColl(DiamCorner1).Z)

            PointsColl(DiamCorner2) = New Point3D(PointsColl(DiamCorner2).X, SqrCentreValue, PointsColl(DiamCorner2).Z)

            PointsColl(DiamCorner3) = New Point3D(PointsColl(DiamCorner3).X, SqrCentreValue, PointsColl(DiamCorner3).Z)

            PointsColl(DiamCorner4) = New Point3D(PointsColl(DiamCorner4).X, SqrCentreValue, PointsColl(DiamCorner4).Z)


            'Split into Four Squares

            Dim Square1 As New Point3DCollection((SquareSize / 2) - 1) '((SquareSize/2)-1)

            Dim Square2 As New Point3DCollection((SquareSize / 2) - 1) '((SquareSize/2)-1)

            Dim Square3 As New Point3DCollection((SquareSize / 2) - 1) '((SquareSize/2)-1)

            Dim Square4 As New Point3DCollection((SquareSize / 2) - 1) '((SquareSize/2)-1)

            'Populate Square 1

            For i = 0 To (SquareSize / 2) - 1

                For j = 0 To (SquareSize / 2) - 1

                    Square1.Add(PointsColl((i * SquareSize) + j))

                Next

            Next

            'Populate Square 2

            For i = 0 To (SquareSize / 2) - 1

                For j = 0 To (SquareSize / 2) - 1

                    Square2.Add(PointsColl((i * SquareSize) + j + (SquareSize / 2)))

                Next

            Next

            'Populate Square 3

            For i = 0 To (SquareSize / 2) - 1

                For j = 0 To (SquareSize / 2) - 1

                    Square3.Add(PointsColl(((i + SquareSize / 2) * SquareSize) + j))

                Next

            Next

            'Populate Square 4

            For i = 0 To (SquareSize / 2) - 1

                For j = 0 To (SquareSize / 2) - 1

                    Square4.Add(PointsColl(((i + SquareSize / 2) * SquareSize) + j + (SquareSize / 2)))

                Next

            Next


            'Call function for each Quarter Square

            Return DiamondSquare(Square1, R - 1)

            Return DiamondSquare(Square2, R - 1)

            Return DiamondSquare(Square3, R - 1)

            Return DiamondSquare(Square4, R - 1)

        Else

            'Replace Square Values in PointsColl

            'Retrieve Square

            Dim Square As New Point3DCollection()

            MessageBox.Show(PointsColl.Count / 2)

            Square.Add(PointsColl(0))

            Square.Add(PointsColl(1))

            Square.Add(PointsColl(2))

            Square.Add(PointsColl(3))

            Return Square

        End If

    End Function

End Class

 

[quddusaliquddus]

Link to Algorithm: Generating Random Fractal Terrain

 

[InertiaM]

As soon as you use "Return" inside a function, it exits the function and will not process any code after it. So:-

            Return DiamondSquare(Square1, R - 1)    'OK
            Return DiamondSquare(Square2, R - 1)    'will not be executed
            Return DiamondSquare(Square3, R - 1)    'will not be executed
            Return DiamondSquare(Square4, R - 1)    'will not be executed

 

[quddusaliquddus]

Thanks for the heads up. Ive updated it - and it looks like it should be working.

How can I test if its working?

    Function DiamondSquareAlgorithm(ByVal PointsColl As Point3DCollection, ByVal RandomRange As Integer) As Point3DCollection

        If PointsColl.Count > 2 Then

            '### Square Step

            'Setup Variables
            Dim Points As New Point3DCollection
            Points = PointsColl

            'Square
            Dim SqrSize As Integer
            Dim SqrSide As Integer
            Dim Rnd As New Random(1234)
            Dim SqrCorners As Integer() = New Integer(3) {}

            'Diamond
            Dim Centre As Integer
            Dim DiamCorners As Integer() = New Integer(3) {}

            'Assign Square Side Length
            SqrSide = Sqrt(Points.Count) - 1

            'Assign Square Corner Indexes
            SqrSize = Points.Count - 1
            SqrCorners(0) = 0
            SqrCorners(1) = Sqrt(SqrSize) - 1
            SqrCorners(2) = Sqrt(SqrSize + 1) * (Sqrt(SqrSize + 1) - 1)
            SqrCorners(3) = SqrSize


            '### Diamond Step

            'Assign Centre Index
            Centre = SqrSize / 2

            'Create Centre Point3D
            Dim CentrePoint As New Point3D

            'Assign to Centre Point3D
            CentrePoint.X = Points(Centre).X
            CentrePoint.Y = Points(SqrCorners(0)).Y + Points(SqrCorners(1)).Y + Points(SqrCorners(2)).Y + Points(SqrCorners(3)).Y + (Rnd.Next(0, RandomRange) / 100)
            CentrePoint.Z = Points(Centre).Z

            'Assign Centre Point3D to Points Collection
            Points(Centre) = CentrePoint

            'Assign Diamond Corners Indexes
            DiamCorners(0) = (Sqrt(SqrSize + 1) - 1) / 2
            DiamCorners(1) = DiamCorners(0) * (Sqrt(SqrSize + 1))
            DiamCorners(2) = DiamCorners(1) + DiamCorners(0) * 2
            DiamCorners(3) = DiamCorners(2) + 2 * DiamCorners(0)

            'Assign Centre Point3D to Diamond Corners
            Points(DiamCorners(0)) = CentrePoint
            Points(DiamCorners(1)) = CentrePoint
            Points(DiamCorners(2)) = CentrePoint
            Points(DiamCorners(3)) = CentrePoint

            '### Call DiamondSquareAlgorithm for each quarter with reduced random range

            'Split into Four Squares

            'Bottom Left
            Dim Square1 As New Point3DCollection((SqrSize / 2) - 1)

            'Bottom Right
            Dim Square2 As New Point3DCollection((SqrSize / 2) - 1)

            'Top Left
            Dim Square3 As New Point3DCollection((SqrSize / 2) - 1)

            'Top Right
            Dim Square4 As New Point3DCollection((SqrSize / 2) - 1)

            'Populate Square 1
            'Bottom Left Square

            'SqrSide=4

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Square1.Add(Points((i * SqrSide) + j))

                Next

            Next

            'Populate Square 2
            'Bottom Right Square

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Square2.Add(Points((i * SqrSide) + j + (SqrSide / 2)))

                Next

            Next

            'Populate Square 3
            'Top Left Square

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Square3.Add(Points(((i + SqrSide / 2) * SqrSide) + j))

                Next

            Next

            'Populate Square 4
            'Top Right Square 

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Square4.Add(Points(((i + SqrSide / 2) * SqrSide) + j + (SqrSide / 2)))

                Next

            Next


            '### Replace each quarter with returned data

            Square1 = DiamondSquareAlgorithm(Square1, RandomRange - 1)
            Square2 = DiamondSquareAlgorithm(Square2, RandomRange - 1)
            Square3 = DiamondSquareAlgorithm(Square3, RandomRange - 1)
            Square4 = DiamondSquareAlgorithm(Square4, RandomRange - 1)

            '### Replace each quarter of whole square with new quarters using loop

            'Populate Square 1
            'Bottom Left Square

            Dim Index As Integer = 0

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Points((i * SqrSide) + j) = Square1(Index)

                    Index = Index + 1

                Next

            Next

            'Populate Square 2
            'Bottom Right Square

            Index = 0

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Points((i * SqrSide) + j + (SqrSide / 2)) = Square2(Index)

                    Index = Index + 1

                Next

            Next

            'Populate Square 3
            'Top Left Square

            Index = 0

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Points(((i + SqrSide / 2) * SqrSide) + j) = Square3(Index)

                    Index = Index + 1

                Next

            Next

            'Populate Square 4
            'Top Right Square 

            Index = 0

            For i = 0 To (SqrSide / 2) - 1

                For j = 0 To (SqrSide / 2) - 1

                    Points(((i + SqrSide / 2) * SqrSide) + j + (SqrSide / 2)) = Square4(Index)

                    Index = Index + 1

                Next

            Next

            '### Return current whole square

            Return Points

        Else

            'MessageBox.Show("4")

            Return PointsColl

        End If

    End Function

I tried testing it with:

    Private Sub AddTerrainBtn_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles AddTerrainBtn.Click

        '### Original Terrain
        Dim Points As New Point3DCollection
        Dim Random As New Random(1234)
        Dim RandomRange As Integer = 99

        'Populate Original Terrain
        For z = 0 To 4

            For x = 0 To 4

                Points.Add(New Point3D(x, Random.Next(0, RandomRange), z))

            Next

        Next

        '### Call DiamondSquareAlgorithm
        Dim TerrainPoints As Point3DCollection = DiamondSquareAlgorithm(Points, RandomRange)

        '### Add Terrain to Viewport

        Dim Mesh As New MeshGeometry3D()
        Dim Material As Material = New DiffuseMaterial(New SolidColorBrush(Colors.DarkKhaki))

        'Add Points
        For i = 0 To TerrainPoints.Count - 1

            Mesh.Positions.Add(TerrainPoints(i))

        Next

        'Add Triangle Indices

        'Terrain Side Length
        Dim SqrSide As Integer = Sqrt(TerrainPoints.Count) - 1

        For i = 0 To SqrSide '[0-4]

            For j = 0 To SqrSide

                Mesh.TriangleIndices.Add((i * SqrSide) + j)
                Mesh.TriangleIndices.Add(((i + 1) * SqrSide) + j)
                Mesh.TriangleIndices.Add((i * SqrSide) + j + 1)
                Mesh.TriangleIndices.Add(((i + 1) * SqrSide) + j)
                Mesh.TriangleIndices.Add((i * SqrSide) + j + 1)
                Mesh.TriangleIndices.Add(((i + 1) * SqrSide) + j + 1)

            Next

        Next

        Dim Model As New GeometryModel3D(Mesh, Material)
        Dim Group As New Model3DGroup()
        Dim ModelV3D As New ModelVisual3D()

        Group.Children.Add(Model)
        ModelV3D.Content = Group
        Me.V.Children.Add(ModelV3D)

    End Sub

But it doesnt seem to be working.