-
Notifications
You must be signed in to change notification settings - Fork 1
/
2d level generator.bb
150 lines (144 loc) · 3.07 KB
/
2d level generator.bb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Graphics 640,480,32,2
SetBuffer BackBuffer()
Global mapwidth = 39
Global mapheight = 29
Dim map(mapwidth,mapheight)
SeedRnd MilliSecs()
While exitloop = False
makemap()
Cls
drawmap()
Color 255,255,255
Rect 640-120,0,119,479,True
Flip
For i = 0 To 200
Delay 1
If KeyDown(1) = True Then exitloop = True
Next
Wend
End
Function makemap(steps = 100)
Local aproved = False
While aproved = False
For y = 0 To mapheight
For x = 0 To mapwidth
map(x,y) = 0
Next
Next
x = mapwidth / 2
y = mapheight / 2
steps = Rand(500) + 500
For i=0 To steps
nstepf = False
While nstepf = False
dir = Rand(8)
Select dir
Case 1 : nx = x - 1 : ny = y - 1
Case 2 : ny = y - 1
Case 3 : nx = x + 1 : ny = y - 1
Case 4 : nx = x - 1
Case 5 : nx = x + 1
Case 6 : nx = x - 1 : ny = y + 1
Case 7 : ny = y + 1
Case 8 : nx = x + 1 : ny = y + 1
End Select
If nx < mapwidth And nx > 0 And ny < mapheight And ny > 0 Then
x = nx
y = ny
nstepf = True
End If
Wend
drawbrush(x,y)
Next
aproved = True
For y=0 To mapheight
If map(0,y) = 1 Then aproved = False
Next
For y=0 To mapheight
If map(mapwidth,y) = 1 Then aproved = False
Next
For x=0 To mapwidth
If map(x,0) = 1 Then aproved = False
Next
For x=0 To mapwidth
If map(x,mapheight) = 1 Then aproved = False
Next
For y=0 To mapheight
For x=mapwidth-7 To mapwidth
If map(x,y) = 1 Then aproved = False
Next
Next
hasone = False
For y=0 To mapheight
If map(mapwidth-8,y) = 1 Then hasone = True
Next
If hasone = False Then aproved = False
hasone = False
For y=0 To mapheight
If map(3,y) = 1 Then hasone = True
Next
If hasone = False Then aproved = False
hasone = False
For x=0 To mapwidth
If map(x,3) = 1 Then hasone = True
Next
If hasone = False Then aproved = False
hasone = False
For x=0 To mapwidth
If map(x,mapheight-3) = 1 Then hasone = True
Next
If hasone = False Then aproved = False
Wend
End Function
Function drawbrush(x,y)
x1 = x - 1
y1 = y - 1
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x
y1 = y - 1
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x + 1
y1 = y - 1
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x - 1
y1 = y
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x + 1
y1 = y
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x - 1
y1 = y + 1
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x
y1 = y + 1
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
x1 = x + 1
y1 = y + 1
If x1 > 0 And x1 < mapwidth And y1 > 0 And y1 < mapheight Then
map(x1,y1) = 1
End If
End Function
Function drawmap()
Color 255,255,255
For y = 0 To mapheight
For x = 0 To mapwidth
If map(x,y) = 1 Then
Rect x*16,y*16,16,16,True
End If
Next
Next
End Function