[bb] Mesh surface Packer Example by Pakz [ 1+ years ago ]

[BlitzBot]

Title : Mesh surface Packer Example
Author : Pakz
Posted : 1+ years ago

Description :

Here a video with more maps and time taken (debugger on on 250 dollar laptop) : <a href="" target="_blank">[/url]

This is a example of how I am trying to optimize a random 3d map with blocks like minecraft and create bigger surfaces where possible.

In this example a small 2d map is generated and a routine goes from fitting big to small blocks into the map. If it fits then the space is added into a rects list and the map space is flagged occupied in a other array.

You end up with a list of coordinates and width and height for placing and resizing the meshes.  I want to try and use this with a randomly created minecraft like map.

In this example it does not use 2*2 blocks. I still need to figure out how to do that. Edit - I added 2 4x4 block to.

Code :

Code: BlitzBasic

1. ; Big Surfaces Maker
2.  
3. Graphics 800,600,32,2
4. SetBuffer BackBuffer()
5. SeedRnd 1
6.  
7. AppTitle "Press escape to end."
8.  
9. Global mapw = 50
10. Global maph = 50
11. Dim map(mapw,maph)
12.  
13. Type r
14.         Field x,y,w,h
15. End Type
16. Dim  cmap(mapw,maph)
17. initmap()
18. ms = MilliSecs()
19. initsurfaces() 
20. ms = MilliSecs() - ms
21.  
22. timer = CreateTimer(60)
23. While KeyDown(1) = False
24.         WaitTimer timer
25.         Cls
26.         drawmap()
27.         drawrects()
28.         ;
29.         If cnt > 60*3
30.                 initmap()
31.                 ms = MilliSecs()               
32.                 initsurfaces() 
33.                 ms = MilliSecs() - ms
34.                 cnt=0
35.         End If
36.         cnt=cnt+1
37.         Text GraphicsWidth()-196,10,"Took:"+ms+" ms"
38.         Flip
39. Wend
40. End
41.  
42. Function initsurfaces()
43.         Delete Each r
44.         For y=0 To maph
45.         For x=0 To mapw
46.                 cmap(x,y) = 0
47.         Next
48.         Next
49.         ;
50.         ; Pass 1 - Fit increasingly smaller blocks into the space and add to list
51.         ;
52.         cnt=0
53.         exitloop = False
54.         rad = mapw
55.         x1 = 0
56.         y1 = 0
57.         While exitloop = False
58.                 fits = True
59.                 x2 = -rad
60.                 y2 = -rad
61.                 If map(x1,y1) = 1
62.                         For y2=-rad To rad
63.                         For x2=-rad To rad
64.                                 x3 = x1+x2
65.                                 y3 = y1+y2
66.                                 If RectsOverlap(x3,y3,1,1,0,0,mapw+1,maph+1) = True
67.                                                 If map(x3,y3) = 0 Then fits = False:Exit
68.                                                 If cmap(x3,y3) = 1 Then fits = False:Exit
69.                                         Else
70.                                         fits = False :Exit
71.                                 EndIf
72.                         Next
73.                         Next
74.                
75.                         If fits = True Then
76.                                 For y2 = -rad To rad
77.                                 For x2 = -rad To rad
78.                                         x3 = x1 + x2
79.                                         y3 = y1 + y2
80.                                         cmap(x3,y3) = 1
81.                                 Next
82.                                 Next
83.                                 r1.r = New r                   
84.                                 r1x = x1-rad
85.                                 r1y = y1-rad                   
86.                                 r1w = rad*2
87.                                 r1h = rad*2
88.                         End If
89.                 End If
90.                 x1 = x1 + 1
91.                 If x1 > mapw
92.                         y1 = y1 + 1
93.                         x1 = 0
94.                 End If
95.                 If x1 => mapw And y1=>maph Then
96.                         x1 = 0
97.                         y1 = 0
98.                         rad = rad - 1
99.                 End If
100.                 If rad < 0 Then exitloop = True
101.         Wend   
102.         ;
103.         ; Pass 2 - check the list for 4x4 rectangles to create one off
104.         ;
105.         For y=0 To maph
106.         For x=0 To mapw
107.                 If map(x,y) = 1
108.                         For this.r = Each r
109.                                 If thisx = x And thisy = y And thisw = 0
110.                                         aset = False
111.                                         For a.r = Each r
112.                                                 If ax = thisx+1 And ay = thisy And aw = 0 Then aset = True
113.                                         Next
114.                                         bset = False
115.                                         For b.r = Each r
116.                                                 If bx = thisx And by = thisy+1 And bw = 0 Then bset = True
117.                                         Next
118.                                         cset = False
119.                                         For c.r = Each r
120.                                                 If cx = thisx+1 And cy = thisy+1 And cw = 0 Then cset = True
121.                                         Next
122.                                         If aset = True And bset = True And cset = True
123.                                                 that.r = New r
124.                                                 thatx = thisx
125.                                                 thaty = thisy
126.                                                 thatw = 1
127.                                                 thath = 1
128.                                                 For a.r = Each r
129.                                                         del = False
130.                                                         If ax = thisx+1 And ay = thisy And aw = 0 Then Del = True
131.                                                         If ax = thisx And ay = thisy+1 And aw = 0 Then del = True
132.                                                         If ax = thisx+1 And ay = thisy+1 And aw = 0 Then del = True
133.                                                         If del = True Then Delete a
134.                                                 Next
135.                                                 Delete this
136.                                         End If
137.                                 End If                 
138.                         Next
139.                 End If
140.         Next
141.         Next
142. End Function
143.  
144. Function drawrects()
145.         Color 255,255,255
146.         For this.r = Each r
147.                 Rect thisx*10,thisy*10,(thisw+1)*10,(thish+1)*10,False
148.         Next
149. End Function
150.  
151. Function drawmap()
152.         For y=0 To maph
153.         For x=0 To mapw
154.                 Select map(x,y)
155.                         Case 0:Color 0,0,0
156.                         Case 1:Color 100,100,100
157.                 End Select
158.                 Rect x*10,y*10,10,10,True
159.         Next
160.         Next
161. End Function
162.  
163. Function initmap()
164.         For y=0 To maph
165.         For x=0 To mapw
166.                 map(x,y) = 0
167.         Next
168.         Next   
169.  
170.         exitloop = False
171.         While exitloop = False
172.                 x1 = Rand(mapw)
173.                 y1 = Rand(maph)
174.                 rad = Rand(3,6)
175.                 For y2 = -rad To rad
176.                 For x2 = -rad To rad
177.                         x3 = x1+x2
178.                         y3 = y1+y2
179.                         If x3 => 0 And y3 >= 0 And x3 =< mapw And y3 <= maph
180.                                 map(x3,y3) = map(x3,y3) + 1
181.                                 If map(x3,y3) > 10 Then exitloop = True                        
182.                         End If                 
183.                 Next
184.                 Next
185.         Wend   
186.         For y = 0 To maph
187.         For x = 0 To mapw
188.                 If map(x,y) < 5 Then map(x,y) = 0
189.                 If map(x,y) > 4 Then map(x,y) = 1
190.         Next
191.         Next
192. End Function

Comments : none...