Jump to content
  • Advertisement
Sign in to follow this  
quddusaliquddus

Diamond-Square Algorithm - Need Help

This topic is 3415 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

If you intended to correct an error in the post then please contact us.

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
Advertisement
[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
Sign in to follow this  

  • Advertisement
×

Important Information

By using GameDev.net, you agree to our community Guidelines, Terms of Use, and Privacy Policy.

We are the game development community.

Whether you are an indie, hobbyist, AAA developer, or just trying to learn, GameDev.net is the place for you to learn, share, and connect with the games industry. Learn more About Us or sign up!

Sign me up!