🔒 Locked

Diamond-Square Algorithm - Need Help

Started by quddusaliquddus Jun 8, 2009 at 5:40 PM 1 replies 2.2k views

Original Post

Jun 8, 2009 at 5:40 PM

Hi :D, I am trying to implement the Diamond-Square Algorithm in VB.NET. I am stuck on how to end the code and what to return So far I have this: Function DiamondSquare(ByVal PointsColl As Point3DCollection, ByVal R As Integer) As Point3DCollection 'Variables Dim SquareSize As Integer = Sqrt(PointsColl.Count) 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).Y + PointsColl(SqrCorner2).Y + PointsColl(SqrCorner3).Y + PointsColl(SqrCorner4).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 Point3DCollection '((SquareSize/2)-1) Dim Square2 As Point3DCollection '((SquareSize/2)-1) Dim Square3 As Point3DCollection '((SquareSize/2)-1) Dim Square4 As Point3DCollection '((SquareSize/2)-1) 'Populate Square 1 Dim Index As Integer = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 Square1(Index) = PointsColl((i * SquareSize) + j) Index = Index + 1 Next Next 'Populate Square 2 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 Square2(Index) = PointsColl((i * SquareSize) + j + (SquareSize / 2)) Index = Index + 1 Next Next 'Populate Square 3 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 Square3(Index) = PointsColl(((i + SquareSize / 2) * SquareSize) + j) Index = Index + 1 Next Next 'Populate Square 4 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 Square4(Index) = PointsColl(((i + SquareSize / 2) * SquareSize) + j + (SquareSize / 2)) Index = Index + 1 Next Next 'Call function for each Quarter Square Square1 = DiamondSquare(Square1, R - 1) Square2 = DiamondSquare(Square2, R - 1) Square3 = DiamondSquare(Square3, R - 1) Square4 = DiamondSquare(Square4, R - 1) 'Replace Square Values in PointsColl 'Retrieve Square1 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 PointsColl((i * SquareSize) + j) = Square1(Index) Index = Index + 1 Next Next 'Retrieve Square2 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 PointsColl((i * SquareSize) + j + (SquareSize / 2)) = Square1(Index) Index = Index + 1 Next Next 'Retrieve Square3 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 PointsColl(((i + SquareSize / 2) * SquareSize) + j) = Square1(Index) Index = Index + 1 Next Next 'Retrieve Square4 Index = 0 For i = 0 To (SquareSize / 2) - 1 For j = 0 To (SquareSize / 2) - 1 PointsColl(((i + SquareSize / 2) * SquareSize) + j + (SquareSize / 2)) = Square1(Index) Index = Index + 1 Next Next End Function Thanks for taking the time to read this post. Regards Q

harveypekar

Jun 9, 2009 at 7:39 AM

Please your source tags, some people (including me, but that may be vb :)) find it a bit unreadable.

quddusaliquddus

Jun 9, 2009 at 10:26 AM

[Source]Imports System.Windows.Media.Media3DImports System.Math'http://gameprogrammer.com/fractal.htmlClass 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)        Dim Index As Integer = 0        For z = 0 To 3            For x = 0 To 3                PointList.Add(New Point3D(x, Index, z))                Index = Index + 1            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            Square1 = DiamondSquare(Square1, R - 1)            Square2 = DiamondSquare(Square2, R - 1)            Square3 = DiamondSquare(Square3, R - 1)            Square4 = DiamondSquare(Square4, R - 1)            'Populate PointsColl from Square 1            PointsColl.Item(0) = Square1.Item(0)            PointsColl.Item(1) = Square1.Item(1)            PointsColl.Item(2) = Square1.Item(2)            PointsColl.Item(3) = Square1.Item(3)            'Populate PointsColl from Square 2            PointsColl.Item(4) = Square2.Item(0)            PointsColl.Item(5) = Square2.Item(1)            PointsColl.Item(6) = Square2.Item(2)            PointsColl.Item(7) = Square2.Item(3)            'Populate PointsColl from Square 3            PointsColl.Item(8) = Square3.Item(0)            PointsColl.Item(9) = Square3.Item(1)            PointsColl.Item(10) = Square3.Item(2)            PointsColl.Item(11) = Square3.Item(3)            'Populate PointsColl from Square 4            PointsColl.Item(12) = Square4.Item(0)            PointsColl.Item(13) = Square4.Item(1)            PointsColl.Item(14) = Square4.Item(2)            PointsColl.Item(15) = Square4.Item(3)                        Return PointsColl        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 FunctionEnd Class[/Source]

Topic Locked

This topic has been locked by a moderator. New replies are not allowed.