Working on Random Map Generation
I just recently made a program that draws a costal atoll style map. it is just ansi art right now and the colours mean that i am using mostly the same char for water and such, anyone who wants to try and make it faster also just fell free to post the faster version in the comments.
Source Code
In the public domain, do what you like with it:
Module Module1
Dim teraindata(,) As Char ‘ Terrain stored Here
Dim mapw As Integer ‘ Dimensions of the map
Dim maph As Integer
Dim rand As New Random
Dim curlocx As Integer
Dim curlocy As Integer
Dim direction As Integer
Dim directionold As Integer
Dim directon1 As Integer
Dim directon2 As Integer
Dim count As Integer
Dim citycount As Integer
Dim watercount As Integer
Sub Main()
Console.Title = "Vbitz’s Map Genorator"
Console.WindowHeight = Console.LargestWindowHeight
Console.WindowWidth = Console.LargestWindowWidth
Console.WindowLeft = 0
Console.WindowTop = 0
ReDim Preserve teraindata(Console.WindowHeight – 4, Console.WindowWidth – 2)
maph = teraindata.GetLength(0) – 1
mapw = teraindata.GetLength(1) – 1
clearmap()
makegrass()
makewater()
‘rendermap()
‘writecitys()
rendermap()
Console.ReadKey()
End Sub
Sub clearmap()
For x = 0 To maph
For y = 0 To mapw
teraindata(x, y) = "0"
Next
Next
End Sub
Sub makegrass()
Console.WriteLine("Grass Genoration Started")
Do Until count > 509
curlocx = rand.Next(1, maph)
curlocy = rand.Next(1, mapw)
For x = 0 To 1000000
teraindata(curlocx, curlocy) = "H"
getdirection()
movepointer()
Next
count = count + 1
writecount()
Loop
End Sub
Sub rendermap()
Console.ForegroundColor = ConsoleColor.White
‘writecount()
Console.WriteLine()
For x = 0 To maph
For y = 0 To mapw
Select Case teraindata(x, y)
Case "H"
Console.ForegroundColor = ConsoleColor.Green
Case "0"
Console.ForegroundColor = ConsoleColor.DarkRed
Case "*"
Console.ForegroundColor = ConsoleColor.White
Case "-"
Console.ForegroundColor = ConsoleColor.Gray
Case "#"
Console.ForegroundColor = ConsoleColor.Blue
End Select
Console.Write(teraindata(x, y))
Next
Console.WriteLine()
Next
End Sub
Sub getdirection()
Do
directon1 = rand.Next(1, 10000)
directon2 = rand.Next(1, 10000)
direction = directon1 / directon2
direction = Math.Round(direction)
Loop Until direction < 5
End Sub
Sub movepointer()
If direction = directionold = False Then
directionold = direction
Select Case direction
Case 1
‘up
If curlocx = 0 = False Then
curlocx = curlocx – 1
End If
Case 2
‘down
If curlocx = maph = False Then
curlocx = curlocx + 1
End If
Case 3
‘left
If curlocy = 0 = False Then
curlocy = curlocy – 1
End If
Case 4
‘right
If curlocy = mapw = False Then
curlocy = curlocy + 1
End If
End Select
End If
End Sub
Sub writecount()
Console.WriteLine("Current Interation : " + count.ToString)
End Sub
Sub writecitys()
Dim trys As Integer = 0
Console.WriteLine("City Genoration Started")
citycount = 0
Do
curlocx = rand.Next(1, maph)
curlocy = rand.Next(1, mapw)
If teraindata(curlocx, curlocy) = "H" Then
If teraindata(curlocx, curlocy) = "#" = False Then
If checkforcity() = False Then
teraindata(curlocx, curlocy) = "*"
citycount = citycount + 1
Else
‘Console.WriteLine("Try: " + trys.ToString)
trys = trys + 1
End If
End If
End If
Loop Until citycount > 63 ‘ Number of Cities Here
End Sub
Function checkforcity() As Boolean
Dim temp1 As Integer
For x = 0 To maph
For y = 0 To mapw
If teraindata(x, y) = "*" Then
temp1 = x – curlocx
temp1 = temp1 + (y – curlocy)
‘Console.WriteLine(x.ToString + ", " + y.ToString)
‘Console.WriteLine(temp1)
‘rendermap()
‘Console.ReadKey()
If temp1 > 8 And temp1 > 0 Then
ElseIf temp1 < -8 And temp1 < 0 Then
Else
Return True
End If
End If
Next
Next
Return False
End Function
Sub buildroads()
For x = 0 To maph
For y = 0 To mapw
If teraindata(x, y) = "*" Then
curlocx = x
curlocy = y
makeroad()
End If
Next
Next
End Sub
Sub makeroad()
End Sub
Sub makewater()
Console.WriteLine("Water Genoration Started")
count = 0
Do Until count > 39
curlocx = rand.Next(1, maph)
curlocy = rand.Next(1, mapw)
For x = 0 To 10000
teraindata(curlocx, curlocy) = "#"
getdirection()
movepointer()
Next
‘Console.WriteLine("Count: " + count.ToString)
count = count + 1
Loop
End Sub
End Module
WARNING: It will take a very long time to run
