Author Topic: B+ Pathfinder  (Read 12451 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+ Pathfinder
« Reply #15 on: August 15, 2018, 07:35:39 pm »
Hi Steve,

Nice code! I love the way you did CalculateTravel. I am sitting here wondering, "How come he doesn't have to worry about "Out of Bounds Errors" with the array checks and assignments. Oh ha! It's the border that is saving us from that.

I did give your code a stress test by increasing the obstacle density to  27 * 27 * .8 and found a situation where the iterations did not go far enough.
 
Along path.PNG


Still your way of illustrating the steps of path is nice for human understanding. The numbers make it easy to spot a path.

Oh hey! there is a _Trim$ keyword! I never thought to check a _version.

From now on, my maps are surely gonna have borders!
« Last Edit: August 15, 2018, 07:38:21 pm by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: B+ Pathfinder
« Reply #16 on: August 15, 2018, 09:41:47 pm »
Hi Steve,

Nice code! I love the way you did CalculateTravel. I am sitting here wondering, "How come he doesn't have to worry about "Out of Bounds Errors" with the array checks and assignments. Oh ha! It's the border that is saving us from that.

I did give your code a stress test by increasing the obstacle density to  27 * 27 * .8 and found a situation where the iterations did not go far enough.

Still your way of illustrating the steps of path is nice for human understanding. The numbers make it easy to spot a path.

Oh hey! there is a _Trim$ keyword! I never thought to check a _version.

From now on, my maps are surely gonna have borders!

Usually, I define my maps as being from (-1 TO size + 1, -1 TO size + 1).  That way, I know I'll always be able to check the borders from 0 TO size, without ever having to worry about those "Out of Bounds" errors you mentioned.  ;)

And here's an  updated version that will go as long as it can, in an attempt to make the path for us:

Code: QB64: [Select]
  1. CONST StepByStep = -1 '-1 for TRUE, 0 for FALSE
  2.  
  3.  
  4.  
  5. SCREEN _NEWIMAGE(800, 600, 32)
  6. DIM SHARED Map(0 TO 26, 0 TO 26) AS INTEGER
  7.  
  8. TYPE Coordinate
  9.     x AS INTEGER
  10.     y AS INTEGER
  11.  
  12. DIM SHARED HeroPosition AS Coordinate
  13. DIM SHARED TargetPosition AS Coordinate
  14.  
  15. f = _LOADFONT(".\cyberbit.ttf", 8, "monospace")
  16.  
  17.     'Clear Variables for a second run
  18.     _FONT 16
  19.     FOR x = 0 TO 26
  20.         FOR y = 0 TO 26
  21.             Map(x, y) = -1
  22.     NEXT y, x
  23.     HeroPosition.x = 0
  24.     HeroPosition.y = 0
  25.     TargetPosition.x = 0
  26.     TargetPosition.y = 0
  27.  
  28.     FOR i = 0 TO 26 'Create Border
  29.         Map(i, 0) = -2: Map(i, 26) = -2 'Filled
  30.         Map(0, i) = -2: Map(26, i) = -2 'Filled
  31.     NEXT
  32.  
  33.     FOR i = 1 TO 200 'Create Obsticals
  34.         x = INT(RND * 26) + 1
  35.         y = INT(RND * 26) + 1
  36.         Map(x, y) = -2 'Filled
  37.     NEXT
  38.  
  39.     'Place Hero
  40.  
  41.  
  42.     DrawMap
  43.     LOCATE 20, 70: PRINT "Use Mouse to place Hero"
  44.     DO
  45.         _LIMIT 30
  46.         WHILE _MOUSEINPUT: WEND
  47.         XPos = (_MOUSEX - 20) \ 20
  48.         YPos = (_MOUSEY - 20) \ 20
  49.         IF XPos > 0 AND XPos < 26 AND YPos > 0 AND YPos < 26 THEN
  50.             IF _MOUSEBUTTON(1) AND (Map(XPos, YPos) <> -2) THEN
  51.                 HeroPosition.x = XPos
  52.                 HeroPosition.y = YPos
  53.                 EXIT DO
  54.             ELSEIF _MOUSEBUTTON(2) THEN GOTO redo
  55.             END IF
  56.         END IF
  57.     LOOP
  58.     DrawMap
  59.  
  60.     LOCATE 20, 70: PRINT "Use Mouse to place Target"
  61.     DO
  62.         _LIMIT 30
  63.         WHILE _MOUSEINPUT: WEND
  64.         XPos = (_MOUSEX - 20) \ 20
  65.         YPos = (_MOUSEY - 20) \ 20
  66.         IF XPos > 0 AND XPos < 26 AND YPos > 0 AND YPos < 26 THEN
  67.             IF _MOUSEBUTTON(1) AND (Map(XPos, YPos) <> -2) AND XPos <> HeroPosition.x AND YPos <> HeroPosition.y THEN
  68.                 TargetPosition.x = XPos
  69.                 TargetPosition.y = YPos
  70.                 EXIT DO
  71.             END IF
  72.         END IF
  73.     LOOP
  74.     _FONT f
  75.  
  76.     CalculateTravel
  77.     DrawMap
  78.  
  79.     DO
  80.         _LIMIT 30
  81.         i$ = INKEY$
  82.         IF i$ = CHR$(27) THEN SYSTEM
  83.     LOOP UNTIL i$ <> ""
  84.  
  85.  
  86.     redo:
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93. SUB DrawMap
  94.     CLS
  95.     IF HeroPosition.x <> 0 AND HeroPosition.y <> 0 THEN LINE (20 * HeroPosition.x + 20, 20 * HeroPosition.y + 20)-STEP(20, 20), &HFFFF0000, BF
  96.     IF TargetPosition.x <> 0 AND TargetPosition.y <> 0 THEN LINE (20 * TargetPosition.x + 20, 20 * TargetPosition.y + 20)-STEP(20, 20), &HFFFFFF00, BF
  97.     FOR x = 0 TO 26
  98.         FOR y = 0 TO 26
  99.             IF Map(x, y) = -2 THEN
  100.                 LINE (20 * x + 20, 20 * y + 20)-STEP(20, 20), -1, BF
  101.             ELSE
  102.                 LINE (20 * x + 20, 20 * y + 20)-STEP(20, 20), -1, B
  103.                 IF Map(x, y) > 0 THEN _PRINTSTRING (20 * x + 21, 20 * y + 21), _TRIM$(STR$(Map(x, y)))
  104.             END IF
  105.     NEXT y, x
  106.  
  107. SUB CalculateTravel
  108.     'Start at  TargetDestination
  109.     Map(TargetPosition.x, TargetPosition.y) = 0
  110.     i = 0
  111.     DO
  112.         mapchanged = 0
  113.         FOR x = 1 TO 25
  114.             FOR y = 1 TO 25
  115.                 IF Map(x, y) = i THEN
  116.                     IF Map(x - 1, y - 1) = -1 THEN Map(x - 1, y - 1) = i + 1: mapchanged = -1
  117.                     IF Map(x, y - 1) = -1 THEN Map(x, y - 1) = i + 1: mapchanged = -1
  118.                     IF Map(x + 1, y - 1) = -1 THEN Map(x + 1, y - 1) = i + 1: mapchanged = -1
  119.                     IF Map(x - 1, y) = -1 THEN Map(x - 1, y) = i + 1: mapchanged = -1
  120.                     IF Map(x + 1, y) = -1 THEN Map(x + 1, y) = i + 1: mapchanged = -1
  121.                     IF Map(x - 1, y + 1) = -1 THEN Map(x - 1, y + 1) = i + 1: mapchanged = -1
  122.                     IF Map(x, y + 1) = -1 THEN Map(x, y + 1) = i + 1: mapchanged = -1
  123.                     IF Map(x + 1, y + 1) = -1 THEN Map(x + 1, y + 1) = i + 1: mapchanged = -1
  124.                 END IF
  125.                 IF Map(HeroPosition.x, HeroPosition.y) <> -1 THEN EXIT SUB
  126.             NEXT
  127.         NEXT
  128.         IF StepByStep THEN
  129.             DrawMap
  130.             _DELAY 1 'A second delay so the user can watch us find the path
  131.         END IF
  132.         i = i + 1
  133.     LOOP UNTIL mapchanged = 0
  134.  


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: B+ Pathfinder
« Reply #17 on: August 18, 2018, 04:57:43 pm »
Finally, I managed to assimilate Steve's simplifications to Pathfinder and to go from there to making persisting paths from Hero to destination goal. Now set a destination and the pathfinder will draw you a path to it no matter where you move the hero (if a path exists). Click again and a new persisting path is maintained (if one exits). To reach the destination just follow the yellow brick road.

I also started some game code for hauling Hedge obstacles around to rearrange hedge but I think pushing is needed to. Now, if a path does not exist, you might be able to haul some hedge around and open one up.

Oh you can also move the hero diagonally if you have number keypad but can't haul diagonally.

Anyway here is Pathfinder 3a:
Code: QB64: [Select]
  1. _TITLE "PathFinder 3a, prepping MAP as you read this."
  2. 'QB64 X 64 version 1.2 20180228/86  from git b301f92
  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. ' 2018-08-15 PathFinder 3: Make a function that returns a path from A to B given A, B
  14. ' The map is shared as well as it's dimensions mapw by maph (constants).
  15. ' The function will create a copy of map and work with that so main map remains intact.
  16. ' Well I suppose we need aa random map maker for starters.
  17. ' And then of course a sub to display the map.
  18. ' OK I am now working under the influence of Steve McNeil's programs. ;)
  19. ' Thanks Steve some great ideas for simplfying the PathFinder for actual game use.
  20.  
  21. ' 2018-08-17 With Pathfinder 3 I want to start working code towards game using MAP(s)
  22. ' I am also under the influence of PMACKAY's game series Mr Bash or Dash or whatever he decides to call the Diamond Miner.
  23. ' Thanks PMACKAY, I love the little game you started and have learned from your questions and setup.
  24.  
  25. '2018-08-18 Pathfinder 3a, I have 3 working with ticks but it changes all after running through the whole tick session.
  26. ' 3a tests whether I can do this with Steve's version which changes immediately and not after whole tick session.
  27. ' It is allot simpler and will run faster than saving all changes in a container and reprocessing into step array.
  28. ' I tried this before but I think I know what I did wrong then, I did not check if value was = current tick.
  29. ' Before I think I just checked if the map had a value or not written in, no only current tick values should parent a new cell.
  30. ' Finally found the frick'in bug!!! had cy instead of cx, OK let's see if can draw the path from Steps array.
  31. ' OK now prepStepMap in called in the Path routine and working.
  32.  
  33.  
  34.  
  35. DEFINT A-Z
  36. ' Using ALL CAP's for CONSTants, user defined TYPE, and SHARED variables,
  37. ' but short mnuemonic abrev because I hate typing long descriptions,
  38. ' so if you forget what the cap'd variable name means, check back to this main section.
  39. CONST TRUE = -1
  40. CONST FALSE = 0
  41. CONST WW = 960 '  Window Width  in pixels
  42. CONST WH = 720 '  Window Height in pixels
  43. CONST SQ = 30 '   Square Size in pixels
  44. CONST MAPW = 30 ' MAP number of squares Wide or Width
  45. CONST MAPH = 20 ' MAP number of squares High or Height
  46.  
  47. ' MAP ITEMS  I will probably be using ideas from PMACKAY's Mr Bash or Dash or whatever he decides to call the Diamond Miner Game
  48. CONST HERO = -1
  49. CONST BORDER = -2
  50. CONST OBSTACLE = -3
  51. CONST SPACER = 0
  52. CONST DOOR = -4
  53.  
  54. 'following Steve's example
  55. TYPE COORDINATE
  56.     x AS INTEGER
  57.     y AS INTEGER
  58.  
  59. SCREEN _NEWIMAGE(WW, WH, 32)
  60. _SCREENMOVE _MIDDLE ' ah this is working better now! is it the 64X64 version?
  61.  
  62. 'The MAP:
  63. 'Decided to use integer values with Descriptive CONST names, thanks Tempodibasic
  64. 'There will be a 1 SQ Border around the Map, the actual squares for game action run 1 to MAPW, 1 to MAPH
  65. DIM SHARED MAP(MAPW + 2, MAPH + 2) AS INTEGER
  66. DIM SHARED HC AS COORDINATE 'Hero Coordinate
  67. DIM SHARED HDC AS COORDINATE 'Hero Destination Coordinate
  68. DIM SHARED MX AS COORDINATE 'Map Exit
  69. 'This will be a map used for getting paths from HC = Hero Coordinate  to HDC = Hero Destination Coordinate
  70. DIM SHARED STEPMAP(MAPW + 2, MAPH + 2) AS INTEGER
  71. DIM SHARED STEPS(MAPH * MAPW) AS COORDINATE
  72. DIM SHARED STEPSI AS INTEGER 'counts steps
  73. DIM SHARED OFFX, OFFY, HAULERMODE AS _BYTE
  74. DIM t AS COORDINATE
  75. OFFX = (WW - SQ * (MAPW + 2)) / 2
  76. OFFY = (WH - SQ * (MAPH + 2)) / 2
  77. 'f = _LOADFONT("cyberbit.ttf", 8, "monospace") ' I copy/pasted into my Pathfinder Folder
  78. 'currFont& = _FONT(0)
  79. HAULERMODE = 0
  80.  
  81.     'this part sets up a sample map and get's the Backtracking build into map
  82.  
  83.     RandomMap .7
  84.     HC.x = Rand(1, MAPW): HC.y = Rand(1, MAPH)
  85.     MAP(HC.x, HC.y) = HERO
  86.  
  87.  
  88.     'this parts displays the ability to find a path to blue square anywhere in the maze
  89.  
  90.     _TITLE "Click maze to display from Hero (white) a path to blue square (if any), c = clear, n = new map, esc = quit"
  91.     displayMap
  92.     DO
  93.         'CLS
  94.         displayMap
  95.         WHILE _MOUSEINPUT: WEND
  96.         IF _MOUSEBUTTON(1) THEN
  97.             xm = _MOUSEX - OFFX - .5 * SQ
  98.             ym = _MOUSEY - OFFY - .5 * SQ
  99.             t.x = xm / SQ: t.y = ym / SQ 'type error
  100.             LINE (t.x * SQ + OFFX + 1, t.y * SQ + OFFY + 1)-STEP(SQ - 3, SQ - 3), _RGB32(255, 0, 0), BF
  101.             IF t.x >= 1 AND t.x <= MAPW AND t.y >= 1 AND t.y <= MAPH THEN
  102.                 HDC.x = t.x: HDC.y = t.y
  103.                 'path HDC
  104.                 _DISPLAY
  105.                 '_FONT f
  106.                 'prepStepMap t
  107.                 '_FONT currFont&
  108.                 'path t
  109.                 'IF STEPSI <> 0 THEN
  110.                 '    displayMap
  111.                 '    FOR s = 1 TO STEPSI
  112.                 '        LINE (STEPS(s).x * SQ + OFFX + 2, STEPS(s).y * SQ + OFFY + 2)-STEP(SQ - 6, SQ - 6), _RGB32(255, 255, 0), BF
  113.                 '        _LIMIT 5
  114.                 '    NEXT
  115.                 '    _DELAY 1
  116.                 'END IF
  117.                 'KH& = _KEYHIT
  118.                 'WHILE KH& = 0: KH& = _KEYHIT: _LIMIT 100: WEND
  119.             END IF
  120.         END IF
  121.         KH& = _KEYHIT
  122.         SELECT CASE KH&
  123.             CASE 104 'h
  124.                 IF HAULERMODE THEN HAULERMODE = FALSE ELSE HAULERMODE = TRUE
  125.             CASE 18432 'up
  126.                 IF MAP(HC.x, HC.y - 1) = SPACER THEN
  127.                     IF HAULERMODE AND MAP(HC.x, HC.y + 1) < -2 THEN
  128.                         MAP(HC.x, HC.y - 1) = MAP(HC.x, HC.y)
  129.                         MAP(HC.x, HC.y) = MAP(HC.x, HC.y + 1)
  130.                         MAP(HC.x, HC.y + 1) = SPACER
  131.                         HC.y = HC.y - 1
  132.                     ELSEIF HAULERMODE = FALSE THEN
  133.                         MAP(HC.x, HC.y - 1) = MAP(HC.x, HC.y)
  134.                         MAP(HC.x, HC.y) = SPACER
  135.                         HC.y = HC.y - 1
  136.                     END IF
  137.                 END IF
  138.             CASE 20480 'down
  139.                 IF MAP(HC.x, HC.y + 1) = SPACER THEN
  140.                     IF HAULERMODE = TRUE AND MAP(HC.x, HC.y - 1) < -2 THEN
  141.                         MAP(HC.x, HC.y + 1) = MAP(HC.x, HC.y)
  142.                         MAP(HC.x, HC.y) = MAP(HC.x, HC.y - 1)
  143.                         MAP(HC.x, HC.y - 1) = SPACER
  144.                         HC.y = HC.y + 1
  145.                     ELSEIF HAULERMODE = FALSE THEN
  146.                         MAP(HC.x, HC.y + 1) = MAP(HC.x, HC.y)
  147.                         MAP(HC.x, HC.y) = SPACER
  148.                         HC.y = HC.y + 1
  149.                     END IF
  150.                 END IF
  151.  
  152.             CASE 19200 'left
  153.                 IF MAP(HC.x - 1, HC.y) = SPACER THEN
  154.                     IF HAULERMODE AND MAP(HC.x + 1, HC.y) < -2 THEN
  155.                         MAP(HC.x - 1, HC.y) = MAP(HC.x, HC.y)
  156.                         MAP(HC.x, HC.y) = MAP(HC.x + 1, HC.y)
  157.                         MAP(HC.x + 1, HC.y) = SPACER
  158.                         HC.x = HC.x - 1
  159.                     ELSEIF HAULERMODE = FALSE THEN
  160.                         MAP(HC.x - 1, HC.y) = MAP(HC.x, HC.y)
  161.                         MAP(HC.x, HC.y) = SPACER
  162.                         HC.x = HC.x - 1
  163.                     END IF
  164.                 END IF
  165.  
  166.             CASE 19712 'right
  167.                 IF MAP(HC.x + 1, HC.y) = SPACER THEN
  168.                     IF HAULERMODE = TRUE AND MAP(HC.x - 1, HC.y) < -2 THEN
  169.                         MAP(HC.x + 1, HC.y) = MAP(HC.x, HC.y)
  170.                         MAP(HC.x, HC.y) = MAP(HC.x - 1, HC.y)
  171.                         MAP(HC.x - 1, HC.y) = SPACER
  172.                         HC.x = HC.x + 1
  173.                     ELSEIF HAULERMODE = FALSE THEN
  174.                         MAP(HC.x + 1, HC.y) = MAP(HC.x, HC.y)
  175.                         MAP(HC.x, HC.y) = SPACER
  176.                         HC.x = HC.x + 1
  177.                     END IF
  178.                 END IF
  179.  
  180.                 'diagonal moves , so can use Pathfinder for routes
  181.             CASE 18176 'left + up
  182.                 IF MAP(HC.x - 1, HC.y - 1) = SPACER THEN
  183.                     MAP(HC.x - 1, HC.y - 1) = MAP(HC.x, HC.y)
  184.                     MAP(HC.x, HC.y) = SPACER
  185.                     HC.x = HC.x - 1: HC.y = HC.y - 1
  186.                 END IF
  187.             CASE 18688 'right + up
  188.                 IF MAP(HC.x + 1, HC.y - 1) = SPACER THEN
  189.                     MAP(HC.x + 1, HC.y - 1) = MAP(HC.x, HC.y)
  190.                     MAP(HC.x, HC.y) = SPACER
  191.                     HC.x = HC.x + 1: HC.y = HC.y - 1
  192.                 END IF
  193.             CASE 20736 'right + down
  194.                 IF MAP(HC.x + 1, HC.y + 1) = SPACER THEN
  195.                     MAP(HC.x + 1, HC.y + 1) = MAP(HC.x, HC.y)
  196.                     MAP(HC.x, HC.y) = SPACER
  197.                     HC.x = HC.x + 1: HC.y = HC.y + 1
  198.                 END IF
  199.             CASE 20224 'left + down
  200.                 IF MAP(HC.x - 1, HC.y + 1) = SPACER THEN
  201.                     MAP(HC.x - 1, HC.y + 1) = MAP(HC.x, HC.y)
  202.                     MAP(HC.x, HC.y) = SPACER
  203.                     HC.x = HC.x - 1: HC.y = HC.y + 1
  204.                 END IF
  205.  
  206.         END SELECT
  207.  
  208.         IF _KEYDOWN(27) THEN END
  209.         IF _KEYDOWN(ASC("n")) THEN EXIT DO
  210.         IF _KEYDOWN(ASC("c")) THEN displayMap
  211.  
  212.         '_DISPLAY
  213.         _LIMIT 100
  214.     LOOP
  215.  
  216. SUB path (ptB AS COORDINATE)
  217.     'path is from hero (DIM SHATED HC as COORDINATE) to ptB
  218.     prepStepMap ptB
  219.     dist = STEPMAP(HC.x, HC.y) 'STEPMAP is DIM SHARED as INTEGER
  220.     IF dist = 0 THEN
  221.         STEPSI = 0
  222.         LOCATE 1, 1: PRINT "Hero cannot connect to destination."
  223.         EXIT SUB
  224.     ELSE
  225.         LOCATE 1, 1: PRINT "Hero distance is: "; dist
  226.     END IF
  227.  
  228.     STEPSI = 0 'DIM SHARED error signal
  229.     cx = HC.x: cy = HC.y
  230.     WHILE dist >= 2
  231.         'LOCATE 2, 1: PRINT "cx, cy: "; cx, cy '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< debug
  232.         cf = 0
  233.         FOR y = cy - 1 TO cy + 1
  234.             FOR x = cx - 1 TO cx + 1
  235.                 'PRINT "x, y, STEPMAP(x, y) "; x, y, STEPMAP(x, y)
  236.                 IF STEPMAP(x, y) = dist - 1 THEN
  237.                     STEPSI = STEPSI + 1
  238.                     STEPS(STEPSI).x = x: STEPS(STEPSI).y = y
  239.                     'LINE (STEPS(STEPSI).x * SQ + OFFX, STEPS(STEPSI).y * SQ + OFFY)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 0), B
  240.                     cf = 1: EXIT FOR
  241.                 END IF
  242.             NEXT
  243.             IF cf = 1 THEN EXIT FOR
  244.         NEXT
  245.         IF cf = 0 THEN 'lost path
  246.             EXIT SUB
  247.         ELSE
  248.             cx = STEPS(STEPSI).x: cy = STEPS(STEPSI).y
  249.             dist = dist - 1
  250.             ' _LIMIT 10
  251.         END IF
  252.     WEND
  253.  
  254. 'this is Steve McNeil's method optimised to skip over needless or redundant checks
  255. SUB prepStepMap (target AS COORDINATE)
  256.     FOR y = 1 TO MAPH
  257.         FOR x = 1 TO MAPW
  258.             STEPMAP(x, y) = 0
  259.         NEXT
  260.     NEXT
  261.     STEPMAP(target.x, target.y) = 1: tick = 1: changes = 1
  262.     WHILE changes
  263.         tick = tick + 1: changes = 0
  264.         ystart = max(target.y - tick, 1): ystop = min(target.y + tick, MAPH)
  265.         FOR y = ystart TO ystop
  266.             xstart = max(target.x - tick, 1): xstop = min(target.x + tick, MAPW)
  267.             FOR x = xstart TO xstop
  268.                 'check out the neighbors
  269.                 IF MAP(x, y) = SPACER OR MAP(x, y) = HERO THEN
  270.                     cf = 0
  271.                     FOR yy = y - 1 TO y + 1
  272.                         FOR xx = x - 1 TO x + 1
  273.                             IF NOT (xx = x AND yy = y) THEN
  274.                                 IF STEPMAP(xx, yy) = tick - 1 AND STEPMAP(x, y) = 0 THEN 'found a parent to assign to cell
  275.                                     STEPMAP(x, y) = tick
  276.                                     '_PRINTSTRING (x * SQ + OFFX + 2, y * SQ + OFFY + 5), LTRIM$(STR$(STEPMAP(x, y)))
  277.                                     changes = 1: cf = 1: EXIT FOR
  278.                                 END IF
  279.                             END IF
  280.  
  281.                         NEXT
  282.                         IF cf THEN EXIT FOR
  283.                     NEXT
  284.                 END IF
  285.             NEXT
  286.         NEXT
  287.         '_LIMIT 10
  288.     WEND
  289.  
  290. SUB displayMap
  291.     'MAP is shared, 0 based with width mapw, height maph that are constants
  292.     DIM k AS LONG
  293.     path HDC
  294.     FOR y = 0 TO MAPH + 1
  295.         FOR x = 0 TO MAPW + 1
  296.             SELECT CASE MAP(x, y)
  297.                 'CASE HERO: k = _RGB32(255, 255, 255)
  298.                 CASE BORDER: k = _RGB32(255, 128, 64)
  299.                 CASE OBSTACLE: k = _RGB32(0, 128, 0)
  300.                 CASE SPACER: k = _RGB32(0, 0, 0)
  301.                 CASE DOOR: k = _RGB32(0, 0, 255)
  302.             END SELECT
  303.             LINE (x * SQ + OFFX, y * SQ + OFFY)-STEP(SQ - 2, SQ - 2), k, BF
  304.         NEXT
  305.     NEXT
  306.     IF STEPSI <> 0 THEN
  307.         'displayMap
  308.         FOR s = 1 TO STEPSI
  309.             LINE (STEPS(s).x * SQ + OFFX + 2, STEPS(s).y * SQ + OFFY + 2)-STEP(SQ - 6, SQ - 6), _RGB32(255, 255, 0), BF
  310.             '_LIMIT 5
  311.         NEXT
  312.         '_DELAY 1
  313.     END IF
  314.     LINE (HC.x * SQ + OFFX + 1, HC.y * SQ + OFFY + 1)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 255), BF
  315.     LOCATE 1, 72: PRINT SPACE$(20)
  316.     LOCATE 1, 72: PRINT "Hauler Mode is ";
  317.     IF HAULERMODE THEN PRINT "ON" ELSE PRINT "OFF"
  318.     _DISPLAY
  319.     _LIMIT 30
  320.  
  321. 'someone might start with this a build a map or levels editor!
  322. 'load a shared MAP(1 to mapw, 1 to maph)
  323. SUB RandomMap (obstacleDensity!)
  324.     'clear old
  325.     FOR y = 1 TO MAPH
  326.         FOR x = 1 TO MAPW
  327.             MAP(x, y) = SPACER
  328.         NEXT
  329.     NEXT
  330.  
  331.     'borders
  332.     FOR x = 0 TO MAPW + 1
  333.         MAP(x, 0) = BORDER
  334.         MAP(x, MAPH + 1) = BORDER
  335.     NEXT
  336.     FOR y = 0 TO MAPH + 1
  337.         MAP(0, y) = BORDER
  338.         MAP(MAPW + 1, y) = BORDER
  339.     NEXT
  340.  
  341.     'convert this part into walls, buildings, jewels, potions...
  342.     'with these obstacles there is no guarantee a path will exist
  343.     FOR I = 1 TO MAPW * MAPH * obstacleDensity!
  344.         ox = Rand(1, MAPW): oy = Rand(1, MAPH)
  345.         MAP(ox, oy) = OBSTACLE
  346.     NEXT
  347.  
  348.     'door
  349.     wall = Rand(1, 4)
  350.     SELECT CASE wall
  351.         CASE 1: MX.x = 1: MX.y = Rand(2, MAPH - 2)
  352.         CASE 2: MX.x = MAPW: MX.y = Rand(2, MAPH - 2)
  353.         CASE 3: MX.x = Rand(2, MAPW - 2): MX.y = 1
  354.         CASE 4: MX.x = Rand(2, MAPW - 2): MX.y = MAPH
  355.     END SELECT
  356.     MAP(MX.x, MX.y) = DOOR
  357.  
  358.  
  359. FUNCTION Rand% (lo%, hi%)
  360.     Rand% = INT(RND * (hi% - lo% + 1)) + lo%
  361. FUNCTION min (n1, n2)
  362.     IF n1 > n2 THEN min = n2 ELSE min = n1
  363. FUNCTION max (n1, n2)
  364.     IF n1 < n2 THEN max = n2 ELSE max = n1
  365. FUNCTION leftOf$ (source$, of$)
  366.     posOf = INSTR(source$, of$)
  367.     IF posOf > 0 THEN leftOf$ = MID$(source$, 1, posOf - 1)
  368. FUNCTION rightOf$ (source$, of$)
  369.     posOf = INSTR(source$, of$)
  370.     IF posOf > 0 THEN rightOf$ = MID$(source$, posOf + LEN(of$))
  371. FUNCTION trim$ (s$)
  372.     trim$ = LTRIM$(RTRIM$(s$))
  373.  
  374.  

The blue square is eventually going to be a Stargate to another garden hedge arrangement. For now, just press n for new.
Oh and h toggles the hauling mode, you can't move freely unless you are dragging some hedge with you in that mode.

Let the hedge hauling begin!
« Last Edit: August 18, 2018, 05:02:16 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+ Pathfinder
« Reply #18 on: August 23, 2018, 11:11:24 pm »
This has gone from Pathfinder to Path maker! All diagonal moves have been removed, see Instructions in comments.
Code: QB64: [Select]
  1. _TITLE "PathFinder 4, No diagonal movements"
  2. 'QB64 X 64 version 1.2 20180228/86  from git b301f92
  3.  
  4. ' version 4: Pathfinder or Path Maker!
  5.  
  6. ' ================================ Instructions ==============================================
  7. '  ctrl + Arrow will haul a green obstacle
  8. ' shift + Arrow will push a green obstacle as long as there is a space on the other side of it.
  9. ' With a new map the destination for paths is set the same as the blue door, see target.
  10. ' The destination can be reset by clicking the map.
  11. ' The blue square is the exit or door to another map, so is pressing n for new.
  12. ' A yellow path will appear between the white hero player and the destination if the way is not
  13. ' blocked. If it is, you can usually clear a path to the door by moving obstacles around.
  14. ' When you clear a path the yellow path will light up.   esc to quit.
  15. ' Oh yeah, you can haul the door around too.
  16. '
  17. ' It is strangely fun to move the green obstacles around, like sculpting with a bull dozer.
  18. ' I am thinking maybe some sort of landscaping game.
  19. '=============================================================================================
  20. ' History of development:
  21. ' started 2018-08-11 when Colbalt asked about A* pathfinder
  22. ' He has now 2018-08-12 posted a QB64 version that is nice!
  23.  
  24. ' 2018-08-11 started PathFinder 1
  25. ' 2018-08-12 almost working but buggy backtract to point A after point B is found.
  26. ' 2018-08-13 PathFinder 1a.bas I think I have a fix for buggy path BackTrack but major surgery so this new version
  27. ' 2018-08-14 Pathfinder 2:  2 parts
  28. ' Part 1: creates a map, a random Home point and backtracts all the points available to move over.
  29. ' Part 2: allows clicking variaous points of map to see if path is found.
  30.  
  31. ' 2018-08-15 PathFinder 3: Make a function that returns a path from A to B given A, B
  32. ' The map is shared as well as it's dimensions mapw by maph (constants).
  33. ' The function will create a copy of map and work with that so main map remains intact.
  34. ' Well I suppose we need aa random map maker for starters.
  35. ' And then of course a sub to display the map.
  36. ' OK I am now working under the influence of Steve McNeil's programs. ;)
  37. ' Thanks Steve some great ideas for simplfying the PathFinder for actual game use.
  38.  
  39. ' 2018-08-17 With Pathfinder 3 I want to start working code towards game using MAP(s)
  40. ' I am also under the influence of PMACKAY's game series Mr Bash or Dash or whatever he decides to call the Diamond Miner.
  41. ' Thanks PMACKAY, I love the little game you started and have learned from your questions and setup.
  42.  
  43. '2018-08-18 Pathfinder 3a, I have 3 working with ticks but it changes all after running through the whole tick session.
  44. ' 3a tests whether I can do this with Steve's version which changes immediately and not after whole tick session.
  45. ' It is allot simpler and will run faster than saving all changes in a container and reprocessing into step array.
  46. ' I tried this before but I think I know what I did wrong then, I did not check if value was = current tick.
  47. ' Before I think I just checked if the map had a value or not written in, no only current tick values should parent a new cell.
  48. ' Finally found the frick'in bug!!! had cy instead of cx, OK let's see if can draw the path from Steps array.
  49. ' OK now prepStepMap in called in the Path routine and working.
  50.  
  51. '2018-08-19 PathFinder 4 add the needed Push Mode to compliment the Haul mode
  52. '2018-08-23 PathFinder 4 DO PATHS USING ONLY VERTCAL AND HORIZONTAL MOVEMENT
  53. ' Also use _keydown for push / haul modes, forget having to toggle modes On and Off.
  54. ' Use left hand Ctrl+ Arrow to Haul and Shift + Arrow to Push, when both down, neither work.
  55. ' Extracted Hero from being emedded in the map.
  56. ' Draw the Hero tile on a second layer over the floor = spacer tile.
  57. '
  58.  
  59. DEFINT A-Z
  60. ' Decided to use integer values with Descriptive CONST names, thanks Tempodibasic
  61. ' Using ALL CAP's for CONSTants, user defined TYPE, and SHARED variables,
  62. ' but short mnuemonic abrev because I hate typing long descriptions,
  63. ' so if you forget what the cap'd variable name means, check back to this main section.
  64.  
  65. CONST TRUE = -1
  66. CONST FALSE = 0
  67. CONST WW = 1060 ' Window Width  in pixels
  68. CONST WH = 720 '  Window Height in pixels
  69. CONST SQ = 30 '   Square Size in pixels
  70. CONST MAPW = 30 ' MAP number of squares Wide or Width
  71. CONST MAPH = 20 ' MAP number of squares High or Height
  72.  
  73. ' MAP ITEMS
  74. ' CONST HERO = -1   no longer embedded in map
  75. CONST BORDER = -2
  76. CONST OBSTACLE = -3
  77. CONST SPACER = 0
  78. CONST DOOR = -4
  79.  
  80. 'following Steve's example
  81. TYPE COORDINATE
  82.     X AS INTEGER
  83.     Y AS INTEGER
  84.  
  85. SCREEN _NEWIMAGE(WW, WH, 32)
  86. _SCREENMOVE _MIDDLE ' ah this is working better now! is it the 64X64 version?
  87.  
  88. 'The MAP:
  89. 'There will be a 1 SQ Border around the Map, the actual squares for game action run 1 to MAPW, 1 to MAPH
  90. DIM SHARED MAP(MAPW + 2, MAPH + 2) AS INTEGER
  91. DIM SHARED HC AS COORDINATE 'Hero Coordinate
  92. DIM SHARED HDC AS COORDINATE 'Hero Destination Coordinate
  93. DIM SHARED MX AS COORDINATE 'Map Exit, AKA Door
  94.  
  95. 'This will be a map used for getting paths from HC = Hero Coordinate  to HDC = Hero Destination Coordinate
  96. DIM SHARED STEPMAP(MAPW + 2, MAPH + 2) AS INTEGER
  97. DIM SHARED STEPS(MAPH * MAPW) AS COORDINATE
  98. DIM SHARED STEPSI AS INTEGER 'counts steps
  99. DIM SHARED XOFF, YOFF, HAULMODE AS _BYTE, PUSHMODE AS _BYTE
  100. DIM t AS COORDINATE
  101. XOFF = (WW - SQ * (MAPW + 2)) / 2
  102. YOFF = (WH - SQ * (MAPH + 2)) / 2
  103. HAULMODE = 0: PUSHMODE = 0
  104.  
  105.     'this part sets up a sample map, and here the door is created
  106.     RandomMap .7
  107.     'set door as first destination for pathing
  108.     HDC.X = MX.X: HDC.Y = MX.Y
  109.  
  110.     'find free space to start hero
  111.     DO
  112.         testx = Rand(1, MAPW): testy = Rand(1, MAPH)
  113.     LOOP UNTIL MAP(testx, testy) = SPACER
  114.     HC.X = testx: HC.Y = testy
  115.  
  116.     'this part displays the ability to find a path to blue square anywhere in the maze
  117.  
  118.     _TITLE "ctrl+Arrow <haul, shift+Arrow >push, Click to set destination, n or blue door for new map, esc=quit"
  119.     DO
  120.  
  121.         WHILE _MOUSEINPUT: WEND
  122.         IF _MOUSEBUTTON(1) THEN
  123.             xm = _MOUSEX - XOFF - .5 * SQ
  124.             ym = _MOUSEY - YOFF - .5 * SQ
  125.             t.X = xm / SQ: t.Y = ym / SQ
  126.             IF t.X >= 1 AND t.X <= MAPW AND t.Y >= 1 AND t.Y <= MAPH THEN
  127.                 HDC.X = t.X: HDC.Y = t.Y
  128.             END IF
  129.         END IF
  130.         KH& = _KEYHIT
  131.         IF _KEYDOWN(100306) THEN HAULMODE = TRUE ELSE HAULMODE = fales 'ctrl
  132.         IF _KEYDOWN(100304) THEN PUSHMODE = TRUE ELSE PUSHMODE = FALSE 'shft
  133.         IF PUSHMODE AND HAULMODE THEN PUSHMODE = FALSE: HAULMODE = FALSE
  134.         SELECT CASE KH&
  135.             CASE 18432 'up
  136.                 IF MAP(HC.X, HC.Y - 1) = DOOR THEN EXIT DO
  137.                 IF MAP(HC.X, HC.Y - 1) = SPACER THEN
  138.                     IF HAULMODE AND MAP(HC.X, HC.Y + 1) < -2 THEN
  139.                         MAP(HC.X, HC.Y) = MAP(HC.X, HC.Y + 1)
  140.                         MAP(HC.X, HC.Y + 1) = SPACER
  141.                         HC.Y = HC.Y - 1
  142.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
  143.                         HC.Y = HC.Y - 1
  144.                     END IF
  145.                 ELSEIF MAP(HC.X, HC.Y - 2) = SPACER AND MAP(HC.X, HC.Y - 1) < -2 AND PUSHMODE THEN
  146.                     MAP(HC.X, HC.Y - 2) = MAP(HC.X, HC.Y - 1)
  147.                     MAP(HC.X, HC.Y - 1) = MAP(HC.X, HC.Y)
  148.                     HC.Y = HC.Y - 1
  149.                 END IF
  150.  
  151.             CASE 20480 'down
  152.                 IF MAP(HC.X, HC.Y + 1) = DOOR THEN EXIT DO
  153.                 IF MAP(HC.X, HC.Y + 1) = SPACER THEN
  154.                     IF HAULMODE = TRUE AND MAP(HC.X, HC.Y - 1) < -2 THEN
  155.                         MAP(HC.X, HC.Y) = MAP(HC.X, HC.Y - 1)
  156.                         MAP(HC.X, HC.Y - 1) = SPACER
  157.                         HC.Y = HC.Y + 1
  158.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
  159.                         HC.Y = HC.Y + 1
  160.                     END IF
  161.                 ELSEIF MAP(HC.X, HC.Y + 2) = SPACER AND MAP(HC.X, HC.Y + 1) < -2 AND PUSHMODE THEN
  162.                     MAP(HC.X, HC.Y + 2) = MAP(HC.X, HC.Y + 1)
  163.                     MAP(HC.X, HC.Y + 1) = MAP(HC.X, HC.Y)
  164.                     HC.Y = HC.Y + 1
  165.                 END IF
  166.  
  167.             CASE 19200 'left
  168.                 IF MAP(HC.X - 1, HC.Y) = DOOR THEN EXIT DO
  169.                 IF MAP(HC.X - 1, HC.Y) = SPACER THEN
  170.                     IF HAULMODE AND MAP(HC.X + 1, HC.Y) < -2 THEN
  171.                         MAP(HC.X, HC.Y) = MAP(HC.X + 1, HC.Y)
  172.                         MAP(HC.X + 1, HC.Y) = SPACER
  173.                         HC.X = HC.X - 1
  174.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
  175.                         HC.X = HC.X - 1
  176.                     END IF
  177.                 ELSEIF MAP(HC.X - 2, HC.Y) = SPACER AND MAP(HC.X - 1, HC.Y) < -2 AND PUSHMODE THEN
  178.                     MAP(HC.X - 2, HC.Y) = MAP(HC.X - 1, HC.Y)
  179.                     MAP(HC.X - 1, HC.Y) = SPACER
  180.                     HC.X = HC.X - 1
  181.                 END IF
  182.  
  183.             CASE 19712 'right
  184.                 IF MAP(HC.X + 1, HC.Y) = DOOR THEN EXIT DO
  185.                 IF MAP(HC.X + 1, HC.Y) = SPACER THEN
  186.                     IF HAULMODE = TRUE AND MAP(HC.X - 1, HC.Y) < -2 THEN
  187.                         MAP(HC.X, HC.Y) = MAP(HC.X - 1, HC.Y)
  188.                         MAP(HC.X - 1, HC.Y) = SPACER
  189.                         HC.X = HC.X + 1
  190.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
  191.                         HC.X = HC.X + 1
  192.                     END IF
  193.                 ELSEIF MAP(HC.X + 2, HC.Y) = SPACER AND MAP(HC.X + 1, HC.Y) < -2 AND PUSHMODE THEN
  194.                     MAP(HC.X + 2, HC.Y) = MAP(HC.X + 1, HC.Y)
  195.                     MAP(HC.X + 1, HC.Y) = MAP(HC.X, HC.Y)
  196.                     HC.X = HC.X + 1
  197.                 END IF
  198.  
  199.         END SELECT
  200.  
  201.         IF _KEYDOWN(27) THEN END
  202.         IF _KEYDOWN(ASC("n")) THEN EXIT DO
  203.         displayMap
  204.         _LIMIT 100
  205.     LOOP
  206.  
  207. SUB path (ptB AS COORDINATE)
  208.     'path is from hero (DIM SHARED HC as COORDINATE) to ptB (DIM SHARED HDC
  209.     prepStepMap ptB
  210.     dist = STEPMAP(HC.X, HC.Y) 'STEPMAP is DIM SHARED as INTEGER
  211.     STEPSI = 0 'DIM SHARED, no path is signaled if still 0 after this sub
  212.     IF dist = 0 THEN EXIT SUB
  213.     cx = HC.X: cy = HC.Y
  214.     'count dist down to destination
  215.     WHILE dist >= 2
  216.         cf = 0
  217.         IF STEPMAP(cx, cy - 1) = dist - 1 THEN
  218.             cf = 1: cy = cy - 1
  219.         ELSEIF STEPMAP(cx - 1, cy) = dist - 1 THEN
  220.             cf = 1: cx = cx - 1
  221.         ELSEIF STEPMAP(cx + 1, cy) = dist - 1 THEN
  222.             cf = 1: cx = cx + 1
  223.         ELSEIF STEPMAP(cx, cy + 1) = dist - 1 THEN
  224.             cf = 1: cy = cy + 1
  225.         END IF
  226.         IF cf = 0 THEN 'lost path, this should not happen until it is done
  227.             EXIT SUB
  228.         ELSE
  229.             'add next step to steps array, set next search target
  230.             STEPSI = STEPSI + 1: STEPS(STEPSI).X = cx: STEPS(STEPSI).Y = cy
  231.             dist = dist - 1
  232.         END IF
  233.     WEND
  234.  
  235. 'this is Steve McNeil's method optimised to skip over needless or redundant checks
  236. SUB prepStepMap (target AS COORDINATE)
  237.     FOR y = 1 TO MAPH
  238.         FOR x = 1 TO MAPW
  239.             STEPMAP(x, y) = 0
  240.         NEXT
  241.     NEXT
  242.     STEPMAP(target.X, target.Y) = 1: tick = 1: changes = 1
  243.     'from an ever broadening area around destination find neighbor to step from
  244.     WHILE changes
  245.         t = tick: tick = tick + 1: changes = 0
  246.         ystart = max(target.Y - tick, 1): ystop = min(target.Y + tick, MAPH)
  247.         FOR y = ystart TO ystop
  248.             xstart = max(target.X - tick, 1): xstop = min(target.X + tick, MAPW)
  249.             FOR x = xstart TO xstop
  250.                 'check out the neighbors
  251.                 IF MAP(x, y) = SPACER THEN
  252.                     IF STEPMAP(x, y) = 0 THEN
  253.                         IF STEPMAP(x, y - 1) = t OR STEPMAP(x - 1, y) = t OR STEPMAP(x + 1, y) = t OR STEPMAP(x, y + 1) = t THEN
  254.                             'there is a step close by to step from
  255.                             STEPMAP(x, y) = tick: changes = 1 'next step
  256.                         END IF
  257.                     END IF 'stepmap = 0
  258.                 END IF 'map = spacer
  259.             NEXT
  260.         NEXT
  261.     WEND
  262.  
  263. SUB displayMap 'all drawing instructions conatined here
  264.     'MAP is shared, 1 based with width =  mapw, height = maph that are constants
  265.     DIM k AS LONG 'kolor tiles
  266.     CLS
  267.     FOR y = 0 TO MAPH + 1
  268.         FOR x = 0 TO MAPW + 1
  269.             SELECT CASE MAP(x, y)
  270.                 'CASE HERO: k = _RGB32(255, 255, 255)   'not embedded in map anymore
  271.                 CASE BORDER: k = _RGB32(255, 128, 64)
  272.                 CASE OBSTACLE: k = _RGB32(0, 128, 0)
  273.                 CASE SPACER: k = _RGB32(0, 0, 0)
  274.                 CASE DOOR: k = _RGB32(0, 0, 255)
  275.             END SELECT
  276.             LINE (x * SQ + XOFF, y * SQ + YOFF)-STEP(SQ - 2, SQ - 2), k, BF
  277.         NEXT
  278.     NEXT
  279.  
  280.     'loads steps array with steps from hero to destination from prepared stepmap array,
  281.     'stepsI is number of steps to destination unless = 0
  282.     path HDC
  283.     IF STEPSI <> 0 THEN
  284.         FOR s = 1 TO STEPSI
  285.             LINE (STEPS(s).X * SQ + XOFF + 10, STEPS(s).Y * SQ + YOFF + 10)-STEP(SQ - 20, SQ - 20), _RGB32(255, 255, 0), BF
  286.         NEXT
  287.     END IF
  288.  
  289.     'draw target or destination
  290.     FOR i = 6 TO 10 STEP 2
  291.         LINE (HDC.X * SQ + XOFF + i - 1, HDC.Y * SQ + YOFF + i - 1)-STEP(SQ - 2 * i, SQ - 2 * i), _RGB32(255, 255, 255), BF
  292.         LINE (HDC.X * SQ + XOFF + i, HDC.Y * SQ + YOFF + i)-STEP(SQ - 2 * i - 2, SQ - 2 * i - 2), _RGB32(255, 0, 0), BF
  293.     NEXT
  294.  
  295.     'draw hero
  296.     LINE (HC.X * SQ + XOFF + 1, HC.Y * SQ + YOFF + 1)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 255), BF
  297.  
  298.     'special keys = powers
  299.     LOCATE 1, 90: PRINT SPACE$(30)
  300.     IF PUSHMODE THEN LOCATE 1, 90: PRINT "Push Mode is ON."
  301.     IF HAULMODE THEN LOCATE 1, 90: PRINT "Haul Mode is ON."
  302.     _DISPLAY
  303.  
  304. 'someone might start with this a build a map or levels editor!
  305. 'load a shared MAP(1 to mapw, 1 to maph)
  306. SUB RandomMap (obstacleDensity!) ' obstacleDensity! = fraction of map squares to make obstacles
  307.     'MAP is shared, 1 based with width =  mapw, height = maph that are constants
  308.     'clear last map
  309.     FOR y = 1 TO MAPH
  310.         FOR x = 1 TO MAPW
  311.             MAP(x, y) = SPACER
  312.         NEXT
  313.     NEXT
  314.  
  315.     'borders
  316.     FOR x = 0 TO MAPW + 1
  317.         MAP(x, 0) = BORDER
  318.         MAP(x, MAPH + 1) = BORDER
  319.     NEXT
  320.     FOR y = 0 TO MAPH + 1
  321.         MAP(0, y) = BORDER
  322.         MAP(MAPW + 1, y) = BORDER
  323.     NEXT
  324.  
  325.     'convert this part into walls, buildings, jewels, potions...
  326.     'with these obstacles there is no guarantee a path will exist
  327.     FOR I = 1 TO MAPW * MAPH * obstacleDensity!
  328.         ox = Rand(1, MAPW): oy = Rand(1, MAPH)
  329.         MAP(ox, oy) = OBSTACLE
  330.     NEXT
  331.  
  332.     'door, exit to next map near a border?
  333.     wall = Rand(1, 4)
  334.     SELECT CASE wall
  335.         CASE 1: MX.X = 1: MX.Y = Rand(2, MAPH - 2)
  336.         CASE 2: MX.X = MAPW: MX.Y = Rand(2, MAPH - 2)
  337.         CASE 3: MX.X = Rand(2, MAPW - 2): MX.Y = 1
  338.         CASE 4: MX.X = Rand(2, MAPW - 2): MX.Y = MAPH
  339.     END SELECT
  340.     MAP(MX.X, MX.Y) = DOOR
  341.  
  342. 'handy functions
  343. FUNCTION Rand% (lo%, hi%)
  344.     Rand% = INT(RND * (hi% - lo% + 1)) + lo%
  345. FUNCTION min (n1, n2)
  346.     IF n1 > n2 THEN min = n2 ELSE min = n1
  347. FUNCTION max (n1, n2)
  348.     IF n1 < n2 THEN max = n2 ELSE max = n1
  349.  
  350.  
Pathfinder 4.PNG
* Pathfinder 4.PNG (Filesize: 43.82 KB, Dimensions: 1028x732, Views: 379)
« Last Edit: August 23, 2018, 11:37:39 pm by bplus »

Offline PMACKAY

  • Forum Regular
  • Posts: 188
  • LIFE is Temporary
    • View Profile
Re: B+ Pathfinder
« Reply #19 on: August 29, 2018, 10:29:23 am »
Just curious i cannot do the math but if one was to do random length and direction on a latice as in something similar to path finder to make it from one side to the other, then maybe you could get the computer to pick a random spot in the latice to start and pick out blocks to make random tracks that connect to the path... i think that could make a maze... now i want to play with it too.but i have my game to complete first


A=rnd*4    direction

B=rnd*length

Check if valid space open in lattice

IF YES

Take out blocks (up,right,down,left) until length of b and stop if no wall on other side unless conecting

NO JUST LOOP

Loop until all paths carved

Thinking it could like cut away 10 up then 4 left and so on until map complete.

MackyWhite

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+ Pathfinder
« Reply #20 on: August 29, 2018, 10:58:36 am »
You may be onto general idea of maze generation, not allot of math really but a little experience with recursive procedures might help take a complex task and make it easier by keeping track of all the branching.

Pathfinder code here should find it's way through a maze build with blocks but mods would be needed for mazes of type Steve and Terry have generated where a cell type controls access to entry.

Offline PMACKAY

  • Forum Regular
  • Posts: 188
  • LIFE is Temporary
    • View Profile
Re: B+ Pathfinder
« Reply #21 on: August 29, 2018, 11:28:07 am »
I guess if it ran into a dead end it could join the start with the path next to it. Leaving the other end closed. Which means each path until a dead end needs only to hold a number and if it ran on the latice there is always a wall between paths. Once connect it takes the main paths numbers making it snapped in place.
MackyWhite

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: B+ Pathfinder
« Reply #22 on: September 09, 2018, 02:39:03 pm »
Hi Ashish,

Actually, I could use some examples of maps to work out more practical uses.

Traveller, one of the RPGs that I played, uses one dimensional hex grid star maps. With some tweaking, one could put in a vessel's jump range and a similar algorithm could map the shortest route. Starships could execute anything from jump-1 thru jump-6, depending upon its drive rating, which were the measure of hex range (aka parsecs). There were places that lower rated vessels could not go without some sort of assistance.

A ship that inadvertently jumped into an empty parsec, without enough fuel to jump back out to one occupied by a viable system with a fuel source, was doomed. You died, suffocating, in the icy cold of space, as Kang once said...

The definitive example is at:
https://travellermap.com

just zoom in to see the detail. Wish they had stuff like that when I was playing...

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+ Pathfinder
« Reply #23 on: September 09, 2018, 03:57:49 pm »
Wow! that is pretty elaborate!