Author Topic: Pathfinder  (Read 5307 times)

0 Members and 1 Guest are viewing this topic.

Offline Qbee

  • Newbie
  • Posts: 27
    • View Profile
Pathfinder
« on: December 18, 2019, 06:30:22 am »
Hello,

I managed to create a pathfinding tool, named "Pathfinder 1.0 for QB64v1.3", that finds a path from point A to point B, if there is a path. If no path exists, the tool will recognize that and give a message. Otherwise the path is shown on the map.
Actually the map has a size of 100 x 100 fields on a 800 x 600 pixel screen. The values can (slightly?)  be changed to test on others mapsizes; calculations are installed in that way that they can handle variable parameters.
It's far from beeing optimal, but at least it does it's job :)

Animated GIF (Thumb)

Code: QB64: [Select]
  1. '$include:'CONSTANTS_Color.BI'
  2. _TITLE "Pathfinder v1.0 for QB64v1.3"
  3. ' done 2019-12-17 to 2019-12-18
  4. ' by Myself (Karsten Maske)
  5. '
  6. ' ESC to exit program
  7. ' any other key restarts with creating a new random map
  8. '
  9.  
  10. CONST SW = 800
  11. CONST SH = 600
  12. CONST MAPWIDTH = 100 ' 100 on 800 * 600 => 8 pixel width
  13. CONST MAPHEIGHT = 100 ' 100 on 800 * 600 => 6 pixel height
  14. CONST MINX = 1
  15. CONST MAXX = MAPWIDTH
  16. CONST MINY = 1
  17. CONST MAXY = MAPHEIGHT
  18. CONST SQUAREWIDTH = SW / MAPWIDTH
  19. CONST SQUAREHEIGHT = SH / MAPHEIGHT
  20. CONST COST = 1 ' move cost from one square to another; horizontal/vertical = diagonal
  21. CONST YOUSHALLNOTPASS = 32000 ' !! signed integer, stay within positive values
  22.  
  23. TYPE typeNode
  24.     id AS INTEGER ' calculated as y * MAPWIDTH + x
  25.     x AS INTEGER
  26.     y AS INTEGER
  27.     f AS SINGLE '   f(x) = g(x) + c + h(x)
  28.     p AS INTEGER '  previous Node (nodeID)
  29.     oo AS INTEGER ' 1 = on OpenList
  30.     oc AS INTEGER ' 1 = on ClosedList
  31.  
  32. DIM SHARED Nodes(0 TO (MAXY - MINY) * MAPWIDTH + (MAXX - MINX)) AS typeNode
  33. DIM SHARED Map(MINX TO MAXX, MINY TO MAXY) AS INTEGER
  34. DIM SHARED bPathFound AS INTEGER
  35. DIM SHARED bNoPathFound AS INTEGER
  36.  
  37. ' #############################################################################################################
  38. ' <- Definitions
  39. ' -> Initialization
  40. ' #############################################################################################################
  41.  
  42. SCREEN _NEWIMAGE(SW, SH, 32)
  43.  
  44.     CLS
  45.  
  46.     bPathFound = 0
  47.     bNoPathFound = 0
  48.     startX = 6
  49.     startY = MAPHEIGHT - 6
  50.     endX = MAPWIDTH - 6
  51.     endY = 6
  52.  
  53.     InitNodes
  54.     InitMap
  55.     SetWall INT(MAPWIDTH / 2), INT(MAPHEIGHT / 4), INT(MAPWIDTH / 2) + 1, MAPHEIGHT - 5
  56.     SetWall INT(MAPWIDTH / 2) + 1, MAPHEIGHT - 6, INT(MAPWIDTH / 3), MAPHEIGHT - 7
  57.     FOR id = 1 TO 250
  58.         RandomBlock
  59.     NEXT
  60.     PaintMap
  61.     ShowCrow
  62.  
  63.     endID = GetIdFromXY(endX, endY)
  64.     id = GetIdFromXY(startX, startY)
  65.     startID = id
  66.     Nodes(id).x = startX
  67.     Nodes(id).y = startY
  68.     Nodes(id).id = id
  69.     Nodes(id).f = SQR(((startX - endX) ^ 2) + ((startY - endY) ^ 2)) ' only h(x)
  70.     Nodes(id).p = 0
  71.     Nodes(id).oo = 1 ' put on open list
  72.     Nodes(id).oc = 0
  73.  
  74.     ' #############################################################################################################
  75.     ' <- Initialization
  76.     ' -> Main
  77.     ' #############################################################################################################
  78.  
  79.     DO
  80.         _LIMIT 1000
  81.         GetNeighbours
  82.  
  83.     LOOP WHILE (bPathFound = 0) AND (bNoPathFound = 0)
  84.  
  85.     LOCATE 1, 1
  86.     IF bPathFound = 1 THEN
  87.         PRINT "Path found!"
  88.         ShowPath
  89.     ELSEIF bNoPathFound = 1 THEN
  90.         PRINT "No path found!"
  91.     ELSE
  92.         PRINT "Nothing"
  93.     END IF
  94.  
  95.     DO
  96.         a = INKEY$
  97.     LOOP WHILE a = ""
  98.  
  99. LOOP WHILE a <> CHR$(27)
  100.  
  101. ' #############################################################################################################
  102. ' <- Main
  103. ' -> helper
  104. ' #############################################################################################################
  105.  
  106. FUNCTION GetIdFromXY (x AS INTEGER, y AS INTEGER)
  107.     GetIdFromXY = (y - MINY) * MAPWIDTH + (x - MINX)
  108.  
  109. ' #############################################################################################################
  110. ' <- helper
  111. ' -> pathfinding SUBs
  112. ' #############################################################################################################
  113.  
  114. SUB GetNeighbours
  115.  
  116.     DIM x AS INTEGER, y AS INTEGER, x1 AS INTEGER, y1 AS INTEGER
  117.     DIM id AS INTEGER
  118.     DIM ooid AS INTEGER
  119.     DIM f AS SINGLE
  120.  
  121.     ooid = GetMinFromOpenList
  122.     IF ooid = 0 THEN ' nothing on open list
  123.         bNoPathFound = 1
  124.         EXIT SUB
  125.     END IF
  126.  
  127.     x1 = Nodes(ooid).x
  128.     y1 = Nodes(ooid).y
  129.  
  130.     IF ooid <> startID THEN
  131.         PaintBlock ooid, GOLD
  132.     END IF
  133.  
  134.     FOR y = y1 - 1 TO y1 + 1 STEP 1
  135.         IF y >= MINY AND y <= MAXY THEN
  136.             FOR x = x1 - 1 TO x1 + 1 STEP 1
  137.                 IF x >= MINX AND x <= MAXX THEN
  138.                     id = GetIdFromXY(x, y)
  139.                     IF id <> startID THEN
  140.                         IF Nodes(id).oc = 0 THEN ' not yet on closed list
  141.                             IF id <> startID THEN
  142.                                 PaintBlock id, AQUA
  143.                             END IF
  144.                             f = Nodes(ooid).f + Map(x, y) + SQR(((x - endX) ^ 2) + ((y - endY) ^ 2))
  145.                             IF id <> endID THEN
  146.                                 IF Nodes(id).oo THEN ' is on open list
  147.                                     IF Nodes(id).f > f THEN
  148.                                         Nodes(id).p = Nodes(ooid).id
  149.                                         Nodes(id).f = f
  150.                                     END IF
  151.                                 ELSE ' not yet on open list
  152.                                     Nodes(id).f = f
  153.                                     Nodes(id).p = Nodes(ooid).id
  154.                                     Nodes(id).oo = 1 ' put on open list
  155.                                     IF id <> startID THEN
  156.                                         PaintBlock id, DARKORANGE
  157.                                     END IF
  158.                                 END IF
  159.                             ELSE
  160.                                 Nodes(id).p = Nodes(ooid).id
  161.                                 bPathFound = 1
  162.                                 EXIT SUB
  163.                             END IF
  164.                         ELSE
  165.                             IF id <> startID THEN
  166.                                 PaintBlock id, GRAY
  167.                             END IF
  168.                         END IF
  169.                     END IF
  170.                 END IF
  171.             NEXT
  172.         END IF
  173.     NEXT
  174.  
  175.     Nodes(ooid).oc = 1
  176.     Nodes(ooid).oo = 0
  177.     IF ooid <> startID THEN
  178.         PaintBlock ooid, BLACK 'SILVER
  179.     END IF
  180.  
  181. FUNCTION GetMinFromOpenList% ()
  182.     DIM i AS INTEGER, id AS INTEGER
  183.     DIM minf AS SINGLE
  184.  
  185.     minf = 99999.9
  186.     id = 0
  187.  
  188.     FOR i = 0 TO MAXX * MAXY - 1
  189.         IF Nodes(i).oo = 1 THEN
  190.             IF Nodes(i).f > 0 THEN
  191.                 IF Nodes(i).f < minf THEN
  192.                     minf = Nodes(i).f
  193.                     id = i
  194.                 END IF
  195.             END IF
  196.         END IF
  197.     NEXT
  198.     GetMinFromOpenList = id
  199.  
  200.  
  201. SUB InitNodes
  202.     DIM x AS INTEGER, y AS INTEGER, id AS INTEGER
  203.  
  204.     FOR y = MINY TO MAXY
  205.         FOR x = MINX TO MAXX
  206.             id = GetIdFromXY(x, y)
  207.             Nodes(id).id = id
  208.             Nodes(id).x = x
  209.             Nodes(id).y = y
  210.             Nodes(id).f = 0
  211.             Nodes(id).p = 0
  212.             Nodes(id).oo = 0
  213.             Nodes(id).oc = 0
  214.         NEXT
  215.     NEXT
  216.  
  217.  
  218. ' #############################################################################################################
  219. ' <- pathfinding SUBs
  220. ' -> map related non graphical Subs
  221. ' #############################################################################################################
  222.  
  223. SUB InitMap
  224.     DIM x AS INTEGER, x1 AS INTEGER, x2 AS INTEGER
  225.     DIM y AS INTEGER, y1 AS INTEGER, y2 AS INTEGER
  226.  
  227.     FOR y = MINY TO MAXY
  228.         y1 = (y - MINY) * SQUAREHEIGHT
  229.         y2 = y1 + SQUAREHEIGHT - 1
  230.         FOR x = MINX TO MAXX
  231.             Map(x, y) = 1
  232.             x1 = (x - MINX) * SQUAREWIDTH
  233.             x2 = x1 + SQUAREWIDTH - 1
  234.         NEXT
  235.     NEXT
  236.  
  237.  
  238. SUB SetWall (x1, y1, x2, y2)
  239.     DIM x AS INTEGER, y AS INTEGER
  240.  
  241.     IF x1 > x2 THEN
  242.         x = x1
  243.         x1 = x2
  244.         x2 = x
  245.     END IF
  246.  
  247.     IF y1 > y2 THEN
  248.         y = y1
  249.         y1 = y2
  250.         y2 = y
  251.     END IF
  252.  
  253.  
  254.     FOR y = y1 TO y2
  255.         FOR x = x1 TO x2
  256.             Map(x, y) = YOUSHALLNOTPASS
  257.         NEXT
  258.     NEXT
  259.  
  260. SUB RandomBlock
  261.     DIM x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER
  262.     DIM n AS INTEGER
  263.  
  264.     n = INT(RND * 5) + 1
  265.     x1 = INT(RND * (MAPWIDTH - n - 2)) + 1
  266.     x2 = x1 + n - 1
  267.  
  268.     n = INT(RND * 5) + 1
  269.     y1 = INT(RND * (MAPHEIGHT - n - 2)) + 1
  270.     y2 = y1 + n - 1
  271.  
  272.     SetWall x1, y1, x2, y2
  273.  
  274.  
  275. ' #############################################################################################################
  276. ' <- map related non graphical Subs
  277. ' -> map related graphical Subs
  278. ' #############################################################################################################
  279.  
  280. SUB PaintMap
  281.     DIM x AS INTEGER, x1 AS INTEGER, x2 AS INTEGER
  282.     DIM y AS INTEGER, y1 AS INTEGER, y2 AS INTEGER
  283.     DIM col AS LONG
  284.  
  285.     CLS
  286.     FOR y = MINY TO MAXY
  287.         y1 = (y - MINY) * SQUAREHEIGHT
  288.         y2 = y1 + SQUAREHEIGHT - 1
  289.         FOR x = MINX TO MAXX
  290.             x1 = (x - MINX) * SQUAREWIDTH
  291.             x2 = x1 + SQUAREWIDTH - 1
  292.             IF Map(x, y) < YOUSHALLNOTPASS THEN
  293.                 col = FERN
  294.             ELSE
  295.                 col = BLACK
  296.             END IF
  297.             LINE (x1, y1)-(x2, y2), col, BF
  298.             LINE (x1, y1)-(x2, y2), BLACK, B
  299.         NEXT
  300.     NEXT
  301.  
  302.     PlaceStartEnd startX, startY, MAROON
  303.     PlaceStartEnd endX, endY, LAWNGREEN
  304.  
  305.  
  306. SUB PlaceStartEnd (x AS INTEGER, y AS INTEGER, col AS LONG)
  307.     DIM x1 AS INTEGER, x2 AS INTEGER, y1 AS INTEGER, y2 AS INTEGER
  308.  
  309.     x1 = (x - MINX) * SQUAREWIDTH
  310.     x2 = x1 + SQUAREWIDTH - 1
  311.     y1 = (y - MINY) * SQUAREHEIGHT
  312.     y2 = y1 + SQUAREHEIGHT - 1
  313.     LINE (x1, y1)-(x2, y2), col, BF
  314.  
  315.  
  316. SUB ShowCrow
  317.     LINE ((startX - MINX) * SQUAREWIDTH, (startY - MINY) * SQUAREHEIGHT)-((endX - MINX) * SQUAREWIDTH, (endY - MINY) * SQUAREHEIGHT), WHITE
  318.  
  319. SUB ShowPath
  320.     DIM x AS INTEGER, x1 AS INTEGER, x2 AS INTEGER
  321.     DIM y AS INTEGER, y1 AS INTEGER, y2 AS INTEGER
  322.     DIM id AS INTEGER, zid AS INTEGER
  323.  
  324.     PaintMap
  325.  
  326.     zid = GetIdFromXY(startX, startY)
  327.     id = GetIdFromXY(endX, endY)
  328.  
  329.     IF Nodes(id).p THEN
  330.  
  331.         WHILE id <> zid
  332.             x = Nodes(Nodes(id).p).x
  333.             y = Nodes(Nodes(id).p).y
  334.             y1 = (y - MINY) * SQUAREHEIGHT
  335.             y2 = y1 + SQUAREHEIGHT - 1
  336.             x1 = (x - MINX) * SQUAREWIDTH
  337.             x2 = x1 + SQUAREWIDTH - 1
  338.  
  339.             LINE (x1, y1)-(x2, y2), CORNFLOWERBLUE, BF
  340.  
  341.             id = Nodes(id).p
  342.         WEND
  343.     END IF
  344.  
  345.     PlaceStartEnd startX, startY, MAROON
  346.     PlaceStartEnd endX, endY, LAWNGREEN
  347.  
  348.  
  349. SUB PaintBlock (id AS INTEGER, col AS LONG)
  350.     DIM x AS INTEGER, y AS INTEGER
  351.     DIM x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER
  352.  
  353.     x = Nodes(id).x
  354.     y = Nodes(id).y
  355.  
  356.     y1 = (y - MINY) * SQUAREHEIGHT
  357.     y2 = y1 + SQUAREHEIGHT - 1
  358.     x1 = (x - MINX) * SQUAREWIDTH
  359.     x2 = x1 + SQUAREWIDTH - 1
  360.  
  361.     LINE (x1, y1)-(x2, y2), col, BF
  362.  
  363.  

* CONSTANTS_Color.BI (Filesize: 14.14 KB, Downloads: 203)
« Last Edit: December 18, 2019, 07:28:41 am by Qbee »

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Pathfinder
« Reply #1 on: December 18, 2019, 07:05:22 am »
I get the message "color.BI not included"

Offline Qbee

  • Newbie
  • Posts: 27
    • View Profile
Re: Pathfinder
« Reply #2 on: December 18, 2019, 07:30:35 am »
Attached it to the post.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pathfinder
« Reply #3 on: December 18, 2019, 10:08:28 am »
Ha, this looks familiar (haven't run code but judging from GIF and subject name) ;-)

https://www.qb64.org/forum/index.php?topic=410.0

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Pathfinder
« Reply #4 on: December 18, 2019, 10:40:51 am »
Yeah not sure were my work on Warcraft is, I know we came up with a nice A+ style pathfinder for that.
Granted after becoming radioactive I only have a half-life!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pathfinder
« Reply #5 on: December 18, 2019, 11:24:49 am »
Ah! but has anyone yet generated paths through generated mazes?

Challenge?

Offline Qbee

  • Newbie
  • Posts: 27
    • View Profile
Re: Pathfinder
« Reply #6 on: December 18, 2019, 11:27:18 am »
Ok.
So needs 2 tasks:
- code for creating mazes
- code for running the mazes
« Last Edit: December 18, 2019, 11:30:52 am by Qbee »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pathfinder
« Reply #7 on: December 18, 2019, 11:39:38 am »
Ok.
So needs 2 tasks:
- code for creating mazes
- code for running the mazes

Here is Maze generator with notes:
https://www.qb64.org/forum/index.php?topic=1680.msg109179#msg109179

For code running maze, just draw the path from A let's say top left square to B let's say bottom right square, or pick randomly or you say because I have already given the maze generator which might give me advantage ;-) or elect me judge for contest so I have to recuse myself from participating. :)

Wait... just keep it a challenge so all who participate benefit.

A path is possible always with that generator code, the trick is to find shortest.
« Last Edit: December 18, 2019, 11:43:16 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pathfinder
« Reply #8 on: December 18, 2019, 02:59:01 pm »
Colbalt dug up code from over 4 years ago:
https://www.qb64.org/forum/index.php?topic=401.msg2842#msg2842
« Last Edit: December 18, 2019, 03:01:25 pm by bplus »

Offline Qbee

  • Newbie
  • Posts: 27
    • View Profile
Re: Pathfinder
« Reply #9 on: December 18, 2019, 08:41:41 pm »
That is pretty cool!

Alas, I have started to reinvent the wheel. Now I have something to compare my experiments with. Thanks!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pathfinder
« Reply #10 on: December 18, 2019, 09:39:09 pm »
Yeah big difference in the maps created for PathFinder work so far and applying a Pathfinder to a Maze generated by the Maze Generator shown in other link. Though, I think it would be easier to convert a generated maze to a map than to try and find a path with the 2 maze generated arrays for horizontal and vertical walls. I have been stuck there since date of that reply.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Pathfinder
« Reply #11 on: December 19, 2019, 04:36:21 am »
Like this:

Code: QB64: [Select]
  1. _TITLE "PathFinder 2, prepping maze as you read this."
  2.  
  3. 'started 2018-08-11 when Colbalt asked about A* pathfinder
  4. ' He has now 2018-08-12 posted a QB64 version that is nice!
  5.  
  6. ' 2018-08-11 started PathFinder 1
  7. ' 2018-08-12 almost working but buggy backtract to point A after point B is found.
  8. ' 2018-08-13 PathFinder 1a.bas I think I have a fix for buggy path BackTrack but major surgery so this new version
  9. ' 2018-08-14 Pathfinder 2:  2 parts
  10. ' Part 1: creates a map, a random Home point and backtracts all the points available to move over.
  11. ' Part 2: allows clicking variaous points of map to see if path is found.
  12.  
  13. ' 2019-12-19 add Maze Generator code that converts 2 arrays for walls and ceilings to a map for PathFinder 2
  14.  
  15. DEFINT A-Z
  16. CONST xmax = 800
  17. CONST ymax = 600
  18. CONST border = 0
  19. CONST sq = 10
  20. CONST W = 40
  21. CONST H = 30
  22. CONST mapw = 2 * W + 1
  23. CONST maph = 2 * H + 1
  24.  
  25. 'generator
  26. TYPE cell
  27.     x AS INTEGER
  28.     y AS INTEGER
  29.  
  30. DIM SHARED h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER
  31. DIM SHARED map(1 TO 2 * W + 1, 1 TO 2 * H + 1) AS STRING * 6
  32.  
  33. SCREEN _NEWIMAGE(xmax + 11, ymax + 11, 32)
  34. _SCREENMOVE (1280 - xmax) / 2 + 30, (760 - ymax) / 2
  35.  
  36. DIM ax, ay, bx, by
  37. DIM y, x, parentF, tick, parentx, changes$, ystart, ystop, xStart, xStop, xxStart, xxStop, yyStart, yyStop, cf, xx, yy
  38. DIM new$, newxy$, newParent$, u, v, mx, my, ps$, parenty
  39.  
  40.     'this part sets up a sample map and get's the Backtracking build into map
  41.  
  42.     FOR y = 1 TO maph 'clear and initialize map
  43.         FOR x = 1 TO mapw
  44.             map(x, y) = " "
  45.         NEXT
  46.     NEXT
  47.     'maze generator
  48.     init_walls
  49.     generate_maze
  50.     fillMap 'convert walls to map and outline borders
  51.  
  52.     ax = 2 * W: ay = 2 * H ' here is the target, a for anchor that all paths must go
  53.     map(ax, ay) = "A"
  54.     parentF = 1: tick = 0: parentx = 0
  55.     WHILE parentF = 1 AND parentx = 0
  56.         parentF = 0: tick = tick + 1: changes$ = ""
  57.         ystart = max(ay - tick, 1): ystop = min(ay + tick, maph)
  58.         FOR y = ystart TO ystop
  59.             xStart = max(ax - tick, 1): xStop = min(ax + tick, mapw)
  60.             FOR x = xStart TO xStop
  61.                 'check out the neighbors
  62.                 IF x - 1 >= 1 THEN xxStart = x - 1 ELSE xxStart = x
  63.                 IF x + 1 <= mapw THEN xxStop = x + 1 ELSE xxStop = x
  64.                 IF y - 1 >= 1 THEN yyStart = y - 1 ELSE yyStart = y
  65.                 IF y + 1 <= maph THEN yyStop = y + 1 ELSE yyStop = y
  66.                 IF RTRIM$(map(x, y)) = "" THEN
  67.                     cf = 0
  68.                     FOR yy = yyStart TO yyStop
  69.                         FOR xx = xxStart TO xxStop
  70.                             IF xx <> x OR yy <> y THEN
  71.                                 IF RTRIM$(map(xx, yy)) = "A" OR INSTR(RTRIM$(map(xx, yy)), ",") > 0 THEN 'found a parent to assign to cell
  72.                                     changes$ = changes$ + LTRIM$(STR$(x)) + "," + LTRIM$(STR$(y)) + "{" + LTRIM$(STR$(xx)) + "," + LTRIM$(STR$(yy)) + "}"
  73.                                     parentF = 1 'so will continue looping
  74.                                     cf = 1: EXIT FOR
  75.                                 END IF
  76.                             END IF
  77.                         NEXT
  78.                         IF cf THEN EXIT FOR
  79.                     NEXT
  80.                 END IF
  81.             NEXT
  82.         NEXT
  83.         'update map with cells assigned parents
  84.         WHILE changes$ <> ""
  85.             new$ = leftOf$(changes$, "}")
  86.             changes$ = rightOf$(changes$, "}")
  87.             newxy$ = leftOf$(new$, "{")
  88.             newParent$ = rightOf$(new$, "{")
  89.             u = VAL(leftOf$(newxy$, ",")): v = VAL(rightOf$(newxy$, ","))
  90.             map(u, v) = leftOf$(newParent$, ",") + "," + rightOf$(newParent$, ",")
  91.         WEND
  92.         _LIMIT 300
  93.     WEND
  94.  
  95.  
  96.     'this parts displays the ability to find a path to blue square anywhere in the maze
  97.  
  98.     _TITLE "Click maze to find a path to blue square (if any), c = clear, n = new map, esc = quit"
  99.     displayM
  100.     DO
  101.         WHILE _MOUSEINPUT: WEND
  102.         IF _MOUSEBUTTON(1) THEN
  103.             mx = _MOUSEX - .5 * sq: my = _MOUSEY - .5 * sq
  104.             bx = mx / sq + 1: by = my / sq + 1
  105.             IF bx >= 1 AND bx <= mapw AND by >= 1 AND by <= maph THEN
  106.                 LINE ((bx - 1) * sq + 2, (by - 1) * sq + 2)-STEP(sq - 4, sq - 4), &HFFFFFF000, BF
  107.                 ps$ = map(bx, by)
  108.                 parentx = VAL(leftOf$(ps$, ","))
  109.                 parenty = VAL(rightOf$(ps$, ","))
  110.                 IF parentx THEN 'backtrack to A   note: B could be right next to A!!!
  111.                     LINE ((parentx - 1) * sq + 3, (parenty - 1) * sq + 3)-STEP(sq - 6, sq - 6), &HFFFFFFFF, BF
  112.                     WHILE parentx 'trace the path back
  113.                         ps$ = map(parentx, parenty)
  114.                         parentx = VAL(leftOf$(ps$, ","))
  115.                         parenty = VAL(rightOf$(ps$, ","))
  116.                         LINE ((parentx - 1) * sq + 3, (parenty - 1) * sq + 3)-STEP(sq - 6, sq - 6), &HFFFFFFFF, BF
  117.                         _LIMIT 10
  118.                         _DISPLAY
  119.                     WEND
  120.                     BEEP
  121.                 ELSE
  122.                     COLOR &HFFFFFFFF
  123.                     LOCATE 15, 10: PRINT "Did not connect to B"
  124.                     _DISPLAY
  125.                     _DELAY 3
  126.                     displayM
  127.                 END IF
  128.             END IF
  129.         END IF
  130.         IF _KEYDOWN(27) THEN END
  131.         IF _KEYDOWN(ASC("n")) THEN EXIT DO
  132.         IF _KEYDOWN(ASC("c")) THEN displayM
  133.         _DISPLAY
  134.         _LIMIT 100
  135.     LOOP
  136.  
  137. SUB displayM ()
  138.     DIM y, x, k AS _UNSIGNED LONG
  139.     FOR y = 1 TO maph
  140.         FOR x = 1 TO mapw
  141.             SELECT CASE RTRIM$(map(x, y))
  142.                 CASE "A": k = &HFF0000FF 'target
  143.                 CASE "B": k = &HFFFFBB00 'border
  144.                 CASE "O": k = &HFF008800 'maze wall
  145.                 CASE ELSE: k = &HFF000000
  146.             END SELECT
  147.             LINE ((x - 1) * sq, (y - 1) * sq)-STEP(sq, sq), k, BF
  148.         NEXT
  149.     NEXT
  150.  
  151. FUNCTION rand% (lo%, hi%)
  152.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  153.  
  154. FUNCTION min (n1, n2)
  155.     IF n1 > n2 THEN min = n2 ELSE min = n1
  156.  
  157. FUNCTION max (n1, n2)
  158.     IF n1 < n2 THEN max = n2 ELSE max = n1
  159.  
  160. FUNCTION leftOf$ (source$, of$)
  161.     DIM posOf
  162.     posOf = INSTR(source$, of$)
  163.     IF posOf > 0 THEN leftOf$ = MID$(source$, 1, posOf - 1)
  164.  
  165. FUNCTION rightOf$ (source$, of$)
  166.     DIM posOf
  167.     posOf = INSTR(source$, of$)
  168.     IF posOf > 0 THEN rightOf$ = MID$(source$, posOf + LEN(of$))
  169.  
  170. SUB init_walls ()
  171.     DIM x AS INTEGER, y AS INTEGER
  172.     FOR x = 0 TO W
  173.         FOR y = 0 TO H
  174.             v_walls(x, y) = 1
  175.             h_walls(x, y) = 1
  176.         NEXT
  177.     NEXT
  178.  
  179. 'this takes the generted maze and loads the Map string array
  180. SUB fillMap ()
  181.     DIM y AS INTEGER, x AS INTEGER
  182.     FOR y = 0 TO H
  183.         FOR x = 0 TO W
  184.             IF x < W AND h_walls(x, y) = 1 THEN
  185.                 map(2 * x + 1, 2 * y + 1) = "O": map(2 * x + 2, 2 * y + 1) = "O": map(2 * x + 3, 2 * y + 1) = "O"
  186.             END IF
  187.             IF y < H AND v_walls(x, y) = 1 THEN
  188.                 map(2 * x + 1, 2 * y + 1) = "O": map(2 * x + 1, 2 * y + 2) = "O": map(2 * x + 1, 2 * y + 3) = "O"
  189.             END IF
  190.         NEXT
  191.     NEXT
  192.     FOR x = 0 TO W - 1
  193.         map(2 * x + 1, 1) = "B": map(2 * x + 2, 1) = "B": map(2 * x + 3, 1) = "B"
  194.         map(2 * x + 1, 2 * H + 1) = "B": map(2 * x + 2, 2 * H + 1) = "B": map(2 * x + 3, 2 * H + 1) = "B"
  195.     NEXT
  196.     FOR y = 0 TO H - 1
  197.         map(1, 2 * y + 1) = "B": map(1, 2 * y + 2) = "B": map(1, 2 * y + 3) = "B"
  198.         map(2 * W + 1, 2 * y + 1) = "B": map(2 * W + 1, 2 * y + 2) = "B": map(2 * W + 1, 2 * y + 3) = "B"
  199.     NEXT
  200.  
  201. '   Maze Generator Code
  202. '
  203. ' 2019-09-02 isolated and updated generator code for OPTION _EXPLICIT
  204. ' from trans 2018-06-15 for Amazing Rat.bas (QB64)
  205. ' From SmallBASIC code written by Chris WS developer
  206. ' Backtracking maze generator by chrisws 2016-06-30 now found at
  207. ' https://github.com/smallbasic/smallbasic.github.io/blob/5601c8bc1d794c5b143d863555bb7c15a5966a3c/samples/node/1623.bas
  208. '
  209. ' Chris notes:
  210. ' https://en.wikipedia.org/wiki/Maze_generation_algorithm
  211. ' - Starting from a random cell,
  212. ' - Selects a random neighbouring cell that has not been visited.
  213. ' - Remove the wall between the two cells and marks the new cell as visited,
  214. '   and adds it to the stack to facilitate backtracking.
  215. ' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
  216. '   When at a dead-end it backtracks through the path until it reaches a cell with an
  217. '   unvisited neighbour, continuing the path generation by visiting this new,
  218. '   unvisited cell (creating a new junction).
  219. '   This process continues until every cell has been visited, backtracking all the
  220. '   way back to the beginning cell. We can be sure every cell is visited.
  221. '
  222.  
  223. 'B+ notes for using:
  224. ' The most important item is that the maze uses 2 arrays one for vertical walls the other for horizontal
  225. ' CONST xmax, ymax is pixel size used in maze coder, using SW, SH for screen dimensions
  226. ' Maze should mount in top left corner of screen with min border space around it at left and top at least.
  227. ' CONST W, H - number of cells Wide and High you can specify.
  228. ' CONST wallThk - adjusts thickness of walls
  229. ' CONST mazeClr - colors walls made with BF in LINE statement
  230. ' CONST border - will create a space around the maze
  231. ' SHARED cellW, cellH - are pixels sizes for cell, see calcs before SCREEN command
  232. ' SHARED  h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER - these are your Maze, 0 no wall, 1 = wall
  233. ' When player occupies cell x, y that cell may v_wall that blocks player going left;
  234. ' a cell v_wall(x+1, y) = 1 will block a player going right;
  235. ' cell (x, y) may have an h_wall that stops player from going up;
  236. ' cell (x, y+1) may have h_wall that stops player at x, y from going down.
  237. ' Cells at (W, y) should not be occupied with W cells wide and array base 0 only W-1 can be occupied
  238. ' unless game needs something special.
  239. ' Likewise cells at (x, H) should only provide wall to stop player from going out of box.
  240.  
  241.  
  242. SUB rand_cell (rWx, rHy)
  243.     rWx = INT(RND * 1000) MOD W
  244.     rHy = INT(RND * 1000) MOD H
  245.  
  246. SUB get_unvisited (visited() AS INTEGER, current AS cell, unvisited() AS cell, uvi AS INTEGER)
  247.     REDIM unvisited(0) AS cell
  248.     DIM x AS INTEGER, y AS INTEGER
  249.     x = current.x
  250.     y = current.y
  251.     uvi = 0
  252.     IF x > 0 THEN
  253.         IF visited(x - 1, y) = 0 THEN
  254.             uvi = uvi + 1
  255.             REDIM _PRESERVE unvisited(uvi) AS cell
  256.             unvisited(uvi).x = x - 1
  257.             unvisited(uvi).y = y
  258.         END IF
  259.     END IF
  260.     IF x < W - 1 THEN
  261.         IF visited(x + 1, y) = 0 THEN
  262.             uvi = uvi + 1
  263.             REDIM _PRESERVE unvisited(uvi) AS cell
  264.             unvisited(uvi).x = x + 1
  265.             unvisited(uvi).y = y
  266.         END IF
  267.     END IF
  268.     IF y > 0 THEN
  269.         IF visited(x, y - 1) = 0 THEN
  270.             uvi = uvi + 1
  271.             REDIM _PRESERVE unvisited(uvi) AS cell
  272.             unvisited(uvi).x = x
  273.             unvisited(uvi).y = y - 1
  274.         END IF
  275.     END IF
  276.     IF y < H - 1 THEN
  277.         IF visited(x, y + 1) = 0 THEN
  278.             uvi = uvi + 1
  279.             REDIM _PRESERVE unvisited(uvi) AS cell
  280.             unvisited(uvi).x = x
  281.             unvisited(uvi).y = y + 1
  282.         END IF
  283.     END IF
  284.  
  285. SUB generate_maze ()
  286.     DIM visited(W, H) AS INTEGER
  287.     DIM num_visited AS INTEGER, num_cells AS INTEGER, si AS INTEGER
  288.     DIM cnt AS INTEGER, rc AS INTEGER, x AS INTEGER, y AS INTEGER
  289.     REDIM stack(0) AS cell
  290.     DIM curr_cell AS cell, next_cell AS cell, cur_cell AS cell
  291.  
  292.     rand_cell cur_cell.x, cur_cell.y
  293.     visited(curr_cell.x, curr_cell.y) = 1
  294.     num_visited = 1
  295.     num_cells = W * H
  296.     si = 0
  297.     WHILE num_visited < num_cells
  298.         REDIM cells(0) AS cell
  299.         cnt = 0
  300.         get_unvisited visited(), curr_cell, cells(), cnt
  301.         IF cnt > 0 THEN
  302.  
  303.             ' choose randomly one of the current cell's unvisited neighbours
  304.             rc = INT(RND * 100) MOD cnt + 1
  305.             next_cell.x = cells(rc).x
  306.             next_cell.y = cells(rc).y
  307.  
  308.             ' push the current cell to the stack
  309.             si = si + 1
  310.             REDIM _PRESERVE stack(si) AS cell
  311.             stack(si).x = curr_cell.x
  312.             stack(si).y = curr_cell.y
  313.  
  314.             ' remove the wall between the current cell and the chosen cell
  315.             IF next_cell.x = curr_cell.x THEN
  316.                 x = next_cell.x
  317.                 y = max(next_cell.y, curr_cell.y)
  318.                 h_walls(x, y) = 0
  319.             ELSE
  320.                 x = max(next_cell.x, curr_cell.x)
  321.                 y = next_cell.y
  322.                 v_walls(x, y) = 0
  323.             END IF
  324.  
  325.             ' make the chosen cell the current cell and mark it as visited
  326.             curr_cell.x = next_cell.x
  327.             curr_cell.y = next_cell.y
  328.             visited(curr_cell.x, curr_cell.y) = 1
  329.             num_visited = num_visited + 1
  330.  
  331.         ELSEIF si > 0 THEN
  332.  
  333.             ' pop a cell from the stack and make it the current cell
  334.             curr_cell.x = stack(si).x
  335.             curr_cell.y = stack(si).y
  336.             si = si - 1
  337.             REDIM _PRESERVE stack(si) AS cell
  338.  
  339.         ELSE
  340.             EXIT WHILE
  341.         END IF
  342.     WEND
  343.  
  344.  

There's one off my bucket list :)

 
Pathfinder inside a generated maze.PNG