Sign in to follow this  
quddusaliquddus

Diamond-Square Algorithm - Need Help

Recommended Posts

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

Share this post


Link to post
Share on other sites
[Source]
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)

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 Function

End Class
[/Source]

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

Sign in to follow this