This is code for a 2d dungeon generator. It makes maps with 1 to 5 rooms connected with doors. It is the first time I tried to make it so the code might be somewhat long for what it does.
Code below :
Import mojo
Const screenwidth:Int=640
Const screenheight:Int=480
Global tilewidth:Int=16
Global tileheight:Int=16
Global mapwidth:Int=40
Global mapheight:Int=30
Const isnothing:Int=0
Const iswall:Int=1
Const isfloor:Int=2
Const isdoor:Int=3
Const minroomw:Int=5
Const minroomh:Int=5
Const maxroomw:Int=10
Const maxroomh:Int=10
Global map:Int[mapwidth][]
Global rcount:Int=0
Class MyGame Extends App
Method OnCreate()
SetUpdateRate(60)
Seed = Millisecs()
For Local i = 0 Until mapwidth
map[i] = New Int[mapheight]
Next
createmap(Rnd(1,6))
End Method
Method OnUpdate()
rcount+=1
Local exitloop=False
If KeyHit(KEY_SPACE) Or rcount > 140 Then
createmap(Rnd(1,6))
rcount=0
End If
End Method
Method OnRender()
Cls 0,0,0
SetColor 255,255,255
DrawText "Generates dungeons with 1 to 5 rooms",0,0
drawmap
End Method
End Class
Function createmap:Bool(numrooms:Int)
Local succes:Bool=False
Seed = Millisecs()
If numrooms<1 Then numrooms=1
If numrooms>5 Then numrooms=4
While succes = False
For Local y=0 Until mapheight
For Local x=0 Until mapwidth
map[x][y] = isnothing
Next
Next
Local startx:Int=mapwidth/2-5
Local starty:Int=mapheight/2-5
Local roomw:Int=Rnd(minroomw,maxroomw)
Local roomh:Int=Rnd(minroomh,maxroomh)
makeroom(startx,starty,roomw,roomh)
If numrooms = 1 Then Return True
Local roomcount:Int=1
Local l1:Bool=False
Local r1:Bool=False
Local u1:Bool=False
Local d1:Bool=False
While roomcount < numrooms
If Rnd(10)<2 And roomcount<numrooms And r1=False Then makedoor("right",startx,starty,roomw,roomh) ; roomcount+=1 ; r1=True
If Rnd(10)<2 And roomcount<numrooms And l1=False Then makedoor("left",startx,starty,roomw,roomh) ; roomcount+=1;l1=True
If Rnd(10)<2 And roomcount<numrooms And u1=False Then makedoor("up",startx,starty,roomw,roomh) ; roomcount+=1 ; u1=True
If Rnd(10)<2 And roomcount<numrooms And d1=False Then makedoor("down",startx,starty,roomw,roomh) ; roomcount+=1;d1=True
Wend
Local doorfound=False
Local x1:Int
Local y1:Int
roomcount=1
Local cnt:Int=0
While roomcount<numrooms
x1=Rnd(mapwidth)
y1=Rnd(mapheight)
If map[x1][y1] = isdoor Then
If makeroomondoor(x1,y1) = True Then roomcount+=1
End If
cnt+=1
If cnt>1000 Then Exit
Wend
If cnt>1000 Then succes=False Else succes = true
Wend
End Function
Function makeroomondoor:Bool(x:Int,y:Int)
Local makeroom:Bool=False
Local cnt:Int=0
Local x1:Int
Local y1:Int
Local w1:Int
Local h1:Int
Local facing:String
If map[x-1][y]=isnothing Then facing = "left"
If map[x+1][y]=isnothing Then facing = "right"
If map[x][y-1]=isnothing Then facing = "up"
If map[x][y+1]=isnothing Then facing = "down"
While cnt<100
w1 = Rnd(minroomw,maxroomw)
h1 = Rnd(minroomh,maxroomh)
x1=-1
Select facing
Case "left"
x1=x-w1
y1=y-Rnd(h1/2)
Case "right"
x1=x+1
y1=y-Rnd(h1/2)
Case "up"
x1=x-Rnd(w1/2)
y1=y-h1
Case "down"
x1=x-Rnd(w1/2)
y1=y+1
End Select
If x1<>-1
If spaceisempty(x1,y1,w1,h1) = True Then
For Local y2=0 Until h1
For Local x2=0 Until w1
map[x2+x1][y2+y1] = isfloor
If y2 = 0 Or x2 = 0 Or y2 = h1-1 Or x2 = w1-1 Then map[x2+x1][y2+y1] = 1 ' wall
Next
Next
' shift map
Select facing
Case "left"
For Local y2=0 Until h1
For Local x2=w1 Until 0 Step -1
If map[x2+x1][y2+y1] <> isdoor
map[x2+x1][y2+y1] = map[x2+x1-1][y2+y1]
End If
Next
Next
For Local y2=0 Until h1
map[x1][y2+y1] = isnothing
Next
Case "right"
For Local y2=0 Until h1
For Local x2=0 Until w1
If map[x2+x1-1][y2+y1] <> isdoor
map[x2+x1-1][y2+y1] = map[x2+x1][y2+y1]
End If
Next
Next
For Local y2=0 Until h1
map[x1+w1-1][y2+y1] = isnothing
Next
Case "up"
For Local y2=h1 Until 0 Step -1
For Local x2=0 Until w1
If map[x2+x1][y2+y1] <> isdoor
map[x2+x1][y2+y1] = map[x2+x1][y2+y1-1]
End If
Next
Next
For Local x2=0 Until w1
map[x1+x2][y1] = isnothing
Next
Case "down"
For Local y2=0 Until h1
For Local x2=0 Until w1
If map[x2+x1][y2+y1-1] <> isdoor
map[x2+x1][y2+y1-1] = map[x2+x1][y2+y1]
End If
Next
Next
For Local x2=0 Until w1
map[x1+x2][y1+h1-1] = isnothing
Next
End Select
Return True
End If
End If
cnt+=1
Wend
Return False
End Function
Function spaceisempty:Bool(x:Int,y:Int,w:Int,h:Int)
For Local y1=0 Until h
For Local x1=0 Until w
If map[x1+x][y1+y] <> isnothing Then Return False
Next
Next
Return True
End Function
Function makedoor(side:String,x:Int,y:Int,w:Int,h:Int)
Local x1:Int
Local y1:Int
Select side
Case "left"
x1=x
y1=y+Rnd(h-6)+3
Case "right"
x1=x+w-1
y1=y+Rnd(h-6)+3
Case "up"
x1=x+Rnd(w-6)+3
y1=y
Case "down"
x1=x+Rnd(w-6)+3
y1=y+h-1
End Select
map[x1][y1] = isdoor
End Function
Function makeroom(x:Int,y:Int,w:Int,h:Int)
For Local y1=0 Until h
For Local x1=0 Until w
map[x1+x][y1+y] = 2 ' floor
If y1 = 0 Or x1 = 0 Or y1 = h-1 Or x1 = w-1 Then map[x1+x][y1+y] = 1 ' wall
Next
Next
End Function
Function drawmap:Bool()
For Local y=0 Until mapheight
For Local x=0 Until mapwidth
Select map[x][y]
Case isnothing ;
Case iswall ; SetColor 150,150,150 ' wall
Case isfloor ; SetColor 50,50,50 ' floor
Case isdoor ; SetColor 200,200,0 ' door
End Select
If map[x][y]<>isnothing Then DrawRect x*tilewidth,y*tileheight,tilewidth,tileheight
Next
Next
End Function
Function Main()
New MyGame()
End Function
No comments:
Post a Comment
Note: Only a member of this blog may post a comment.