Random Map Generators.

[Agamemnus]

Hello,

I already know a few methods of generating random maps, but if you have any knowledge in this regard, I'd like you to share it on this thread. I want to create a data base along with tutorials written in easy to understand English for random map generators.

Maps can be 2D or 3D. The minimum is that they are 2D and have at least 2 elements. (water/land, etc)

I didn't know whether to post this in QB programming, general non QB programming, or FB programming, so I'm posting this here. The language of implementation doesn't need to be QB/FB but it's preferrable. A description of the generator is also preferrable.

Thanks..

[speedlemon]

http://www.geocities.com/andrewsqbpage/RDG.BAS

[KiZ]

Fractals are an excellent way of generating random maps.

In fact, here is a great tut on it:
http://www.gameprogrammer.com/fractal.html

[Zack]

Why not just generate a random number 0 or 1, and then if it's 0 , it's a water tile, if it's 1, is a land tile? You could work it out to enhance the probability of water/land.

[KiZ]

Why not just generate a random number 0 or 1, and then if it's 0 , it's a water tile, if it's 1, is a land tile? You could work it out to enhance the probability of water/land.

That would just create random "static" which would make an appauling map.

[na_th_an]

Me and my pal used a very simple approach.

Get your map covered with water.

Then set a few random "seeds". Each seeds performs a 4-way flood-fill which is limited by two parameters: a maximum radius and a random condition. That way, each seed expands until it gets a maximum radius or when the condition is true. You get nice irregular islands.

[Zack]

Why not just generate a random number 0 or 1, and then if it's 0 , it's a water tile, if it's 1, is a land tile? You could work it out to enhance the probability of water/land.

That would just create random "static" which would make an appauling map.

Yeah, I see what you mean...like PSETing a screen randomly with random colours.
Nathan's suggestion sounds cool...I'm going to try that.

[Ryan]

I used a system of setting the land tiles (regular grass, trees, rocks, etc.) at random and then dropping in a preset lake and village on top of it all. It worked well for the game, though I can't recommend it for everything. I also made a random dungeon generator to create maps like the original Rogue game, but as it's dungeons and not land/water I won't post it. It's available at FBTK.net.

[Dr_Davenstein]

I made something similar to this for a QB game a couple of years back. It just creates a bunch of random circles, gives each a random position within the screen boundary, set's an up/down attribute to each one and scans x/y down the screen to see if the current pixel is within the bounds of any of the circles. If it is, then it either increments, or decrements the current green value and adds a small random brown color to make it kind of look like trees. When the green value gets below a certain point, it changes the color to a blue tint to make it kind of look like water. Finally, it runs a gaussian blur routine on the buffer to make it look a little better. I'll probably make an ogl thing with it for fun.

Code:

#Include "Fbgfx.bi"
Option Explicit
Randomize Timer

Const False As Integer = 0
Const True As Integer = Not False
Const Cir_Cnt As Integer = 150
Const SCR_WIDTH As Integer = 640
Const SCR_HEIGHT As Integer = 480
Const BPP As Integer = 32

Screenres SCR_WIDTH, SCR_HEIGHT, BPP,, 1

Setmouse 0,0,0

Type Point2D
    X As Integer
    Y As Integer
End Type


Type Circles
    P As Point2d
    Rad As Integer
    Hill_Hole As Byte
End Type


Declare Function Vec_2D_Dist(vA As Point2D, vB As Point2D) As Single
Declare Sub Copy_Pixels( Buffer() As Integer )
Declare Sub Blur_Buffer( Buffer() As Integer, Strength As Integer )

Dim As Circles Cir(CIR_CNT)
Dim As Integer i, X, Y, R, G, B, First_Loop, Buffer(SCR_WIDTH, SCR_Height)
Dim As Single Dist
Dim As Point2D tVec


Locate 1,1:Print "Building landscape. Please wait..."

Do
    
    For i= 0 To Ubound(Cir)
        Cir(i).P.X = Rnd*SCR_WIDTH
        Cir(i).P.Y = Rnd*SCR_HEIGHT
        Cir(i).Rad = 25+(Rnd*100)        
        Select Case Int(Rnd*2)
        Case 0
            Cir(i).Hill_Hole = 1
        Case 1
            Cir(i).Hill_Hole = -1
        End Select
    Next
    
    
    For Y = 0 To SCR_HEIGHT-1
        For X = 0 To SCR_WIDTH-1
            tVec.Y = Y
            tVec.X = X
            R = 0
            G = 128
            B = 0
            For i = 0 To Ubound(Cir)
                Dist = Vec_2D_Dist( Cir(i).P, tVec )
                If Dist<=Cir(i).Rad Then
                    G += (((Cir(i).Rad-Dist)-Int(Rnd*3))*Cir(i).Hill_Hole)
                End If
            Next
            
            If G<0 Then G=0
            If G>255 Then G=255
            
            If G<=68 And G>=64 Then
                R = 128
                G = 128
                B = 255
            End If
            
            If G<64 Then
                B = G+Int(Rnd*64)
                R = 0
                G = 0
            End If
            
            If Int(Rnd*2)=0 Then
                If B<G Then
                    G/=1.75
                    R=G/2.042553191489362
                    B=G/5.05263157894737
                End If
            End If
            
            Buffer(X,Y) = Rgb(R, G, B)
            
            If Multikey(Sc_Escape) Then End
        Next
    Next
    
    Blur_Buffer Buffer(), 1
Loop Until Multikey(Sc_Escape)


Sleep
End



Sub Blur_Buffer( Buffer() As Integer, Strength As Integer )
    Dim As Integer X, Y, X1, Y1, Col, Hits, R, G, B
    
    For Y = 0 To SCR_HEIGHT
        For X = 0 To SCR_WIDTH
            R=0
            G=0
            B=0
            Hits = 0
            For Y1 = Y-Strength To Y+Strength
                For X1 = X-Strength To X+Strength
                    If X1>=0 And Y1>=0 And X1<SCR_WIDTH And Y1<SCR_HEIGHT Then
                        R+= ((Buffer(X1, Y1) Shr 16) And &HFF)
                        G+= ((Buffer(X1, Y1) Shr 8 ) And &HFF)
                        B+= ((Buffer(X1, Y1) Shr 0 ) And &HFF)
                        Hits+=1
                    End If
                Next
            Next
            If Hits=0 Then Hits=1
            R\=Hits
            G\=Hits
            B\=Hits
            Pset(X,Y), Rgb( R,G,B )
            
        Next
    Next
    
    Copy_Pixels Buffer()
End Sub


Sub Copy_Pixels( Buffer() As Integer )
    Dim As Integer X, Y, Col
    
    For Y = 0 To SCR_HEIGHT
        For X = 0 To SCR_WIDTH
            Buffer(X,Y) = Point(X,Y)
        Next
    Next
End Sub


Function Vec_2D_Dist(vA As Point2D, vB As Point2D) As Single
    Dim DX As Single, _
    DY As Single ,_
    Dist As Single
    
    DX = Va.X - Vb.X
    DY = Va.Y - Vb.Y
    Dist = Sqr(DX^2 + DY^2)
    Function = Dist
End Function

[Agamemnus]

Interesting.

Here's what I have (FB). You can adjust the "so>x" values to get different results.

Code:

defint a-z
screen 12: cls: randomize 1

'<----- extra for larger map view
dim ps, offsetx, offsety
ps = 2
offsetx = 64
offsety = 64
'<-----


dim mmx, mmy, mapMaxX_x_pixelSize, mapMaxY_x_pixelSize
mmx = 128
mmy = 128

mmxps = (mmx + 1) * ps 'extra for larger map view

DIM map1(0 TO (mmx+2)*(mmy+2)-1)
DIM map2(0 TO (mmx+2)*(mmy+2)-1)

for i = 0 to (mmx+2)*(mmy+2)-1
map1(i) = INT(RND*2)
map2(i) = INT(RND*2)
next i

dim mapcolor(0 TO 1): mapcolor(0) = 2: mapcolor(1) = 1

do
if mapswitch = 1 then
mapswitch = 0: gosub resolve_edges1
else
mapswitch = 1: gosub resolve_edges2
end if
gosub drawmap
ma = 0
for x1 = 1 to mmx
for y1 = 1 to mmy
i = x1 + y1 * (mmx + 2)

so = 0
if mapswitch = 1 then
n = map2(i)
if map1(i + 1) = n THEN so = so + 1
if map1(i - 1) = n THEN so = so + 1
if map1(i + mmx + 2) = n THEN so = so + 1
if map1(i - mmx - 2) = n THEN so = so + 1
if map1(i + 3 + mmx) = n THEN so = so + 1
if map1(i + 1 + mmx) = n THEN so = so + 1
if map1(i - 1 - mmx) = n THEN so = so + 1
if map1(i - 3 - mmx) = n THEN so = so + 1
if so > 3 then map2(i) = 1 - map2(i): ma = ma+1
else
n = map1(i)
if map2(i + 1) = n THEN so = so + 1
if map2(i - 1) = n THEN so = so + 1
if map2(i + mmx + 2) = n THEN so = so + 1
if map2(i - mmx - 2) = n THEN so = so + 1
if map2(i + 3 + mmx) = n THEN so = so + 1
if map2(i + 1 + mmx) = n THEN so = so + 1
if map2(i - 1 - mmx) = n THEN so = so + 1
if map2(i - 3 - mmx) = n THEN so = so + 1
if so > 4 then map1(i) = 1 - map1(i): ma = ma + 1
end if
next y1, x1

'if inkey$ <>"" then exit do
cycle&=cycle&+1
if cycle&>20 then exit do
loop
if mapswitch = 0 then gosub resolve_edges1 else gosub resolve_edges2
gosub drawmap
sleep

system

resolve_edges1:
for y = 1 to mmy
map1(0+y*(mmx + 2)) = map1(mmx+y*(mmx+2))
map1(mmx+1+y*(mmx+2)) = map1(1+y*(mmx+2))
next y
for x = 1 to mmy
map1(x) = map1(x+mmy*(mmx+2))
map1(x+(mmy+1)*(mmx+2)) = map1(x+mmx+2)
next x
map1(0) = map1(mmx+mmy*(mmx+2))
map1(mmx+1+(mmy+1)*(mmx+2)) = map1(1+mmx+2)
map1(mmx) = map1(1+mmy*(mmx+2))
map1(mmy*(mmx+2)) = map1(mmx+mmx+2)
return

resolve_edges2:
for y = 1 to mmy
map2(0+y*(mmx +2)) = map2(mmx+y*(mmx+2))
map2(mmx+1+y*(mmx+2)) = map2(1+y*(mmx+2))
next y
for x = 1 to mmy
map2(x) = map2(x+mmy*(mmx+2))
map2(x+(mmy+1)*(mmx+2)) = map2(x+mmx+2)
next x
map2(0) = map2(mmx+mmy*(mmx+2))
map2(mmx+1+(mmy+1)*(mmx+2)) = map2(1+mmx+2)
map2(mmx) = map2(1+mmy*(mmx+2))
map2(mmy*(mmx+2)) = map2(mmx+mmx+2)
return

drawmap:
for x = 1 to mmx
for y = 1 to mmy
i = x + y * (mmx+2)

'if map2(i) = 1 then
'pset (x, y), mapcolor(1)
'else
'pset (x, y), mapcolor(0)
'end if

offsetx2 = x * ps + offsetx
offsety2 = mmxps - y * ps + offsety
line (offsetx2, offsety2)-(offsetx2 + ps, offsety2 + ps), mapcolor(map2(i)), bf


next x, y
return