June 18, 2021, 06:10:02 AM

### Author Topic: [bb] 2d Level Generator by Pakz [ 1+ years ago ]  (Read 585 times)

#### BlitzBot

• Jr. Member
• Posts: 1
##### [bb] 2d Level Generator by Pakz [ 1+ years ago ]
« on: June 29, 2017, 12:28:39 AM »
Title : 2d Level Generator
Author : Pakz
Posted : 1+ years ago

Description : This code creates random levels for 2d games. The maps are created by a random walk method. The maps are checked if they are big enough (close to the edges) before they are displayed.

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