Author Topic: Maze Generator with notes for using and Game example  (Read 5339 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Maze Generator with notes for using and Game example
« on: September 03, 2019, 10:46:40 am »
This maze maker creates path all through maze, you might want to knock more walls down to have alternate ways to go through maze. I am working that aspect with a game I am cloning.

I left notes so it will be easier for me to pickup and use in future, or by you all ;)

Code: QB64: [Select]
  1. _TITLE "Maze Generator" 'B+
  2. ' 2019-09-02 isolated and updated generator code for OPTION _EXPLICIT
  3. ' from trans 2018-06-15 for Amazing Rat.bas (QB64)
  4. ' From SmallBASIC code written by Chris WS developer
  5. ' Backtracking maze generator by chrisws 2016-06-30 now found at
  6. ' https://github.com/smallbasic/smallbasic.github.io/blob/5601c8bc1d794c5b143d863555bb7c15a5966a3c/samples/node/1623.bas
  7. '
  8. ' Chris notes:
  9. ' https://en.wikipedia.org/wiki/Maze_generation_algorithm
  10. ' - Starting from a random cell,
  11. ' - Selects a random neighbouring cell that has not been visited.
  12. ' - Remove the wall between the two cells and marks the new cell as visited,
  13. '   and adds it to the stack to facilitate backtracking.
  14. ' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
  15. '   When at a dead-end it backtracks through the path until it reaches a cell with an
  16. '   unvisited neighbour, continuing the path generation by visiting this new,
  17. '   unvisited cell (creating a new junction).
  18. '   This process continues until every cell has been visited, backtracking all the
  19. '   way back to the beginning cell. We can be sure every cell is visited.
  20. '
  21.  
  22. 'B+ notes for using:
  23. ' The most important item is that the maze uses 2 arrays one for vertical walls the other for horizontal
  24. ' CONST xmax, ymax is pixel size used in maze coder, using SW, SH for screen dimensions
  25. ' Maze should mount in top left corner of screen with min border space around it at left and top at least.
  26. ' CONST W, H - number of cells Wide and High you can specify.
  27. ' CONST wallThk - adjusts thickness of walls
  28. ' CONST mazeClr - colors walls made with BF in LINE statement
  29. ' CONST border - will create a space around the maze
  30. ' SHARED cellW, cellH - are pixels sizes for cell, see calcs before SCREEN command
  31. ' SHARED  h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER - these are your Maze, 0 no wall, 1 = wall
  32. ' When player occupies cell x, y that cell may v_wall that blocks player going left;
  33. ' a cell v_wall(x+1, y) = 1 will block a player going right;
  34. ' cell (x, y) may have an h_wall that stops player from going up;
  35. ' cell (x, y+1) may have h_wall that stops player at x, y from going down.
  36. ' Cells at (W, y) should not be occupied with W cells wide and array base 0 only W-1 can be occupied
  37. ' unless game needs something special.
  38. ' Likewise cells at (x, H) should only provide wall to stop player from going out of box.
  39.  
  40. CONST xmax = 800, ymax = 600, SW = 1200, SH = 700 'maze pixels from 0,0 and screen SH, SW
  41. CONST W = 40, H = 30, border = 25, wallThk = 5 'maze cells wide and high
  42. CONST mazeClr = &HFFFF8800
  43.  
  44. TYPE cell
  45.     x AS INTEGER
  46.     y AS INTEGER
  47.  
  48. DIM SHARED cellW AS SINGLE, cellH AS SINGLE, h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER
  49. cellW = (xmax - 2 * border - wallThk) / W
  50. cellH = (ymax - 2 * border - wallThk) / H
  51.  
  52. SCREEN _NEWIMAGE(SW, SH, 32)
  53. _SCREENMOVE 100, 20
  54. LINE (0, 0)-(xmax, ymax), &HFFFFFF00, B
  55. init_walls
  56. generate_maze
  57. show_maze
  58.  
  59. SUB init_walls ()
  60.     DIM x AS INTEGER, y AS INTEGER
  61.     FOR x = 0 TO W
  62.         FOR y = 0 TO H
  63.             v_walls(x, y) = 1
  64.             h_walls(x, y) = 1
  65.         NEXT
  66.     NEXT
  67.  
  68. SUB show_maze ()
  69.     DIM py AS SINGLE, px AS SINGLE, y AS INTEGER, x AS INTEGER
  70.     py = border
  71.     FOR y = 0 TO H
  72.         px = border
  73.         FOR x = 0 TO W
  74.             IF x < W AND h_walls(x, y) = 1 THEN
  75.                 LINE (px, py)-STEP(cellW + wallThk, wallThk), mazeClr, BF
  76.             END IF
  77.             IF y < H AND v_walls(x, y) = 1 THEN
  78.                 LINE (px, py)-STEP(wallThk, cellH + wallThk), mazeClr, BF
  79.             END IF
  80.             px = px + cellW
  81.         NEXT
  82.         py = py + cellH
  83.     NEXT
  84.  
  85. SUB rand_cell (rWx, rHy)
  86.     rWx = INT(RND * 1000) MOD W
  87.     rHy = INT(RND * 1000) MOD H
  88.  
  89. SUB get_unvisited (visited() AS INTEGER, current AS cell, unvisited() AS cell, uvi AS INTEGER)
  90.     REDIM unvisited(0) AS cell
  91.     DIM x AS INTEGER, y AS INTEGER
  92.     x = current.x
  93.     y = current.y
  94.     uvi = 0
  95.     IF x > 0 THEN
  96.         IF visited(x - 1, y) = 0 THEN
  97.             uvi = uvi + 1
  98.             REDIM _PRESERVE unvisited(uvi) AS cell
  99.             unvisited(uvi).x = x - 1
  100.             unvisited(uvi).y = y
  101.         END IF
  102.     END IF
  103.     IF x < W - 1 THEN
  104.         IF visited(x + 1, y) = 0 THEN
  105.             uvi = uvi + 1
  106.             REDIM _PRESERVE unvisited(uvi) AS cell
  107.             unvisited(uvi).x = x + 1
  108.             unvisited(uvi).y = y
  109.         END IF
  110.     END IF
  111.     IF y > 0 THEN
  112.         IF visited(x, y - 1) = 0 THEN
  113.             uvi = uvi + 1
  114.             REDIM _PRESERVE unvisited(uvi) AS cell
  115.             unvisited(uvi).x = x
  116.             unvisited(uvi).y = y - 1
  117.         END IF
  118.     END IF
  119.     IF y < H - 1 THEN
  120.         IF visited(x, y + 1) = 0 THEN
  121.             uvi = uvi + 1
  122.             REDIM _PRESERVE unvisited(uvi) AS cell
  123.             unvisited(uvi).x = x
  124.             unvisited(uvi).y = y + 1
  125.         END IF
  126.     END IF
  127.  
  128. SUB generate_maze ()
  129.     DIM visited(W, H) AS INTEGER
  130.     DIM num_visited AS INTEGER, num_cells AS INTEGER, si AS INTEGER
  131.     DIM cnt AS INTEGER, rc AS INTEGER, x AS INTEGER, y AS INTEGER
  132.     REDIM stack(0) AS cell
  133.     DIM curr_cell AS cell, next_cell AS cell, cur_cell AS cell
  134.  
  135.     rand_cell cur_cell.x, cur_cell.y
  136.     visited(curr_cell.x, curr_cell.y) = 1
  137.     num_visited = 1
  138.     num_cells = W * H
  139.     si = 0
  140.     WHILE num_visited < num_cells
  141.         REDIM cells(0) AS cell
  142.         cnt = 0
  143.         get_unvisited visited(), curr_cell, cells(), cnt
  144.         IF cnt > 0 THEN
  145.  
  146.             ' choose randomly one of the current cell's unvisited neighbours
  147.             rc = INT(RND * 100) MOD cnt + 1
  148.             next_cell.x = cells(rc).x
  149.             next_cell.y = cells(rc).y
  150.  
  151.             ' push the current cell to the stack
  152.             si = si + 1
  153.             REDIM _PRESERVE stack(si) AS cell
  154.             stack(si).x = curr_cell.x
  155.             stack(si).y = curr_cell.y
  156.  
  157.             ' remove the wall between the current cell and the chosen cell
  158.             IF next_cell.x = curr_cell.x THEN
  159.                 x = next_cell.x
  160.                 y = max(next_cell.y, curr_cell.y)
  161.                 h_walls(x, y) = 0
  162.             ELSE
  163.                 x = max(next_cell.x, curr_cell.x)
  164.                 y = next_cell.y
  165.                 v_walls(x, y) = 0
  166.             END IF
  167.  
  168.             ' make the chosen cell the current cell and mark it as visited
  169.             curr_cell.x = next_cell.x
  170.             curr_cell.y = next_cell.y
  171.             visited(curr_cell.x, curr_cell.y) = 1
  172.             num_visited = num_visited + 1
  173.  
  174.         ELSEIF si > 0 THEN
  175.  
  176.             ' pop a cell from the stack and make it the current cell
  177.             curr_cell.x = stack(si).x
  178.             curr_cell.y = stack(si).y
  179.             si = si - 1
  180.             REDIM _PRESERVE stack(si) AS cell
  181.  
  182.         ELSE
  183.             EXIT WHILE
  184.         END IF
  185.     WEND
  186.  
  187. FUNCTION max (a, b)
  188.     IF a > b THEN max = a ELSE max = b
  189.  

EDIT (already, oops I meant to eliminate margin and just use border, no sense in both. While at it I fixed a few notes hopefully clearer and mounted maze onto larger screen SW, SH to show how to do that too, see screen shot)

Dang, I posted screen shot and noticed tiny little squares missing in bottom right corners. OK fixed and added a wallThk CONST so you can adjust wall size and still mount maze centered in xmax, ymax pixel area.
(new screen shot)
Maze Generator now with wallThk const.PNG
* Maze Generator now with wallThk const.PNG (Filesize: 54.84 KB, Dimensions: 1203x728, Views: 218)
« Last Edit: September 04, 2019, 09:50:40 am by bplus »

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Maze Generator with notes for using
« Reply #1 on: September 03, 2019, 01:29:15 pm »
Very nice, BPlus!

I see that the walls and the gaps are on the same scale. I'll try to do something about it in own way (it won't be today). Thanks for sharing!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Generator with notes for using
« Reply #2 on: September 03, 2019, 02:35:41 pm »
Hi Petr,

I hope to have game up using generator soon, it's sorta working now but needs some work.

I am trying to clone this:
https://easylang.online/games/
click game then maze

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Maze Generator with notes for using
« Reply #3 on: September 03, 2019, 02:41:37 pm »
Thank you for link, BPlus! Very nice game!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Generator with notes for using
« Reply #4 on: September 03, 2019, 03:31:40 pm »
Hi Petr, for you a sneak preview!

My mouse action isn't as smooth as EasyLang's but so far I have 16 lines of code to add to catch up to theirs in size ;D (but their code is making faces, nice!)

Code: QB64: [Select]
  1. _TITLE "Escape from Monster Maze" 'B+ 2019-09-03
  2. ' 2019-08-31 attempt a better, smoother mouser
  3. ' 2019-09-03 Maze geneartion, nice mouse and arrow key action,
  4. '            momentum removed, just cant turn corners that fast.
  5. ' 2019-09-03 Troubles
  6. ' I either have to loose arrow keys or deactivate mouse or something
  7. ' so arrow key presses are defeated by mouse presence. :-P
  8. ' and still not 100% happy with mouse action. ;(
  9. ' I kicked out walls randomly several for each new monster but not effective for creating
  10. ' alternate paths when dang monsters are ganging up at upper left corner, yikes! no escape!!!
  11. ' to fix that
  12. ' 1. lay out another generated maze over top of current that will create meaningfull alternate route
  13. ' 2. relocate monsters when my guy gets back to start!
  14.  
  15.  
  16. CONST xmax = 800, ymax = 600 'screen
  17. CONST W = 15, H = 15, border = 50 'maze cells wide and high
  18. CONST mazeClr = &HFFFF8800
  19.  
  20. TYPE cell
  21.     x AS INTEGER
  22.     y AS INTEGER
  23.  
  24. DIM SHARED cellW AS SINGLE, cellH AS SINGLE, h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER
  25. cellW = (xmax - 2 * border) / W
  26. cellH = (ymax - 2 * border) / H
  27.  
  28. '        Locals for Main module code
  29. 'DIM x, y
  30. DIM px, py, mx, my, k$, d, a, start, i, nMonsters, test AS cell
  31.  
  32. 'RANDOMIZE TIMER
  33. SCREEN _NEWIMAGE(xmax, ymax, 32)
  34. _SCREENMOVE 100, 20
  35. nMonsters = 3
  36.     init_walls
  37.     generate_maze
  38.     'open gate a bottom right corner to esacpe
  39.     h_walls(W - 1, H) = 0
  40.     nMonsters = nMonsters + 1
  41.     REDIM m(1 TO nMonsters) AS cell
  42.     FOR i = 1 TO nMonsters
  43.         m(i).x = RND * 7 * W / 8 + W / 8 - 1: m(i).y = RND * 7 * H / 8 + H / 8 - 1
  44.         'for every monster make 2 escape hatches
  45.         test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  46.         WHILE h_walls(test.x, test.y) = 0
  47.             test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  48.         WEND
  49.         h_walls(test.x, test.y) = 0
  50.         test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  51.         WHILE v_walls(test.x, test.y) = 0
  52.             test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  53.         WEND
  54.         v_walls(test.x, test.y) = 0
  55.         test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  56.         WHILE h_walls(test.x, test.y) = 0
  57.             test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  58.         WEND
  59.         h_walls(test.x, test.y) = 0
  60.         test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  61.         WHILE v_walls(test.x, test.y) = 0
  62.             test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  63.         WEND
  64.         v_walls(test.x, test.y) = 0
  65.     NEXT
  66.     px = 0: py = 0: start = TIMER
  67.     WHILE 1
  68.         CLS
  69.  
  70.         show_maze
  71.  
  72.         FOR i = 1 TO nMonsters
  73.             fcirc (m(i).x + .5) * cellW + border, (m(i).y + .5) * cellH + border, cellH / 3, &HFFFF0000
  74.             d = INT(RND * 4) + 1
  75.             SELECT CASE d
  76.                 CASE 1 'up
  77.                     IF m(i).y - 1 >= 0 THEN
  78.                         IF h_walls(m(i).x, m(i).y) = 0 THEN m(i).y = m(i).y - 1
  79.                     END IF
  80.                 CASE 2 'down
  81.                     IF m(i).y + 1 <= H - 1 THEN
  82.                         IF h_walls(m(i).x, m(i).y + 1) = 0 THEN m(i).y = m(i).y + 1
  83.                     END IF
  84.                 CASE 3 'right
  85.                     IF m(i).x + 1 <= W - 1 THEN
  86.                         IF v_walls(m(i).x + 1, m(i).y) = 0 THEN m(i).x = m(i).x + 1
  87.                     END IF
  88.                 CASE 4 'left
  89.                     IF m(i).x - 1 >= 0 THEN
  90.                         IF v_walls(m(i).x, m(i).y) = 0 THEN m(i).x = m(i).x - 1
  91.                     END IF
  92.             END SELECT
  93.             IF m(i).x = px AND m(i).y = py THEN
  94.                 fcirc (px + .5) * cellW + border, (py + .5) * cellH + border, cellH / 3, &HFFFFFFFF 'draw player
  95.                 _DISPLAY
  96.                 _DELAY 1
  97.                 px = 0: py = 0
  98.             END IF
  99.         NEXT
  100.         d = 0
  101.         WHILE _MOUSEINPUT: WEND
  102.         mx = INT((_MOUSEX - border) / cellW): my = INT((_MOUSEY - border) / cellH) 'offset by 1/2 character size
  103.         LOCATE 1, 1: PRINT SPACE$(10)
  104.         LOCATE 1, 1: PRINT px, py, mx, my
  105.         'if the mouse is near the player then it will act as magnet drawing player to it unless wall in way
  106.         'IF ABS(mx - px) >= 1 AND ABS(my - py) = 0 OR ABS(mx - px) = 0 AND ABS(my - py) >= 1 THEN
  107.         IF ABS(mx - px) <> 0 OR ABS(my - py) <> 0 THEN
  108.             a = _R2D(_ATAN2(my - py, mx - px))
  109.             IF a < 0 THEN a = a + 360
  110.             IF a > 250 AND a < 290 THEN d = 1
  111.             IF a > 70 AND a < 110 THEN d = 2
  112.             IF (a >= 0 AND a < 20) OR (a > 340 AND a <= 360) THEN d = 3
  113.             IF a > 160 AND a < 200 THEN d = 4
  114.         END IF
  115.  
  116.         k$ = INKEY$ 'key press takes precedence over mouse
  117.  
  118.         IF LEN(k$) = 2 THEN
  119.             SELECT CASE ASC(k$, 2)
  120.                 CASE 72: d = 1 'up
  121.                 CASE 80: d = 2 'down
  122.                 CASE 77: d = 3 'right
  123.                 CASE 75: d = 4 'left
  124.             END SELECT
  125.         END IF
  126.         '  _____     ________
  127.         '  |x, y     |x+1, y        the walls of the cell x, y are at right and above,
  128.         '  ________                 x+1 has the next wall and y+1 is the next horizontal separator
  129.         '  |x, y+1
  130.         SELECT CASE d
  131.             CASE 1 'up
  132.                 IF py - 1 >= 0 THEN
  133.                     IF h_walls(px, py) = 0 THEN py = py - 1
  134.                 END IF
  135.             CASE 2 'down
  136.                 IF py + 1 <= H THEN
  137.                     IF h_walls(px, py + 1) = 0 THEN py = py + 1
  138.                 END IF
  139.             CASE 3 'right
  140.                 IF px + 1 <= W - 1 THEN
  141.                     IF v_walls(px + 1, py) = 0 THEN px = px + 1
  142.                 END IF
  143.             CASE 4 'left
  144.                 IF px - 1 >= 0 THEN
  145.                     IF v_walls(px, py) = 0 THEN px = px - 1
  146.                 END IF
  147.         END SELECT
  148.         fcirc (px + .5) * cellW + border, (py + .5) * cellH + border, cellH / 3, &HFF0000FF 'draw player
  149.         _DISPLAY
  150.         _LIMIT 5
  151.         IF px = W - 1 AND py = H THEN EXIT WHILE
  152.     WEND
  153.     _PRINTSTRING (xmax - 580, ymax - 20), "You escaped in" + STR$((TIMER - start) \ 1) + " secs, press any to continue"
  154.     _DISPLAY
  155.     SLEEP
  156.  
  157.  
  158. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  159.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  160.     DIM X AS INTEGER, Y AS INTEGER
  161.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  162.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  163.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  164.     WHILE X > Y
  165.         RadiusError = RadiusError + Y * 2 + 1
  166.         IF RadiusError >= 0 THEN
  167.             IF X <> Y + 1 THEN
  168.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  169.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  170.             END IF
  171.             X = X - 1
  172.             RadiusError = RadiusError - X * 2
  173.         END IF
  174.         Y = Y + 1
  175.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  176.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  177.     WEND
  178.  
  179. ' From SmallBASIC code written by Chris WS developer
  180. ' Backtracking maze generator by chrisws 2016-06-30 now found at
  181. ' https://github.com/smallbasic/smallbasic.github.io/blob/5601c8bc1d794c5b143d863555bb7c15a5966a3c/samples/node/1623.bas
  182. '
  183. ' Chris notes:
  184. ' https://en.wikipedia.org/wiki/Maze_generation_algorithm
  185. ' - Starting from a random cell,
  186. ' - Selects a random neighbouring cell that has not been visited.
  187. ' - Remove the wall between the two cells and marks the new cell as visited,
  188. '   and adds it to the stack to facilitate backtracking.
  189. ' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
  190. '   When at a dead-end it backtracks through the path until it reaches a cell with an
  191. '   unvisited neighbour, continuing the path generation by visiting this new,
  192. '   unvisited cell (creating a new junction).
  193. '   This process continues until every cell has been visited, backtracking all the
  194. '   way back to the beginning cell. We can be sure every cell is visited.
  195.  
  196. SUB init_walls ()
  197.     DIM x AS INTEGER, y AS INTEGER
  198.     FOR x = 0 TO W
  199.         FOR y = 0 TO H
  200.             v_walls(x, y) = 1
  201.             h_walls(x, y) = 1
  202.         NEXT
  203.     NEXT
  204.  
  205. SUB show_maze ()
  206.     DIM py AS SINGLE, px AS SINGLE, y AS INTEGER, x AS INTEGER
  207.     py = border
  208.     FOR y = 0 TO H
  209.         px = border
  210.         FOR x = 0 TO W
  211.             IF x < W AND h_walls(x, y) = 1 THEN
  212.                 LINE (px, py)-STEP(cellW, 2), mazeClr, BF
  213.             END IF
  214.             IF y < H AND v_walls(x, y) = 1 THEN
  215.                 LINE (px, py)-STEP(2, cellH), mazeClr, BF
  216.             END IF
  217.             px = px + cellW
  218.         NEXT
  219.         py = py + cellH
  220.     NEXT
  221.  
  222. SUB rand_cell (rWx, rHy)
  223.     rWx = INT(RND * 1000) MOD W
  224.     rHy = INT(RND * 1000) MOD H
  225.  
  226. SUB get_unvisited (visited() AS INTEGER, current AS cell, unvisited() AS cell, uvi AS INTEGER)
  227.     REDIM unvisited(0) AS cell
  228.     DIM x AS INTEGER, y AS INTEGER
  229.     x = current.x
  230.     y = current.y
  231.     uvi = 0
  232.     IF x > 0 THEN
  233.         IF visited(x - 1, y) = 0 THEN
  234.             uvi = uvi + 1
  235.             REDIM _PRESERVE unvisited(uvi) AS cell
  236.             unvisited(uvi).x = x - 1
  237.             unvisited(uvi).y = y
  238.         END IF
  239.     END IF
  240.     IF x < W - 1 THEN
  241.         IF visited(x + 1, y) = 0 THEN
  242.             uvi = uvi + 1
  243.             REDIM _PRESERVE unvisited(uvi) AS cell
  244.             unvisited(uvi).x = x + 1
  245.             unvisited(uvi).y = y
  246.         END IF
  247.     END IF
  248.     IF y > 0 THEN
  249.         IF visited(x, y - 1) = 0 THEN
  250.             uvi = uvi + 1
  251.             REDIM _PRESERVE unvisited(uvi) AS cell
  252.             unvisited(uvi).x = x
  253.             unvisited(uvi).y = y - 1
  254.         END IF
  255.     END IF
  256.     IF y < H - 1 THEN
  257.         IF visited(x, y + 1) = 0 THEN
  258.             uvi = uvi + 1
  259.             REDIM _PRESERVE unvisited(uvi) AS cell
  260.             unvisited(uvi).x = x
  261.             unvisited(uvi).y = y + 1
  262.         END IF
  263.     END IF
  264.  
  265. SUB generate_maze ()
  266.     DIM visited(W, H) AS INTEGER
  267.     DIM num_visited AS INTEGER, num_cells AS INTEGER, si AS INTEGER
  268.     DIM cnt AS INTEGER, rc AS INTEGER, x AS INTEGER, y AS INTEGER
  269.     REDIM stack(0) AS cell
  270.     DIM curr_cell AS cell, next_cell AS cell, cur_cell AS cell
  271.  
  272.     rand_cell cur_cell.x, cur_cell.y
  273.     visited(curr_cell.x, curr_cell.y) = 1
  274.     num_visited = 1
  275.     num_cells = W * H
  276.     si = 0
  277.     WHILE num_visited < num_cells
  278.         REDIM cells(0) AS cell
  279.         cnt = 0
  280.         get_unvisited visited(), curr_cell, cells(), cnt
  281.         IF cnt > 0 THEN
  282.  
  283.             ' choose randomly one of the current cell's unvisited neighbours
  284.             rc = INT(RND * 100) MOD cnt + 1
  285.             next_cell.x = cells(rc).x
  286.             next_cell.y = cells(rc).y
  287.  
  288.             ' push the current cell to the stack
  289.             si = si + 1
  290.             REDIM _PRESERVE stack(si) AS cell
  291.             stack(si).x = curr_cell.x
  292.             stack(si).y = curr_cell.y
  293.  
  294.             ' remove the wall between the current cell and the chosen cell
  295.             IF next_cell.x = curr_cell.x THEN
  296.                 x = next_cell.x
  297.                 y = max(next_cell.y, curr_cell.y)
  298.                 h_walls(x, y) = 0
  299.             ELSE
  300.                 x = max(next_cell.x, curr_cell.x)
  301.                 y = next_cell.y
  302.                 v_walls(x, y) = 0
  303.             END IF
  304.  
  305.             ' make the chosen cell the current cell and mark it as visited
  306.             curr_cell.x = next_cell.x
  307.             curr_cell.y = next_cell.y
  308.             visited(curr_cell.x, curr_cell.y) = 1
  309.             num_visited = num_visited + 1
  310.  
  311.         ELSEIF si > 0 THEN
  312.  
  313.             ' pop a cell from the stack and make it the current cell
  314.             curr_cell.x = stack(si).x
  315.             curr_cell.y = stack(si).y
  316.             si = si - 1
  317.             REDIM _PRESERVE stack(si) AS cell
  318.  
  319.         ELSE
  320.             EXIT WHILE
  321.         END IF
  322.     WEND
  323.  
  324. FUNCTION max (a, b)
  325.     IF a > b THEN max = a ELSE max = b
  326.  

Just about escaped!.PNG
* Just about escaped!.PNG (Filesize: 16.71 KB, Dimensions: 799x629, Views: 189)
« Last Edit: September 03, 2019, 03:34:52 pm by bplus »

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Maze Generator with notes for using
« Reply #5 on: September 03, 2019, 04:58:37 pm »
Very nice, BPlus! Just recalculate the maze cell into graphical coordinates and then use them to move and the movement will be smooth. I tried it, it's not as easy as writing it...

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Generator with notes for using
« Reply #6 on: September 03, 2019, 09:25:14 pm »
Well so far my record is 14 monsters in 48 secs :D

Marked as best answer by bplus on September 13, 2019, 12:28:27 pm

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Generator with notes for using
« Reply #7 on: September 04, 2019, 12:46:39 am »
Escape from Monster Maze:

We made some faces, used XOR to smooth mouse action a tiny bit, and Luke's timestamp to time deactivation of mouse so it doesn't counteract arrow key presses.

Code: QB64: [Select]
  1. _TITLE "Escape from Monster Maze" 'B+ 2019-09-03
  2. ' 2019-08-31 attempt a better, smoother mouser
  3. ' 2019-09-03 Maze geneartion, nice mouse and arrow key action,
  4. '            momentum removed, just cant turn corners that fast.
  5. ' 2019-09-03 Troubles
  6. ' I either have to loose arrow keys or deactivate mouse or something
  7. ' so arrow key presses are defeated by mouse presence. :-P
  8. ' and still not 100% happy with mouse action. ;(
  9. ' I kicked out walls randomly several for each new monster but not effective for creating
  10. ' alternate paths when dang monsters are ganging up at upper left corner, yikes! no escape!!!
  11. ' to fix that
  12. ' 1. lay out another generated maze over top of current that will create meaningfull alternate route
  13. ' 2. relocate monsters when my guy gets back to start!
  14.  
  15. ' Ok I fixed it so if you start using arrow keys the mouse is disabled for 3 seconds from last arrow press
  16. ' using Luke's time stamp.  This way the mouse position wont counteract arrow key presses.
  17. ' HEY I think XOR smoothed out the mouse action a tiny bit!!! and so did opening up angles
  18. ' directions from mouse to full 90 degrees around 0, 90, 180, 270.
  19.  
  20.  
  21. DECLARE LIBRARY 'give Lukes' timesstamp function a test drive!
  22.     FUNCTION time& (BYVAL null&)
  23.  
  24. CONST xmax = 700, ymax = 700 'screen
  25. CONST W = 15, H = 15, border = 50 'maze cells wide and high
  26. CONST mazeClr = &HFFFF8800
  27.  
  28. TYPE cell
  29.     x AS INTEGER
  30.     y AS INTEGER
  31.  
  32. DIM SHARED stopTime& 'disable mouse influence of player position for 3 sec from last arrow key
  33. DIM SHARED cellW AS SINGLE, cellH AS SINGLE, h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER
  34. cellW = (xmax - 2 * border) / W
  35. cellH = (ymax - 2 * border) / H
  36.  
  37. '        Locals for Main module code
  38. DIM px, py, mx, my, k$, d, a, start, i, j, nMonsters, test AS cell, tmp AS LONG, wayt
  39.  
  40. SCREEN _NEWIMAGE(xmax, ymax, 32)
  41. _SCREENMOVE 100, 20
  42. nMonsters = 3
  43.     init_walls
  44.     generate_maze
  45.     'open gate a bottom right corner to esacpe
  46.     h_walls(W - 1, H) = 0
  47.     nMonsters = nMonsters + 1
  48.     REDIM m(1 TO nMonsters) AS cell
  49.     FOR i = 1 TO nMonsters
  50.         m(i).x = RND * 7 * W / 8 + W / 8 - 1: m(i).y = RND * 7 * H / 8 + H / 8 - 1
  51.         FOR j = 1 TO 2 'for every monster make 4 escape hatches
  52.             test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  53.             WHILE h_walls(test.x, test.y) = 0
  54.                 test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  55.             WEND
  56.             h_walls(test.x, test.y) = 0
  57.             test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  58.             WHILE v_walls(test.x, test.y) = 0
  59.                 test.x = INT(RND * (W - 2)) + 1: test.y = INT(RND * (H - 2)) + 1
  60.             WEND
  61.             v_walls(test.x, test.y) = 0
  62.         NEXT
  63.     NEXT
  64.     px = 0: py = 0: start = TIMER
  65.     WHILE 1
  66.         CLS
  67.         show_maze
  68.         FOR i = 1 TO nMonsters
  69.             'fcirc (m(i).x + .5) * cellW + border, (m(i).y + .5) * cellH + border, cellH / 3, &HFFFF0000
  70.             IF RND < .5 THEN
  71.                 monster1 (m(i).x + .5) * cellW + border, (m(i).y + .5) * cellH + border
  72.             ELSE
  73.                 monster2 (m(i).x + .5) * cellW + border, (m(i).y + .5) * cellH + border
  74.             END IF
  75.             d = INT(RND * 4) + 1
  76.             SELECT CASE d
  77.                 CASE 1 'up
  78.                     IF m(i).y - 1 >= 0 THEN
  79.                         IF h_walls(m(i).x, m(i).y) = 0 THEN m(i).y = m(i).y - 1
  80.                     END IF
  81.                 CASE 2 'down
  82.                     IF m(i).y + 1 <= H - 1 THEN
  83.                         IF h_walls(m(i).x, m(i).y + 1) = 0 THEN m(i).y = m(i).y + 1
  84.                     END IF
  85.                 CASE 3 'right
  86.                     IF m(i).x + 1 <= W - 1 THEN
  87.                         IF v_walls(m(i).x + 1, m(i).y) = 0 THEN m(i).x = m(i).x + 1
  88.                     END IF
  89.                 CASE 4 'left
  90.                     IF m(i).x - 1 >= 0 THEN
  91.                         IF v_walls(m(i).x, m(i).y) = 0 THEN m(i).x = m(i).x - 1
  92.                     END IF
  93.             END SELECT
  94.             IF m(i).x = px AND m(i).y = py THEN
  95.                 'fcirc (px + .5) * cellW + border, (py + .5) * cellH + border, cellH / 3, &HFFFFFFFF 'draw player
  96.                 makeFace (px + .5) * cellW + border, (py + .5) * cellH + border, 1
  97.                 _DISPLAY
  98.                 _DELAY 1
  99.                 px = 0: py = 0
  100.             END IF
  101.         NEXT
  102.         d = 0
  103.         IF mouseOK(0) = -1 THEN
  104.             WHILE _MOUSEINPUT: WEND
  105.             mx = INT((_MOUSEX - border) / cellW): my = INT((_MOUSEY - border) / cellH) 'convert to maze cell
  106.  
  107.             'if the mouse is near the player then it will act as magnet drawing player to it unless wall in way
  108.             IF ABS(mx - px) <> 0 XOR ABS(my - py) <> 0 THEN 'ah ha XOR smooths it out a bit
  109.                 a = _R2D(_ATAN2(my - py, mx - px))
  110.                 IF a < 0 THEN a = a + 360
  111.                 IF a > 225 AND a < 315 THEN d = 1
  112.                 IF a > 45 AND a < 135 THEN d = 2
  113.                 IF (a >= 0 AND a < 45) OR (a > 315 AND a <= 360) THEN d = 3
  114.                 IF a > 135 AND a < 225 THEN d = 4
  115.             ELSE
  116.                 d = 0
  117.             END IF
  118.         END IF
  119.  
  120.         'debug
  121.         'LOCATE 1, 1: PRINT SPACE$(100)
  122.         'LOCATE 1, 1: PRINT px, py, mx, my, mouseOK(0), timestamp&, stopTime&
  123.  
  124.         k$ = INKEY$ 'key press takes precedence over mouse
  125.         IF LEN(k$) = 2 THEN
  126.             SELECT CASE ASC(k$, 2) 'turn off mouse control for 3 secs after arrow press
  127.                 CASE 72: d = 1: tmp = mouseOK(1) 'up
  128.                 CASE 80: d = 2: tmp = mouseOK(1) 'down
  129.                 CASE 77: d = 3: tmp = mouseOK(1) 'right
  130.                 CASE 75: d = 4: tmp = mouseOK(1) 'left
  131.             END SELECT
  132.         END IF
  133.         '  _____     ________
  134.         '  |x, y     |x+1, y        the walls of the cell x, y are at right and above,
  135.         '  ________                 x+1 has the next wall and y+1 is the next horizontal separator
  136.         '  |x, y+1
  137.         SELECT CASE d
  138.             CASE 1 'up
  139.                 IF py - 1 >= 0 THEN
  140.                     IF h_walls(px, py) = 0 THEN py = py - 1
  141.                 END IF
  142.             CASE 2 'down
  143.                 IF py + 1 <= H THEN
  144.                     IF h_walls(px, py + 1) = 0 THEN py = py + 1
  145.                 END IF
  146.             CASE 3 'right
  147.                 IF px + 1 <= W - 1 THEN
  148.                     IF v_walls(px + 1, py) = 0 THEN px = px + 1
  149.                 END IF
  150.             CASE 4 'left
  151.                 IF px - 1 >= 0 THEN
  152.                     IF v_walls(px, py) = 0 THEN px = px - 1
  153.                 END IF
  154.         END SELECT
  155.         'fcirc (px + .5) * cellW + border, (py + .5) * cellH + border, cellH / 3, &HFF0000FF 'draw player
  156.         makeFace (px + .5) * cellW + border, (py + .5) * cellH + border, 0
  157.         _DISPLAY
  158.         _LIMIT 5
  159.         IF px = W - 1 AND py = H THEN EXIT WHILE
  160.     WEND
  161.     _PRINTSTRING (xmax - 580, ymax - 20), "You escaped in" + STR$((TIMER - start) \ 1) + " secs, press any to continue"
  162.     _DISPLAY
  163.     wayt = 1
  164.     WHILE wayt
  165.         WHILE _MOUSEINPUT: WEND
  166.         IF _MOUSEBUTTON(1) THEN wayt = 0
  167.         IF LEN(INKEY$) THEN wayt = 0
  168.     WEND
  169.  
  170. FUNCTION mouseOK% (mode%) '1 set, 0 checks if time is up yes -1, no 0
  171.     IF mode% > 0 THEN 'set
  172.         stopTime& = timestamp& + 3 '3 secs before mouse access
  173.     ELSE
  174.         IF timestamp& - stopTime& > 0 THEN mouseOK% = -1 ELSE mouseOK% = 0
  175.     END IF
  176.  
  177. FUNCTION timestamp& 'try Luke's Timestamp for checking times
  178.     timestamp& = time&(0)
  179.  
  180. SUB makeFace (x, y, white)
  181.     IF white THEN fcirc x, y, cellW / 3, &HFF994422 ELSE fcirc x, y, cellW / 3, &HFFAABBFF
  182.     fcirc x - 3 * cellW / 24, y, cellW / 14, &HFF0000FF
  183.     fcirc x + 3 * cellW / 24, y, cellW / 14, &HFF0000FF
  184.     fcirc x - 3 * cellW / 24, y + 1, cellW / 28, &HFF000000
  185.     fcirc x + 3 * cellW / 24, y + 1, cellW / 28, &HFF000000
  186.     LINE (x - cellW / 12, y + cellW / 6)-STEP(cellW / 6, 2), &HFFFF4444, BF
  187.  
  188. SUB monster1 (x, y)
  189.     fcirc x, y, cellW / 2.5, &HFF990000
  190.     LINE (x - cellW / 6, y - 2)-STEP(cellW / 18, 1), &HFF000000, BF
  191.     LINE (x + cellW / 12, y - 2)-STEP(cellW / 18, 1), &HFF000000, BF
  192.     LINE (x - cellW / 12, y + cellW / 6)-STEP(cellW / 6, 2), &HFF000000, BF
  193.  
  194. SUB monster2 (x, y)
  195.     fcirc x, y, cellW / 2.5, &HFF990000
  196.     LINE (x - cellW / 6, y - 6)-STEP(cellW / 18, 1), &HFF000000, BF
  197.     LINE (x + cellW / 12, y - 6)-STEP(cellW / 18, 1), &HFF000000, BF
  198.     fcirc x, y + cellW / 6, cellW / 6, &HFF000000
  199.  
  200. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  201.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  202.     DIM X AS INTEGER, Y AS INTEGER
  203.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  204.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  205.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  206.     WHILE X > Y
  207.         RadiusError = RadiusError + Y * 2 + 1
  208.         IF RadiusError >= 0 THEN
  209.             IF X <> Y + 1 THEN
  210.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  211.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  212.             END IF
  213.             X = X - 1
  214.             RadiusError = RadiusError - X * 2
  215.         END IF
  216.         Y = Y + 1
  217.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  218.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  219.     WEND
  220.  
  221. ' From SmallBASIC code written by Chris WS developer
  222. ' Backtracking maze generator by chrisws 2016-06-30 now found at
  223. ' https://github.com/smallbasic/smallbasic.github.io/blob/5601c8bc1d794c5b143d863555bb7c15a5966a3c/samples/node/1623.bas
  224. '
  225. ' Chris notes:
  226. ' https://en.wikipedia.org/wiki/Maze_generation_algorithm
  227. ' - Starting from a random cell,
  228. ' - Selects a random neighbouring cell that has not been visited.
  229. ' - Remove the wall between the two cells and marks the new cell as visited,
  230. '   and adds it to the stack to facilitate backtracking.
  231. ' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
  232. '   When at a dead-end it backtracks through the path until it reaches a cell with an
  233. '   unvisited neighbour, continuing the path generation by visiting this new,
  234. '   unvisited cell (creating a new junction).
  235. '   This process continues until every cell has been visited, backtracking all the
  236. '   way back to the beginning cell. We can be sure every cell is visited.
  237.  
  238. SUB init_walls ()
  239.     DIM x AS INTEGER, y AS INTEGER
  240.     FOR x = 0 TO W
  241.         FOR y = 0 TO H
  242.             v_walls(x, y) = 1
  243.             h_walls(x, y) = 1
  244.         NEXT
  245.     NEXT
  246.  
  247. SUB show_maze ()
  248.     DIM py AS SINGLE, px AS SINGLE, y AS INTEGER, x AS INTEGER
  249.     py = border
  250.     FOR y = 0 TO H
  251.         px = border
  252.         FOR x = 0 TO W
  253.             IF x < W AND h_walls(x, y) = 1 THEN
  254.                 LINE (px, py)-STEP(cellW, 2), mazeClr, BF
  255.             END IF
  256.             IF y < H AND v_walls(x, y) = 1 THEN
  257.                 LINE (px, py)-STEP(2, cellH), mazeClr, BF
  258.             END IF
  259.             px = px + cellW
  260.         NEXT
  261.         py = py + cellH
  262.     NEXT
  263.  
  264. SUB rand_cell (rWx, rHy)
  265.     rWx = INT(RND * 1000) MOD W: rHy = INT(RND * 1000) MOD H
  266.  
  267. SUB get_unvisited (visited() AS INTEGER, current AS cell, unvisited() AS cell, uvi AS INTEGER)
  268.     REDIM unvisited(0) AS cell
  269.     DIM x AS INTEGER, y AS INTEGER
  270.     x = current.x: y = current.y: uvi = 0
  271.     IF x > 0 THEN
  272.         IF visited(x - 1, y) = 0 THEN
  273.             uvi = uvi + 1
  274.             REDIM _PRESERVE unvisited(uvi) AS cell
  275.             unvisited(uvi).x = x - 1: unvisited(uvi).y = y
  276.         END IF
  277.     END IF
  278.     IF x < W - 1 THEN
  279.         IF visited(x + 1, y) = 0 THEN
  280.             uvi = uvi + 1
  281.             REDIM _PRESERVE unvisited(uvi) AS cell
  282.             unvisited(uvi).x = x + 1: unvisited(uvi).y = y
  283.         END IF
  284.     END IF
  285.     IF y > 0 THEN
  286.         IF visited(x, y - 1) = 0 THEN
  287.             uvi = uvi + 1
  288.             REDIM _PRESERVE unvisited(uvi) AS cell
  289.             unvisited(uvi).x = x: unvisited(uvi).y = y - 1
  290.         END IF
  291.     END IF
  292.     IF y < H - 1 THEN
  293.         IF visited(x, y + 1) = 0 THEN
  294.             uvi = uvi + 1
  295.             REDIM _PRESERVE unvisited(uvi) AS cell
  296.             unvisited(uvi).x = x: unvisited(uvi).y = y + 1
  297.         END IF
  298.     END IF
  299.  
  300. SUB generate_maze ()
  301.     DIM visited(W, H) AS INTEGER
  302.     DIM num_visited AS INTEGER, num_cells AS INTEGER, si AS INTEGER
  303.     DIM cnt AS INTEGER, rc AS INTEGER, x AS INTEGER, y AS INTEGER
  304.     REDIM stack(0) AS cell
  305.     DIM curr_cell AS cell, next_cell AS cell, cur_cell AS cell
  306.  
  307.     rand_cell cur_cell.x, cur_cell.y
  308.     visited(curr_cell.x, curr_cell.y) = 1
  309.     num_visited = 1: num_cells = W * H: si = 0
  310.     WHILE num_visited < num_cells
  311.         REDIM cells(0) AS cell
  312.         cnt = 0
  313.         get_unvisited visited(), curr_cell, cells(), cnt
  314.         IF cnt > 0 THEN
  315.             ' choose randomly one of the current cell's unvisited neighbours
  316.             rc = INT(RND * 100) MOD cnt + 1
  317.             next_cell.x = cells(rc).x: next_cell.y = cells(rc).y
  318.             ' push the current cell to the stack
  319.             si = si + 1
  320.             REDIM _PRESERVE stack(si) AS cell
  321.             stack(si).x = curr_cell.x: stack(si).y = curr_cell.y
  322.             ' remove the wall between the current cell and the chosen cell
  323.             IF next_cell.x = curr_cell.x THEN
  324.                 x = next_cell.x: y = max(next_cell.y, curr_cell.y)
  325.                 h_walls(x, y) = 0
  326.             ELSE
  327.                 x = max(next_cell.x, curr_cell.x): y = next_cell.y
  328.                 v_walls(x, y) = 0
  329.             END IF
  330.             ' make the chosen cell the current cell and mark it as visited
  331.             curr_cell.x = next_cell.x: curr_cell.y = next_cell.y
  332.             visited(curr_cell.x, curr_cell.y) = 1
  333.             num_visited = num_visited + 1
  334.         ELSEIF si > 0 THEN
  335.             ' pop a cell from the stack and make it the current cell
  336.             curr_cell.x = stack(si).x: curr_cell.y = stack(si).y
  337.             si = si - 1
  338.             REDIM _PRESERVE stack(si) AS cell
  339.         ELSE
  340.             EXIT WHILE
  341.         END IF
  342.     WEND
  343.  
  344. FUNCTION max (a, b)
  345.     IF a > b THEN max = a ELSE max = b
  346.  

Currently marked best answer because example application of getting new mazes to play in AND it's got faces now! :D
Escape from Monster Maze.PNG
* Escape from Monster Maze.PNG (Filesize: 18.93 KB, Dimensions: 699x729, Views: 133)
« Last Edit: September 04, 2019, 09:03:49 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Generator with notes for using and Game example
« Reply #8 on: September 04, 2019, 09:52:08 am »
Oh man! do I have an idea to improve mouse action! :)

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Maze Generator with notes for using and Game example
« Reply #9 on: September 05, 2019, 01:01:50 pm »
For a long time, I've considered making a Rogue-like game, but I never really got around to it.  The idea of being able to zap out random levels at the drop of a hat always seemed a little daunting to me, so I never really bothered to try and do it -- until this morning!

Here's my first run at a little "maze/level generator", which I might just end up using to finally create that little Rogue-like that I've always wanted to make.  It's not quite a maze generator like yours, but it works nicely enough for my needs, and was actually a lot simpler to create than I'd first imagined.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2. REDIM SHARED MapArray(0, 0) AS _BYTE
  3.  
  4.     CLS
  5.     CreateMap 99, 74, 10, 1
  6.     DrawMap
  7.     SLEEP
  8.  
  9.  
  10.  
  11. SUB DrawMap
  12.     FOR y = 0 TO UBOUND(MapArray, 2)
  13.         FOR x = 0 TO UBOUND(MapArray, 1)
  14.             LOCATE y + 1, x + 1
  15.             SELECT CASE MapArray(x, y)
  16.                 CASE -1
  17.                     COLOR 0, &HFF000000
  18.                     PRINT CHR$(219);
  19.                 CASE 2
  20.                     COLOR &HFF000000, &HFF777777
  21.                     PRINT ".";
  22.                 CASE ELSE
  23.                     COLOR &HFF0000FF, &HFF000000
  24.                     PRINT CHR$(219);
  25.             END SELECT
  26.  
  27.         NEXT
  28.     NEXT
  29.  
  30.  
  31.  
  32.  
  33.  
  34. SUB CreateMap (XLimit, YLimit, Rooms, Level)
  35.     ERASE MapArray 'clear the old map and reset everything to 0
  36.     REDIM MapArray(XLimit, YLimit) AS _BYTE
  37.  
  38.     DIM RoomCenterX(Rooms) AS _BYTE, RoomCenterY(Rooms) AS _BYTE
  39.  
  40.     FOR i = 1 TO Rooms
  41.         DO
  42.             RoomSize = INT(RND * 9) + 2
  43.             RoomX = INT(RND * (XLimit - RoomSize))
  44.             RoomY = INT(RND * (YLimit - RoomSize))
  45.             'test for positioning
  46.             good = -1 'it's good starting out
  47.             FOR y = 0 TO RoomSize: FOR x = 0 TO RoomSize
  48.                     IF MapArray(RoomX + x, RoomY + y) = -1 THEN good = 0: EXIT FOR 'don't draw a room on a room
  49.             NEXT x, y
  50.         LOOP UNTIL good
  51.         FOR y = 0 TO RoomSize: FOR x = 0 TO RoomSize
  52.                 MapArray(RoomX + x, RoomY + y) = -1 'go ahead and draw a room
  53.         NEXT x, y
  54.         RoomCenterX(i) = RoomX + .5 * RoomSize
  55.         RoomCenterY(i) = RoomY + .5 * RoomSize
  56.     NEXT
  57.     FOR i = 1 TO Rooms - 1
  58.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  59.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  60.         DO UNTIL StartX = EndX AND StartY = EndY
  61.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  62.             Meander = 20
  63.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  64.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  65.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  66.                     Ychange = 0
  67.                 ELSE
  68.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  69.                     Ychange = 0
  70.                 END IF
  71.             ELSE
  72.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  73.                     Ychange = SGN(EndY - StartY)
  74.                     XChange = 0
  75.                 ELSE
  76.                     Ychange = INT(RND * 3) - 1
  77.                     XChange = 0
  78.                 END IF
  79.             END IF
  80.             StartX = StartX + XChange
  81.             StartY = StartY + Ychange
  82.             IF StartX < 0 THEN StartX = 0
  83.             IF StartY < 0 THEN StartY = 0
  84.             IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
  85.             IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
  86.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 2
  87.         LOOP
  88.     NEXT
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Generator with notes for using and Game example
« Reply #10 on: September 06, 2019, 08:56:48 pm »
For those interested, the game I started is further developed here:
https://www.qb64.org/forum/index.php?topic=1690.0

with two versions, both have smoother mouse action and more developed game.

I look forward to seeing what Steve comes up with for his, at least the basic navigation in his maze.