Code archives/Algorithms/Map Generator from roguebasin

This code has been declared by its author to be Public Domain code.

Download source code

Map Generator from roguebasin by Pakz2014
I was reading though the rogue basin map generator descriptions and saw how to do this one.

You could modify the angle step and random draw distance to get other types of maps. I am sure something can be done.

The maps look nice for simple games.

Here is a short video showing a series of maps that get created
http://youtu.be/_4MJHVEr8n8
Graphics 640,480,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Const mapwidth = 39
Const mapheight = 29
Const tilewidth = 16
Const tileheight = 16
Dim map(mapwidth,mapheight)

While KeyDown(1) = False
	Cls
	makemap()
	drawmap()
	Flip
	For i=0 To 1000
		If KeyDown(1) = True Then End
		Delay 1
	Next
Wend
End

Function drawmap()
	Color 255,255,255
	For y = 0 To 29
		For x = 0 To 39
			If map(x,y) = 1 Then
				Rect x*tilewidth,y*tileheight,tilewidth,tileheight,True
			End If
		Next
	Next
End Function

Function makemap()
	For y=0 To mapheight
		For x=0 To mapwidth
			map(x,y) = 0
		Next
	Next
	While ang < 359
		d = Rand(60,200)
		For i=0 To d
			x1 = Cos(ang) * i
			y1 = Sin(ang) * i
			x = mapwidth/2*tilewidth + x1
			y = mapheight/2*tileheight + y1
			x = x / tilewidth
			y = y / tileheight
			drawbrush(x,y)
		Next
		ang = ang + Rand(1,50)
	Wend
End Function

Function drawbrush(x,y)
	x1 = x
	y1 = y - 1
	map(x1,y1) = 1
	x1 = x - 1
	y1 = y
	map(x1,y1) = 1
	x1 = x + 1
	y1 = y
	map(x1,y1) = 1
	x1 = x
	y1 = y + 1
	map(x1,y1) = 1
End Function

Comments

None.

Code Archives Forum