Code archives/Algorithms/Map Generator from roguebasin
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
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