Simple Worm-Algorithm
We created a worm like algorithm in a previous post, here we'll use a similar one to create a simple map on a grid, which will work like this for X loop it will get a random worm length Y and loop it. In that Y loop the worm will get a random direction assigned and whichever tile it goes through will get a fixed Index. That index when our loops end will show as a different color like shown in the image below.
 |
| We can twitch our values to create more of one color or another to fit our needs |
The code that creates the above is the following
Public Sub DrawCanvas()
Dim Z, Q As Integer
Dim WormSteps As Integer
Dim TotalSteps As Integer = 800 '100
Dim StartX, StartY As Integer
Dim Direction As Integer
Dim ColorQN As Integer
Randomize()
For Q = 0 To TotalSteps
StartX = Int(Rnd() * MaxGridX)
StartY = Int(Rnd() * MaxGridY)
ColorQN = Int(Rnd() * 15)
GridWorld(StartX, StartY).ID = ColorQN
WormSteps = Int(Rnd() * 800) '120)
For Z = 0 To WormSteps
Direction = Int(Rnd() * 4)
If Direction = 0 Then
StartY -= 1
ElseIf Direction = 1 Then
StartX += 1
ElseIf Direction = 2 Then
StartY += 1
ElseIf Direction = 3 Then
StartX -= 1
End If
If StartX < 0 Then StartX = 0
If StartX > MaxGridX Then StartX = MaxGridX
If StartY < 0 Then StartY = 0
If StartY > MaxGridY Then StartY = MaxGridY
GridWorld(StartX, StartY).ID = ColorQN
Next
Next
End Sub
Now on drawing it on the canvas, everything under index 4 (5 indexes of color) are drawn blue. And then every 2 indexes drawn with different colors. This is not efficient for large map arrays since the algorithm can be trapped between points and draw the same ones till the loop ends. (You could though add conditions and hold previous direction and grid points to avoid them)
Simple Worm-Algorithm, made better
If we take the algorithm and make more worm steps while having less starting points for worms, let's say total steps = 30 and worm steps = 1200 we should get a different more island-like result.
And if we pass through our tiles, check where water changes to land and paint those tiles with a different color we can get the following.
The steps number (total and worm) can give very different results.
Just for reference I used the following code to render the map.
QRect = New Rectangle(GridWorld(X, Y).X + OffSetX, GridWorld(X, Y).Y + OffSetY, GridWidth, GridWidth)
If GridWorld(X, Y).ID <= 4 Then
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 0, 0, 215)), QRect)
ElseIf GridWorld(X, Y).ID <= 6 Then
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 15, 150, 15)), QRect)
ElseIf GridWorld(X, Y).ID <= 8 Then
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 65, 120, 45)), QRect)
ElseIf GridWorld(X, Y).ID <= 10 Then
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 90, 160, 90)), QRect)
ElseIf GridWorld(X, Y).ID <= 12 Then
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 180, 165, 25)), QRect)
ElseIf GridWorld(X, Y).ID <= 14 Then
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 190, 100, 25)), QRect)
Else
Gs.FillRectangle(New SolidBrush(Color.FromArgb(255, 45, 45, 255)), QRect)
End If
Looped through all grid tiles.
And the new gridmap generation algorithm is the following.
Public Sub DrawCanvas()
Dim Z, Q As Integer
Dim WormSteps As Integer
Dim TotalSteps As Integer = 30 '100
Dim StartX, StartY As Integer
Dim Direction As Integer
Dim ColorQN As Integer
For Z = 0 To MaxGridX
For Q = 0 To MaxGridY
GridWorld(Z, Q).ID = 0
Next
Next
Randomize()
For Q = 0 To TotalSteps
StartX = Int(Rnd() * MaxGridX)
StartY = Int(Rnd() * MaxGridY)
ColorQN = Int(Rnd() * 15)
GridWorld(StartX, StartY).ID = ColorQN
WormSteps = Int(Rnd() * 1200) '120)
For Z = 0 To WormSteps
Direction = Int(Rnd() * 4)
If Direction = 0 Then
StartY -= 1
ElseIf Direction = 1 Then
StartX += 1
ElseIf Direction = 2 Then
StartY += 1
ElseIf Direction = 3 Then
StartX -= 1
End If
If StartX < 0 Then StartX = 0
If StartX > MaxGridX Then StartX = MaxGridX
If StartY < 0 Then StartY = 0
If StartY > MaxGridY Then StartY = MaxGridY
GridWorld(StartX, StartY).ID = ColorQN
Next
Next
Dim ShallowWaterWidth As Integer = 3
For Q = 0 To ShallowWaterWidth
ParseMap()
Next
End Sub
Public Sub ParseMap()
Dim X, Y As Integer
'LOOP HORIZONTAL
For Y = 0 To MaxGridY
For X = 0 To (MaxGridX - 1)
If GridWorld(X, Y).ID <= 4 And GridWorld(X + 1, Y).ID > 4 Then 'Or GridWorld(X, Y).ID <= 4 And GridWorld(X + 1, Y).ID = 15 Then
GridWorld(X, Y).ID = 15
End If
Next
For X = (MaxGridX - 1) To 0 Step -1
If GridWorld(X + 1, Y).ID <= 4 And GridWorld(X, Y).ID > 4 Then 'Or GridWorld(X, Y).ID <= 4 And GridWorld(X + 1, Y).ID = 15 Then
GridWorld(X + 1, Y).ID = 15
End If
Next
Next
'LOOP VERTICAL
For X = 0 To MaxGridX
For Y = 0 To (MaxGridY - 1)
If GridWorld(X, Y).ID <= 4 And GridWorld(X, Y + 1).ID > 4 Then 'Or GridWorld(X, Y).ID <= 4 And GridWorld(X + 1, Y).ID = 15 Then
GridWorld(X, Y).ID = 15
End If
Next
For Y = (MaxGridY - 1) To 0 Step -1
If GridWorld(X, Y + 1).ID <= 4 And GridWorld(X, Y).ID > 4 Then 'Or GridWorld(X, Y).ID <= 4 And GridWorld(X + 1, Y).ID = 15 Then
GridWorld(X, Y + 1).ID = 15
End If
Next
Next
End Sub
Comments
Post a Comment