This code was inspired by the following video: https://www.youtube.com/watch?v=slTEz6555Ts
Code: Select all
Randomize Timer
Dim Shared As Integer Land
Land=1
Dim Shared As Integer Water
Water=0
Function Bounds(MapWidth As Integer, MapHeight As Integer, xPos As Integer, yPos As Integer) As Integer
Dim As Integer iReturn=0
If xPos<1 Or xPos>MapWidth Then iReturn=1
If yPos<1 Or yPos>MapHeight Then iReturn=1
Return iReturn
End Function
Sub NoiseGrid(MapWidth As Integer, MapHeight As Integer, iGrid() As Integer, Density As Integer)
Dim tRandom As Integer
For i As Integer=1 To MapHeight-1
For j As Integer=1 To MapWidth-1
If Int(99*Rnd)+1>Density Then iGrid(i, j)=Water Else iGrid(i, j)=Land
Next
Next
End Sub
Sub Automaton(iWidth As Integer, iHeight As Integer, iGrid() As Integer, iCount As Integer)
Dim Neighbor As Integer
Dim tGrid(iWidth, iHeight) As Integer
For t As Integer=1 to iCount
For y As Integer=1 To iHeight
For x As Integer=1 To iWidth
tGrid(x, y)=iGrid(x, y)
tGrid(x, y)=iGrid(x, y)
Next
Next
For j As Integer=1 To iHeight
For k As Integer=1 to iWidth
Neighbor=0
For y As Integer=j-1 to j+1
For x As Integer=k-1 to k+1
If Bounds(iWidth, iHeight, x, y)=0 Then
If y<>j or x<>k Then
If tGrid(x,y)=Land Then Neighbor=Neighbor+1
EndIf
Else
Neighbor=Neighbor+1
EndIf
If Neighbor>4 Then iGrid(j, k)=Land Else iGrid(j, k)=Water
Next
Next
Next
Next
Next
End Sub
Sub ShowGrid(iWidth As Integer, iHeight As Integer, iGrid() As Integer)
For y As Integer=0 To iHeight-1
For x As Integer=0 To iWidth-1
If iGrid(x, y)=Water Then PSet(x, y), RGB(0, 0, 0)
If iGrid(x, y)=Land Then PSet(x, y), RGB(255, 255, 255)
Next
Next
End Sub
Dim Touch As String
Dim As Integer Density=60
Dim As Integer Count=10
Dim As Integer MapWidth=320
Dim As Integer MapHeight=240
ScreenRes(MapWidth, MapHeight, 32)
Dim Map(MapWidth, MapHeight) As Integer
NoiseGrid MapWidth, MapHeight, Map(), Density
Automaton MapWidth, MapHeight, Map(), Count
ShowGrid MapWidth, MapHeight, Map()
While (1)
Touch=InKey
If Touch=Chr(27) Then End
If Touch="c" Then Count=Count+1
If Touch="C" Then Count=Count+1
If Touch="d" Then Density=Density-1
If Touch="D" Then Density=Density+1
If UCase(Touch)="C" Or UCase(Touch)="D" Then
NoiseGrid 320, 240, Map(), Density
Automaton 320, 240, Map(), Count
ScreenLock
ShowGrid MapWidth, MapHeight, Map()
ScreenUnLock
EndIf
Sleep 1,1
Wend