From the bmax forum - Map generator(s)

Monkey Forums/Monkey Code/From the bmax forum - Map generator(s)

Pakz	(Posted 2016) [#1]

I found this nice thread on the blitz basic site in the blitzmax section. I am reading through the thread :
http://www.blitzbasic.com/Community/posts.php?topic=105827

I converted one source there from Adamstrange to Monkey. I am still studying on how its done. The result I have with the code here is quite nice so far.
I might post more code in this thread later on. There was another map generator that I am
going to be looking at.

Here a video of the results:

Import mojo

Class themap
	Field mapwidth:Int
	Field mapheight:Int
	Field tilewidth:Float
	Field tileheight:Float
	Field map:Float[][]
	Method New(	mapwidth:Int,
				mapheight:Int,
				numpoints:Int)
		Self.mapwidth = mapwidth
		Self.mapheight = mapheight
		tilewidth = DeviceWidth()/Float(mapwidth)
		tileheight = DeviceHeight()/Float(mapheight)
		map = New Float[mapwidth][]
		For Local i = 0 Until mapwidth
            map[i] = New Float[mapheight]
        Next
        addheightmappoints(numpoints)
        For Local i=0 Until numpoints
        expandheightmap
        next
	End Method
	Method expandheightmap()
		For Local n=0 To 100000
			Local x1:Int=Rnd(1,mapwidth-1)
			Local y1:Int=Rnd(1,mapheight-1)
			If map[x1][y1] > 0
				For Local y2=y1-1 To y1+1
				For Local x2=x1-1 To x1+1
					If map[x1][y1] > map[x2][y2]
						map[x2][y2] = 
										(map[x1][y1]+
										map[x2][y2])*Rnd(0.49,0.5)
					End If
				Next
				Next 
			End If
		Next
	End Method
	Method addheightmappoints(count:Int)
		For Local i=0 Until count
			Local x:Int=Rnd(	mapwidth/2-(mapwidth/3),
								mapwidth/2+(mapwidth/3))
			Local y:Int=Rnd(	mapheight/2-(mapheight/3),
								mapheight/2+(mapheight/3))
			map[x][y] = Rnd(64,200)
		Next
	End Method
	Method drawmap()
		For Local y:Float=0 Until mapheight Step 1
		For Local x:Float=0 Until mapwidth Step 1
			SetColor map[x][y],0,0
			DrawRect 	x*tilewidth,
						y*tileheight,
						tilewidth+1,
						tileheight+1
		Next
		Next
	End Method
	Method clearheightmap()
	End Method
End Class

Global mymap:themap 

Class MyGame Extends App
	Field nm:Int
    Method OnCreate()
        SetUpdateRate(60)
        Local date := GetDate()
        Seed = date[5]        
        mymap = New themap(	Rnd(50,150),
        					Rnd(50,150),
        					Rnd(2,20))
    End Method
    Method OnUpdate()        
    	nm+=1
    	If nm>100
    		mymap = New themap(	Rnd(50,150),
    							Rnd(50,150),
    							Rnd(2,20))
    		nm=0
    	End If
    End Method
    Method OnRender()
        Cls 0,0,0 
        mymap.drawmap
        SetColor 255,255,255
		DrawText 	"MonkeyX - Heightmap/"+
					"texture/image generator",
					0,0
    End Method
End Class


Function Main()
    New MyGame()
End Function

Pakz	(Posted 2016) [#2]

Here something I have been working on this morning. Island with desert/connected land or cave.

Here a video of some of the output:

Import mojo

Class themap
	Field mapwidth:Int
	Field mapheight:Int
	Field tilewidth:Float
	Field tileheight:Float
	Field map:Int[][]
	Field cmode:Int=Rnd(1,4)
	Method New(	mapwidth:Int,
				mapheight:Int)
		Self.mapwidth = mapwidth
		Self.mapheight = mapheight
		tilewidth = Float(DeviceWidth())/Float(mapwidth)
		tileheight = Float(DeviceHeight())/Float(mapheight)	
		map = New Int[mapwidth][]
		For Local i = 0 Until mapwidth
			map[i] = New Int[mapheight]
		Next
		map[mapwidth/2][mapheight/2] = 255
		For Local i=0 To (mapwidth*mapheight)/4
		placeblock
		Next
		mapblur
	End Method
	Method mapblur()
		For Local i=0 To mapwidth*mapheight
			Local x1:Int=Rnd(2,mapwidth-4)
			Local y1:Int=Rnd(2,mapheight-4)
			If map[x1][y1] > 0
				For Local y2=y1-1 To y1+1
				For Local x2=x1-1 To x1+1
					If map[x2][y2] = 0
						map[x2][y2] = map[x1][y1] / 2
					End If
				Next
				Next
			End If
		Next
	End Method
	Method placeblock()
		Local x:Int=Rnd(0,mapwidth)
		Local y:Int=Rnd(0,mapheight)
		Local fitsx:Int=Rnd(3,12)
		Local fitsy:Int=Rnd(3,12)
		If Rnd(0,10) < 2 Then
			If Rnd(1,3) = 1
				fitsx = Rnd(6,22)				
				fitsy = 3
			Else
				fitsy = Rnd(6,22)
				fitsx = 3
			End If
		End If
		If mapfit(x,y,fitsx,fitsy) = True
			fitmap(x,y,fitsx,fitsy)
		End If
		
	End Method
	Method fitmap(x:Int,y:Int,w:Int,h:Int)
		For Local y2 = y Until y+h
		For Local x2 = x Until x+w
			map[x2][y2] = 255
		Next
		Next		
	End Method
	Method mapfit:Bool(x:Int,y:Int,w:Int,h:Int)
		If x+w > mapwidth-3 Then Return False
		If y+h > mapheight-3 Then Return False
		If x<3 Then Return False
		If y<3 Then Return False
		For Local y2 = y Until y+h
		For Local x2 = x Until x+w
			If map[x2][y2] > 0 Then Return False
		Next
		Next
		For Local y2 = y+1 Until y+h-1
			If map[x-1][y2] > 0 Then Return True
			If map[x+w][y2] > 0 Then Return True
		Next		
		For Local x2 = x+1 Until x+w-1
			If map[x2][y-1] > 0 Then Return True
			If map[x2][y+h] > 0 Then Return True
		Next
		End Method
	Method draw()
		For Local y:Float=0 Until mapheight Step 1
		For Local x:Float=0 Until mapwidth Step 1
			If map[x][y] > 0
			Local d:Int = distance(x,y,320,240)
			d = d / 2.5		
			SetColor map[x][y],d,0
			DrawRect	x*tilewidth,
						y*tileheight,
						tilewidth+1,
						tileheight+1
			End If
		Next
		Next
	End Method
End Class

Global mymap:themap

Class MyGame Extends App
	Field refresh:Int
    Method OnCreate()
        SetUpdateRate(60)
        mymap = New themap(100,100)
    End Method
    Method OnUpdate()
    	refresh+=1
    	If refresh>120
    	    mymap = New themap(Rnd(100,200),Rnd(100,200))
    		refresh=0
    	Endif        
    End Method
    Method OnRender()
        Cls 0,0,0 
        SetColor 255,255,255
        mymap.draw
    End Method
End Class


Function Main()
    New MyGame()
End Function

Function distance:Int(x1:Int,y1:Int,x2:Int,y2:Int)
    Return Abs(x2-x1)+Abs(y2-y1)
End Function

Pakz	(Posted 2016) [#3]

Here something else I made after looking through code from the blitzmax thread.

It creates red clouds using the drunken walk algorithm.

Import mojo

Class themap
    Field map:Int[][]
    Field mapwidth:Int
    Field mapheight:Int
    Field tilewidth:Float
    Field tileheight:Float
    Method New(    mapwidth:Int,
                mapheight:Int)
        tilewidth = DeviceWidth()/Float(mapwidth)
        tileheight = DeviceHeight()/Float(mapheight)
        Self.mapwidth = mapwidth
        Self.mapheight = mapheight
        map = New Int[mapwidth][]
           For Local i = 0 Until mapwidth
            map[i] = New Int[mapheight]
        Next
        makemap        
    End Method
    Method makemap()
        Local x:Int=mapwidth/2
        Local y:Int=mapheight/2
        Local dx:Int[]=[0,1,0,-1]
        Local dy:Int[]=[-1,0,1,0]
        For Local i=0 To mapwidth*mapheight
              Local m : Int = map[x][y]+16
              If m>255 Then m=255 
            map[x][y] = m 
            Local d:Int=Rnd(0,4)
            x+=dx[d]
            y+=dy[d]
              If     x<1 Or y<1 Or 
                  x>mapwidth-3 Or 
                  y>mapheight-3 Then 
                  x=mapwidth/2 
                  y=mapheight/2 
              End If
        Next        
    End Method
    Method draw()
        For Local y=0 Until mapheight
        For Local x=0 Until mapwidth
            Local col:Int=map[x][y]    
            If col > 0        
                SetColor col,0,0
                DrawRect     x*tilewidth,
                            y*tileheight,
                            tilewidth+1,
                            tileheight+1
            end if
        Next
        Next
    End Method
End Class

Global mymap:themap

Class MyGame Extends App
	Field cnt:Int
    Method OnCreate()
        SetUpdateRate(1)
        Local date := GetDate()
        Seed = date[5]
        mymap = New themap(320,256)
    End Method
    Method OnUpdate() 
    	cnt+=1       
        If 	KeyHit(KEY_SPACE) = True Or
        	cnt>2 Then
            mymap = New themap(320,356)
            cnt=0
        End If
    End Method
    Method OnRender()
        Cls 0,0,0 
        mymap.draw
        SetColor 255,255,255
        DrawText     "Monkey-X - Red Clouds Example.",
                    0,0
        DrawText "Press Space to Render new",0,20
    End Method
End Class


Function Main()
    New MyGame()
End Function

Here a slightly different version. Here there is a extra pass to make it blurry.

Import mojo

Class themap
	Field map:Int[][]
	Field mapwidth:Int
	Field mapheight:Int
	Field tilewidth:Float
	Field tileheight:Float
	Method New(	mapwidth:Int,
				mapheight:Int)
		tilewidth = DeviceWidth()/Float(mapwidth)
		tileheight = DeviceHeight()/Float(mapheight)
		Self.mapwidth = mapwidth
		Self.mapheight = mapheight
		map = New Int[mapwidth][]
       	For Local i = 0 Until mapwidth
        	map[i] = New Int[mapheight]
        Next
        makemap		
	End Method
	Method makemap()
		Local x:Int=mapwidth/2
		Local y:Int=mapheight/2
		Local dx:Int[]=[0,1,0,-1]
		Local dy:Int[]=[-1,0,1,0]
		For Local i=0 To mapwidth*mapheight
  			Local m : Int = map[x][y]+16
  			If m>255 Then m=255 
			map[x][y] = m 
			Local d:Int=Rnd(0,4)
			x+=dx[d]
			y+=dy[d]
  			If 	x<1 Or y<1 Or 
  				x>mapwidth-3 Or 
  				y>mapheight-3 Then 
  				x=mapwidth/2 
  				y=mapheight/2 
  			End If
		Next
		For Local y1=1 Until mapheight-1
		For Local x1=1 Until mapwidth-1
			Local mv:Int
			For Local y2=-1 To 1
			For Local x2=-1 To 1
				map[x1+x2][y1+y2] =
				(map[x1][y1] +
				map[x1+x2][y1+y2]) / 2
			Next
			Next 
		Next
		Next
	End Method
	Method draw()
		For Local y=0 Until mapheight
		For Local x=0 Until mapwidth
			Local col:Int=map[x][y]	
			If col > 0		
				SetColor col,0,0
				DrawRect 	x*tilewidth,
							y*tileheight,
							tilewidth+1,
							tileheight+1
			end if
		Next
		Next
	End Method
End Class

Global mymap:themap

Class MyGame Extends App
	Field cnt:Int
    Method OnCreate()    	
        SetUpdateRate(1)
        Local date := GetDate()
        Seed = date[5]
        mymap = New themap(320,240)
    End Method
    Method OnUpdate()
    	cnt+=1        
    	If KeyHit(KEY_SPACE) = True Or
    		cnt>2 Then
    		mymap = New themap(320,240)
    		cnt=0
    	End If
    End Method
    Method OnRender()
        Cls 0,0,0 
        mymap.draw
        SetColor 255,255,255
        DrawText 	"Monkey-X - Red Clouds Example.",
        			0,0
        DrawText 	"Press Space to Render new or wait "+
        			"2 secs",0,20
    End Method
End Class


Function Main()
    New MyGame()
End Function