Ooops
November 28, 2020, 01:33:55 PM

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

Offline 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


Comments : none...

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal