January 26, 2021, 06:18:02 AM

Author Topic: [bb] Mesh surface Packer Example by Pakz [ 1+ years ago ]  (Read 521 times)

BlitzBot

• Jr. Member
• Posts: 1
[bb] Mesh surface Packer Example by Pakz [ 1+ years ago ]
« on: June 29, 2017, 12:28:40 AM »
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
55.         x1 = 0
56.         y1 = 0
57.         While exitloop = False
58.                 fits = True
61.                 If map(x1,y1) = 1
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
78.                                         x3 = x1 + x2
79.                                         y3 = y1 + y2
80.                                         cmap(x3,y3) = 1
81.                                 Next
82.                                 Next
83.                                 r1.r = New r
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
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)
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