Code: Select all
'kokoelmat kartan generointia varten.
Type GeneratedRoom
Field x%
Field y%
Field w%
Field h%
EndType
Type GeneratedPath
Field x%
Field y%
Field angle%
Field lenght%
Field turn_lenght%
Field turns_left%
EndType
'taulukko ja tunnukset karttadatalle.
Dim GenMap(0,0) As Byte
Const MAP_ID_EMPTY = 0
Const MAP_ID_WALL = 1
Const MAP_ID_PATH = 2
Const MAP_ID_ROOM = 3
Const MAP_WIDTH = 100
Const MAP_HEIGHT = 100
Randomize Timer()
Function Generate_Map(Room_minW=5, Room_minH=3, Room_maxW=20, Room_maxH=20, Room_count = 10, Paths_per_room = 2, Path_min_len=50, Path_max_len=100)
ClearArray ON
ReDim GenMap(MAP_WIDTH, MAP_HEIGHT)
NewRoom = True 'Luodaan ensin uusi huone, ja siitä lähtevät polut.
//##############################################
//#Generoidaan ensin huoneet ja polkujen alut.
//##############################################
Repeat
If NewRoom = True
Repeat
r_width% = Rand(Room_minW, Room_maxW)
r_height% = Rand(Room_minH, Room_maxH)
room_x% = Rand(1, MAP_WIDTH - r_width - 1)
room_y% = Rand(1, MAP_HEIGHT - r_height - 1)
//Tarkistetaan alue
Room_Placement_OK = True
For iRoom.GeneratedRoom = Each GeneratedRoom
If BoxOverlap(room_x, room_y, r_width, r_height, iRoom\x, iRoom\y,iRoom\w,iRoom\h)
Room_Placement_OK = False
Exit
EndIf
Next iRoom
Until Room_Placement_OK = True
If Room_Placement_OK = True
// Luodaan huone.
genroom.GeneratedRoom = New(GeneratedRoom)
genroom\x = room_x
genroom\y = room_y
genroom\w = r_width - 1
genroom\h = r_height - 1
For iy = room_y To (room_y + r_height - 1)
For ix = room_x To (room_x + r_width - 1)
GenMap(ix, iy) = MAP_ID_ROOM
Next ix
Next iy
Room_count = Room_count - 1
//Arvotaan polkujen aloitus paikat.
r_paths% = Rand(1, paths_per_room)
While r_paths > 0
If Rand(1)
path_x% = room_x + Rand(r_width)
If Rand(1)
path_y = room_y-1
travel_direction = 90
Else
path_y = room_y + r_height
travel_direction = 270
EndIf
Else
path_y% = room_y + Rand(r_height)
If Rand(1)
path_x = room_x-1
travel_direction = 180
Else
path_x = room_x + r_width
travel_direction = 0
EndIf
EndIf
If Max(Min(path_x, map_width), 0) = path_x And Max(Min(path_y, map_height), 0) = path_y
GenPath.GeneratedPath = New(GeneratedPath)
GenPath\x = Max(Min(path_x, map_width), 0)
GenPath\y = Max(Min(path_y, map_height), 0)
GenPath\angle = travel_direction
GenPath\lenght = Rand(Path_min_len, Path_min_len)
GenPath\turns_left = Rand(1, 20) 'oletukasena polku voi kääntyä 1-10 kertaa.
r_paths = r_paths -1
EndIf
Wend
EndIf
EndIf
Until Room_count <= 0
// Poistetaan tarkistus huoneet.
For iRoom.GeneratedRoom = Each GeneratedRoom
Delete iRoom
Next iRoom
//###################################
//#Generoidaan nyt polut:
//###################################
For iPath.GeneratedPath = Each GeneratedPath
turn_moment = Rand(1, iPath\lenght)
tsx% = Cos(iPath\angle+90) + Cos(iPath\angle+180)
tsy% = Sin(iPath\angle+90) - Sin(iPath\angle+180)
If GenMap(iPath\x + tsx, iPath\y - tsy) = MAP_ID_ROOM
fat_side = 1
Else
fat_side = -1
EndIf
For i = 1 To iPath\lenght
If GenMap(iPath\x, iPath\y) <> MAP_ID_ROOM
If iPath\x > 0 And iPath\y > 0 And iPath\x < MAP_WIDTH - 1 And iPath\y < MAP_HEIGHT - 1
GenMap(iPath\x, iPath\y) = MAP_ID_PATH
GenMap(iPath\x + Int(Cos(iPath\angle+90*fat_side)), iPath\y - Int(Sin(iPath\angle+90*fat_side))) = MAP_ID_PATH
iPath\x = iPath\x + Cos(iPath\angle)
iPath\y = iPath\y - Sin(iPath\angle)
If i = turn_moment And iPath\turns_left > 0
If Rand(1) Then travel_direction = iPath\angle + 90 Else travel_direction = iPath\angle - 90
iPath\angle = travel_direction
iPath\turns_left = iPath\turns_left - 1
turn_moment = Rand(turn_moment+1, iPath\lenght)
fat_side = -fat_side
EndIf
EndIf
Else
Exit
EndIf
Next i
Delete iPath
Next iPath
//#################################
//#Lisätään seinät
//#################################
For iy = 1 To MAP_HEIGHT
For ix = 1 To MAP_WIDTH
If GenMap(ix, iy) = MAP_ID_PATH Or GenMap(ix, iy) = MAP_ID_ROOM
For i = -1 To 1
For j = -1 To 1
If GenMap(ix+j, iy+i) = MAP_ID_EMPTY And (i <> 0 Or j <> 0)
GenMap(ix+j, iy+i) = MAP_ID_WALL
EndIf
Next j
Next i
EndIf
Next ix
Next iy
EndFunction
//Luo oikean tilemapin ja maalaa sen tileillä
Function RenderToTilemap()
map = MakeMap(MAP_WIDTH, MAP_HEIGHT, 32, 32)
SetMap map, ON, OFF
For y = 1 To MAP_HEIGHT
For x = 1 To MAP_WIDTH
id = GenMap(x-1, y-1)
If id <> MAP_ID_EMPTY
If id = MAP_ID_ROOM
EditMap map,0,x,y,193 + Rand(0, 3)
ElseIf id = MAP_ID_PATH
EditMap map,0,x,y,172
ElseIf id = MAP_ID_WALL
EditMap map,0,x,y,22
EditMap map,2,x,y,1
EndIf
EndIf
Next x
Next y
Return map
EndFunction
SCREEN 800,600
Generate_Map(4,4,15,15, 25, 4, 30, 200)
map = RenderToTilemap()
'ChDir "C:\Ohjelmat\CoolBasic"
u=LoadObject("Media\guy.bmp",72)
tileset=LoadImage("Media\tileset.bmp")
PaintObject map,tileset
SetupCollision u,map,2,4,2
//Generaattorin asetukset.
Room_minW=5
Room_minH=3
Room_maxW=20
Room_maxH=20
Room_count = 10
Paths_per_room = 4
Path_min_len=50
Path_max_len=100
Repeat
If UpKey() Then MoveObject u,5
If DownKey() Then MoveObject u, -5
If LeftKey() Then TurnObject u,5
If RightKey() Then TurnObject u, -5
If KeyHit(cbkeyreturn)
DeleteObject map
Generate_Map(Room_minW, Room_minH, Room_maxW, Room_maxH, Room_count, Paths_per_room, Path_min_len, Path_max_len)
map = RenderToTilemap()
PaintObject map,tileset
SetupCollision u,map,2,4,2
ObjectOrder map,-1
EndIf
CloneCameraPosition u
DrawGame
Color 255,0,0
Room_minW = Room_minW + (KeyHit(cbkeya) - KeyHit(cbkeyz))
Room_minH = Room_minH + (KeyHit(cbkeys) - KeyHit(cbkeyx))
Room_maxW = Room_maxW + (KeyHit(cbkeyd) - KeyHit(cbkeyc))
Room_maxH = Room_maxH + (KeyHit(cbkeyf) - KeyHit(cbkeyv))
Room_count = Room_count + (KeyHit(cbkeyg) - KeyHit(cbkeyb))
'Path_min_len
'Path_max_len
If KeyDown(14)
Text 0,0,"az Minimum Room width:"+Room_minW
Text 0,12,"sx Minimum Room height:"+Room_minH
Text 0,12*2,"dc Maximum Room width:"+Room_maxW
Text 0,12*3,"fv Maximum Room height:"+Room_maxH
Text 0,12*4,"gb Room count:"+Room_count
Else
Text 0,0,"Hit backspace To show generator settings."
Text 0,12,"Use keys A-G To increase And Z-B To decrease the value."
EndIf
DrawScreen
Forever