QB64.org Forum

Active Forums => Programs => Topic started by: bplus on August 13, 2018, 09:38:26 pm

Title: B+ Pathfinder
Post by: bplus on August 13, 2018, 09:38:26 pm

This uses no awareness of where B is until it hits it! Therefore you could find all the B's you want on a map, not just one.

And yet, can you find a path that takes less squares?

Sure this thing zigs when no zig or zag is needed but the square counts are the same.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Code: QB64: [Select]

1. _TITLE "PathFinder 1a, press spacebar to continue whenever it stops, press esc to quit"
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. ' 8:38 PM 28 times in a row it worked, now diddle the size of array and loose the board text view
10. ' 9:09 PM I have run 2 dozen tests more at least and zero bugs! on smaller and more squares.
11. ' 9:25 PM Still no failures! Ready to show the world.
12.  
13.  
14. DEFINT A-Z
15. CONST ww = 800
16. CONST wh = 600
17. CONST sq = 10
18. CONST maxx = 80
19. CONST maxy = 60
20.  
21. SCREEN _NEWIMAGE(ww, wh, 32)
22. _SCREENMOVE (1280 - ww) / 2 + 30, (760 - wh) / 2
23. RANDOMIZE TIMER
24.  
25. TYPE xytype
26.     x AS INTEGER
27.     y AS INTEGER
28. END TYPE
29. DIM SHARED ax, ay, bx, by
30. DIM SHARED board(1 TO maxx, 1 TO maxy) AS STRING * 6
31. DO
32.     FOR y = 1 TO maxy
33.         FOR x = 1 TO maxx
34.             board(x, y) = " "
35.         NEXT
36.     NEXT
37.     'with these obstacles there is no guarantee a path will exist
38.     FOR i = 1 TO maxx * maxy * .8
39.         ox = rand(1, maxx): oy = rand(1, maxy)
40.         WHILE (ox = ax AND oy = ay) OR (ox = bx AND ox = by)
41.             ox = rand(1, maxx): oy = rand(1, maxy)
42.         WEND
43.         board(ox, oy) = "O"
44.     NEXT
45.     ax = rand(1, maxx): ay = rand(1, maxy)
46.     bx = rand(1, maxx): by = rand(1, maxy)
47.     WHILE ax = bx AND ay = by
48.         bx = rand(1, maxx): by = rand(1, maxy)
49.     WEND
50.     board(ax, ay) = "A"
51.     board(bx, by) = "B"
52.     displayB
53.     WHILE NOT _KEYDOWN(32): _LIMIT 100: WEND
54.     WHILE _KEYDOWN(32): _LIMIT 100: WEND
55.     parentF = 1: tick = 0: parentx = 0
56.     WHILE parentF = 1 AND parentx = 0
57.         parentF = 0: tick = tick + 1: changes$ = ""
58.         'IF tick > maxx * maxy THEN EXIT WHILE   'this was crude infinite loop stopper
59.         ystart = max(ay - tick, 1): ystop = min(ay + tick, maxy)
60.         FOR y = ystart TO ystop
61.             xstart = max(ax - tick, 1): xstop = min(ax + tick, maxx)
62.             'PRINT ystart, ystop, xstart, xstop
63.             'END
64.             FOR x = xstart TO xstop
65.                 'check out the neighbors
66.                 IF x - 1 >= 1 THEN xxstart = x - 1 ELSE xxstart = x
67.                 IF x + 1 <= maxx THEN xxstop = x + 1 ELSE xxstop = x
68.                 IF y - 1 >= 1 THEN yystart = y - 1 ELSE yystart = y
69.                 IF y + 1 <= maxy THEN yystop = y + 1 ELSE yystop = y
70.                 IF RTRIM$(board(x, y)) = "" THEN
71.                     cf = 0
72.                     FOR yy = yystart TO yystop
73.                         FOR xx = xxstart TO xxstop
74.                             IF xx <> x OR yy <> y THEN
75.                                 IF RTRIM$(board(xx, yy)) = "A" OR INSTR(RTRIM$(board(xx, yy)), ",") > 0 THEN 'found a parent to assign to cell
76.  
77.                                     '          This had ne stuck for awhile!
78.                                     'LOGIC BUG   board(x, y) = LTRIM$(STR$(xx)) + "," + LTRIM$(STR$(yy))
79.                                     'can't change board until all are checked!!!!   so save up changes
80.                                     changes$ = changes$ + LTRIM$(STR$(x)) + "," + LTRIM$(STR$(y)) + "{" + LTRIM$(STR$(xx)) + "," + LTRIM$(STR$(yy)) + "}"
81.                                     rec (x - 1) * sq + 3, (y - 1) * sq + 3, x * sq - 3, y * sq - 3, 555
82.                                     parentF = 1 'so will continue looping
83.                                     cf = 1: EXIT FOR
84.                                 END IF
85.                             END IF
86.                         NEXT
87.                         IF cf THEN EXIT FOR
88.                     NEXT
89.                 ELSEIF RTRIM$(board(x, y)) = "A" OR INSTR(board(x, y), ",") > 0 THEN 'see if B is a neighbor
90.                     FOR yy = yystart TO yystop
91.                         FOR xx = xxstart TO xxstop
92.                             IF xx <> x OR yy <> y THEN
93.                                 IF RTRIM$(board(xx, yy)) = "B" THEN 'B conects to x, y
94.                                     parentx = x: parenty = y 'from this we should be able to backtrack to A
95.                                     GOTO jump1
96.                                 END IF
97.                             END IF
98.                         NEXT
99.                     NEXT
100.                 END IF
101.             NEXT
102.         NEXT
103.         jump1:
104.         'update board with cells assigned parents
105.         WHILE changes$ <> ""
106.             new$ = leftOf$(changes$, "}")
107.             changes$ = rightOf$(changes$, "}")
108.             newxy$ = leftOf$(new$, "{")
109.             newParent$ = rightOf$(new$, "{")
110.             u = VAL(leftOf$(newxy$, ",")): v = VAL(rightOf$(newxy$, ","))
111.             board(u, v) = leftOf$(newParent$, ",") + "," + rightOf$(newParent$, ",")
112.         WEND
113.  
114.         '_DISPLAY
115.         _LIMIT 10
116.     WEND
117.     'displayB
118.     'either parentF = 0, no parents found for all the cells in tick or parentbx was found and we have a path to backtrack to A
119.     BackTrack$ = ""
120.     IF parentx THEN 'backtrack to A   note: B could be right next to A!!!
121.         'IF parentx <> ax AND parenty <> ay THEN
122.         frec (parentx - 1) * sq + 3, (parenty - 1) * sq + 3, sq - 6, sq - 6, 990
123.         'END IF
124.  
125.         'this had me stuck for the longest time! parentx was the fix! (along with removal of blunders)
126.         WHILE parentx 'trace the path back
127.             ps$ = board(parentx, parenty)
128.             parentx = VAL(leftOf$(ps$, ","))
129.             parenty = VAL(rightOf$(ps$, ","))
130.  
131.             'IF parentx <> ax AND parenty <> ay THEN
132.             frec (parentx - 1) * sq + 3, (parenty - 1) * sq + 3, sq - 6, sq - 6, 990
133.             'END IF
134.             'IF parentx <> ax AND parenty <> ay THEN EXIT WHILE
135.             '_DISPLAY
136.             _LIMIT 10
137.         WEND
138.         WHILE NOT _KEYDOWN(32)
139.             IF _KEYDOWN(27) THEN END
140.             _LIMIT 100
141.         WEND
142.         WHILE _KEYDOWN(32): _LIMIT 100: WEND
143.     ELSE
144.         rgb 999
145.         LOCATE 15, 10: PRINT "Did not connect to B"
146.         _DELAY 3
147.     END IF
148.  
149.     'for this to be of any use, I need to format the print to exact same size, well thats easy
150.     '
151.     '                      this is why board is string * 6 type
152.     '                          maxx = 16 maxy = 12  or less
153.     'rgb 999
154.     'CLS
155.     'FOR y = 1 TO maxy
156.     '    FOR x = 1 TO maxx
157.     '        PRINT board(x, y);
158.     '    NEXT
159.     '    PRINT: PRINT
160.     'NEXT
161.     'WHILE NOT _KEYDOWN(32)
162.     '    IF _KEYDOWN(27) THEN END
163.     '    _LIMIT 100
164.     'WEND
165.     'WHILE _KEYDOWN(32): _LIMIT 100: WEND
166. LOOP UNTIL _KEYDOWN(27)
167. SUB displayB
168.     FOR y = 1 TO maxy
169.         FOR x = 1 TO maxx
170.             SELECT CASE RTRIM$(board(x, y))
171.                 CASE IS = "": k = 0
172.                 CASE IS = "A": k = 9
173.                 CASE IS = "B": k = 999
174.                 CASE IS = "O": k = 50
175.                     'CASE ELSE: k = 30
176.             END SELECT
177.             frec (x - 1) * sq, (y - 1) * sq, sq, sq, k
178.         NEXT
179.     NEXT
180. END SUB
181. SUB rec (x1, y1, x2, y2, rgbN)
182.     rgb rgbN
183.     LINE (x1, y1)-(x2, y2), , B
184. END SUB
185. SUB frec (x1, y1, w, h, rgbN)
186.     rgb rgbN
187.     LINE (x1, y1)-STEP(w, h), , BF
188. END SUB
189. SUB rgb (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
190.     s3$ = RIGHT$("000" + LTRIM$(STR$(n)), 3)
191.     r = VAL(MID$(s3$, 1, 1)): IF r THEN r = 28 * r + 3
192.     g = VAL(MID$(s3$, 2, 1)): IF g THEN g = 28 * g + 3
193.     b = VAL(MID$(s3$, 3, 1)): IF b THEN b = 28 * b + 3
194.     COLOR _RGB32(r, g, b)
195. END SUB
196. FUNCTION rand% (lo%, hi%)
197.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
198. END FUNCTION
199. FUNCTION min (n1, n2)
200.     IF n1 > n2 THEN min = n2 ELSE min = n1
201. END FUNCTION
202. FUNCTION max (n1, n2)
203.     IF n1 < n2 THEN max = n2 ELSE max = n1
204. END FUNCTION
205. FUNCTION leftOf$ (source$, of$)
206.     posOf = INSTR(source$, of$)
207.     IF posOf > 0 THEN leftOf$ = MID$(source$, 1, posOf - 1)
208. END FUNCTION
209. FUNCTION rightOf$ (source$, of$)
210.     posOf = INSTR(source$, of$)
211.     IF posOf > 0 THEN rightOf$ = MID$(source$, posOf + LEN(of$))
212. END FUNCTION
213.  

Title: Re: B+ Pathfinder
Post by: FellippeHeitor on August 13, 2018, 09:55:01 pm

Very much amusing to watch, Mark.

Title: Re: B+ Pathfinder
Post by: bplus on August 13, 2018, 10:18:52 pm

Must be the zig zags! :)

Title: Re: B+ Pathfinder
Post by: bplus on August 13, 2018, 11:10:21 pm

I have noticed, when it does not find connection to B, I want more time to see for myself:

Mod for that (fits just before the end of the main loop):

Code: QB64: [Select]

1.     ELSE
2.         rgb 999
3.         LOCATE 15, 10: PRINT "Did not connect to B"
4.         WHILE NOT _KEYDOWN(32)
5.             IF _KEYDOWN(27) THEN END
6.             _LIMIT 100
7.         WEND
8.         WHILE _KEYDOWN(32): _LIMIT 100: WEND  '<<< BTW using spacebar several times in a row to restart the code, needs to be cleared from buffer
9.  
10.     END IF
11.  

The trick to this backtracking idea was learned from coding many versions of the Snake Game.

Title: Re: B+ Pathfinder
Post by: johnno56 on August 14, 2018, 04:07:23 am

Completely off topic.... I like your colour scheme... Care to share the settings?

J

Title: Re: B+ Pathfinder
Post by: FellippeHeitor on August 14, 2018, 06:19:41 am

I believe that's preset scheme Camouflage, though I could be wrong.

Title: Re: B+ Pathfinder
Post by: johnno56 on August 14, 2018, 06:30:00 am

Yep. Looks like Camouflage to me too... Thanks for that...

J

Title: Re: B+ Pathfinder
Post by: bplus on August 14, 2018, 06:49:55 am

Confirmed, Camouflage, I think I remember someone recommending it, Fellippe?

Holy Son of the Universal Machine! This Pathfinder technique can be generalized to every point on the map with the same one time calculation from a given point A!

stay tuned...

Title: Re: B+ Pathfinder
Post by: Ashish on August 14, 2018, 10:44:06 am

Nice work bplus!
This can be useful for me.

Title: Re: B+ Pathfinder
Post by: bplus on August 14, 2018, 10:56:37 am

Hi Ashish,

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

Title: Re: B+ Pathfinder
Post by: bplus on August 14, 2018, 10:22:30 pm

B+ Pathfinder 2, shows that once the map has been setup, you can find a path from any part of the map. To me, this is more powerful than what an A star Pathfinder can do.

Code: QB64: [Select]

1. _TITLE "PathFinder 2, prepping maze 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. DEFINT A-Z
14. CONST ww = 800
15. CONST wh = 600
16. CONST sq = 10
17. CONST mapw = 80
18. CONST maph = 60
19.  
20. SCREEN _NEWIMAGE(ww, wh, 32)
21. _SCREENMOVE (1280 - ww) / 2 + 30, (760 - wh) / 2
22. RANDOMIZE TIMER
23.  
24. DIM SHARED ax, ay, bx, by
25. DIM SHARED board(1 TO mapw, 1 TO maph) AS STRING * 6
26. DO
27.  
28.     'this part sets up a sample map and get's the Backtracking build into map
29.  
30.     FOR y = 1 TO maph
31.         FOR x = 1 TO mapw
32.             board(x, y) = " "
33.         NEXT
34.     NEXT
35.     'with these obstacles there is no guarantee a path will exist
36.     FOR i = 1 TO mapw * maph * .7
37.         ox = rand(1, mapw): oy = rand(1, maph)
38.         board(ox, oy) = "O"
39.     NEXT
40.     ax = rand(1, mapw): ay = rand(1, maph)
41.     board(ax, ay) = "A"
42.     parentF = 1: tick = 0: parentx = 0
43.     WHILE parentF = 1 AND parentx = 0
44.         parentF = 0: tick = tick + 1: changes$ = ""
45.         ystart = max(ay - tick, 1): ystop = min(ay + tick, maph)
46.         FOR y = ystart TO ystop
47.             xstart = max(ax - tick, 1): xstop = min(ax + tick, mapw)
48.             FOR x = xstart TO xstop
49.                 'check out the neighbors
50.                 IF x - 1 >= 1 THEN xxstart = x - 1 ELSE xxstart = x
51.                 IF x + 1 <= mapw THEN xxstop = x + 1 ELSE xxstop = x
52.                 IF y - 1 >= 1 THEN yystart = y - 1 ELSE yystart = y
53.                 IF y + 1 <= maph THEN yystop = y + 1 ELSE yystop = y
54.                 IF RTRIM$(board(x, y)) = "" THEN
55.                     cf = 0
56.                     FOR yy = yystart TO yystop
57.                         FOR xx = xxstart TO xxstop
58.                             IF xx <> x OR yy <> y THEN
59.                                 IF RTRIM$(board(xx, yy)) = "A" OR INSTR(RTRIM$(board(xx, yy)), ",") > 0 THEN 'found a parent to assign to cell
60.                                     changes$ = changes$ + LTRIM$(STR$(x)) + "," + LTRIM$(STR$(y)) + "{" + LTRIM$(STR$(xx)) + "," + LTRIM$(STR$(yy)) + "}"
61.                                     parentF = 1 'so will continue looping
62.                                     cf = 1: EXIT FOR
63.                                 END IF
64.                             END IF
65.                         NEXT
66.                         IF cf THEN EXIT FOR
67.                     NEXT
68.                 END IF
69.             NEXT
70.         NEXT
71.         'update board with cells assigned parents
72.         WHILE changes$ <> ""
73.             new$ = leftOf$(changes$, "}")
74.             changes$ = rightOf$(changes$, "}")
75.             newxy$ = leftOf$(new$, "{")
76.             newParent$ = rightOf$(new$, "{")
77.             u = VAL(leftOf$(newxy$, ",")): v = VAL(rightOf$(newxy$, ","))
78.             board(u, v) = leftOf$(newParent$, ",") + "," + rightOf$(newParent$, ",")
79.         WEND
80.         _LIMIT 300
81.     WEND
82.  
83.  
84.     'this parts displays the ability to find a path to blue square anywhere in the maze
85.  
86.     _TITLE "Click maze to find a path to blue square (if any), c = clear, n = new map, esc = quit"
87.     displayB
88.     DO
89.         'CLS
90.         'displayB
91.         WHILE _MOUSEINPUT: WEND
92.         IF _MOUSEBUTTON(1) THEN
93.             mx = _MOUSEX - .5 * sq: my = _MOUSEY - .5 * sq
94.             bx = mx / sq + 1: by = my / sq + 1
95.             IF bx >= 1 AND bx <= mapw AND by >= 1 AND by <= maph THEN
96.                 frec (bx - 1) * sq + 2, (by - 1) * sq + 2, sq - 4, sq - 4, 990
97.                 ps$ = board(bx, by)
98.                 parentx = VAL(leftOf$(ps$, ","))
99.                 parenty = VAL(rightOf$(ps$, ","))
100.                 IF parentx THEN 'backtrack to A   note: B could be right next to A!!!
101.                     frec (parentx - 1) * sq + 3, (parenty - 1) * sq + 3, sq - 6, sq - 6, 999
102.                     WHILE parentx 'trace the path back
103.                         ps$ = board(parentx, parenty)
104.                         parentx = VAL(leftOf$(ps$, ","))
105.                         parenty = VAL(rightOf$(ps$, ","))
106.                         frec (parentx - 1) * sq + 3, (parenty - 1) * sq + 3, sq - 6, sq - 6, 999
107.                         _LIMIT 10
108.                         _DISPLAY
109.                     WEND
110.                 ELSE
111.                     rgb 999
112.                     LOCATE 15, 10: PRINT "Did not connect to B"
113.                     _DISPLAY
114.                     _DELAY 3
115.                     displayB
116.                 END IF
117.             END IF
118.         END IF
119.         IF _KEYDOWN(27) THEN END
120.         IF _KEYDOWN(ASC("n")) THEN EXIT DO
121.         IF _KEYDOWN(ASC("c")) THEN displayB
122.         _DISPLAY
123.         _LIMIT 100
124.     LOOP
125. LOOP UNTIL _KEYDOWN(27)
126.  
127. SUB displayB
128.     FOR y = 1 TO maph
129.         FOR x = 1 TO mapw
130.             SELECT CASE RTRIM$(board(x, y))
131.                 CASE "A": k = 9
132.                 CASE "B": k = 905
133.                 CASE "O": k = 50
134.                 CASE ELSE: k = 0
135.             END SELECT
136.             frec (x - 1) * sq, (y - 1) * sq, sq, sq, k
137.         NEXT
138.     NEXT
139. END SUB
140. SUB rec (x1, y1, x2, y2, rgbN)
141.     rgb rgbN
142.     LINE (x1, y1)-(x2, y2), , B
143. END SUB
144. SUB frec (x1, y1, w, h, rgbN)
145.     rgb rgbN
146.     LINE (x1, y1)-STEP(w, h), , BF
147. END SUB
148. SUB rgb (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
149.     s3$ = RIGHT$("000" + LTRIM$(STR$(n)), 3)
150.     r = VAL(MID$(s3$, 1, 1)): IF r THEN r = 28 * r + 3
151.     g = VAL(MID$(s3$, 2, 1)): IF g THEN g = 28 * g + 3
152.     b = VAL(MID$(s3$, 3, 1)): IF b THEN b = 28 * b + 3
153.     COLOR _RGB32(r, g, b)
154. END SUB
155. FUNCTION rand% (lo%, hi%)
156.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
157. END FUNCTION
158. FUNCTION min (n1, n2)
159.     IF n1 > n2 THEN min = n2 ELSE min = n1
160. END FUNCTION
161. FUNCTION max (n1, n2)
162.     IF n1 < n2 THEN max = n2 ELSE max = n1
163. END FUNCTION
164. FUNCTION leftOf$ (source$, of$)
165.     posOf = INSTR(source$, of$)
166.     IF posOf > 0 THEN leftOf$ = MID$(source$, 1, posOf - 1)
167. END FUNCTION
168. FUNCTION rightOf$ (source$, of$)
169.     posOf = INSTR(source$, of$)
170.     IF posOf > 0 THEN rightOf$ = MID$(source$, posOf + LEN(of$))
171. END FUNCTION
172.  

 

 
Blue square is Point A the start point. Yellow squares are different destinations from A.

Title: Re: B+ Pathfinder
Post by: johnno56 on August 15, 2018, 05:05:00 am

... Riddle me this one, Batman...

J

Title: Re: B+ Pathfinder
Post by: bplus on August 15, 2018, 07:06:45 am

There you have clicked the hedge, the black is the free space on which paths are stepped through.

Also I was not satisfied when I clicked a spot that it was clicking the right square, so I adjusted the mouseX, mouseY by .5*sq = half the square size. For me it was better, for your pointer maybe worse,

Here is the line to diddle:
mx = _MOUSEX - .5 * sq: my = _MOUSEY - .5 * sq

maybe just leave it to mouse x, y no adjustments? Maybe adjust a whole square?

But you should be definitely attempting to click a black square. And some places will not connect to A the blue rectangle because the hedge completely surrounds the spot clicked.

Title: Re: B+ Pathfinder
Post by: bplus on August 15, 2018, 07:45:21 am

Now the next logical step is to write a function that returns the actual path to take from A to B, step by step.

I am inclined to make this function a string. Can functions return arrays?

I think I have always used a sub for array building.

Better would be to have real map problems to work on now that I have proof of concept.

Title: Re: B+ Pathfinder
Post by: SMcNeill on August 15, 2018, 10:19:36 am

Quote from: bplus on August 15, 2018, 07:45:21 am

Now the next logical step is to write a function that returns the actual path to take from A to B, step by step.

I am inclined to make this function a string. Can functions return arrays?

I think I have always used a sub for array building.

Better would be to have real map problems to work on now that I have proof of concept.

I tend to do something like this with an array of steps needed to move from point A to point B.

Code: QB64: [Select]

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

Place Hero with mouse, then target with mouse, then watch as it tries to build you a path from one point to the other.  Hit ESC after that to quit, or any other key to go again on a second map.

Not only does this give you a path to the "hero", but it also tells you how many steps would be required to reach ANY point available on the map.

EDIT:  Minor modification where I changed total map size just so it could display fully on machines running a smaller resolution than mine is.

Also note:  To get back from the Target to the Hero (as if the target was a monster chasing the hero), simply count down from the largest number at the hero to the adjacent square with the next smaller number.    To path find from the hero to the target, we'd just swap their search order and then trace back from highest square to lowest, same as before.  (Basically, just swap the values for the two targets...)

Title: Re: B+ Pathfinder
Post by: bplus 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.
 

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!

Title: Re: B+ Pathfinder
Post by: SMcNeill on August 15, 2018, 09:41:47 pm

Quote from: bplus 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.

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

Title: Re: B+ Pathfinder
Post by: bplus 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. END TYPE
59.  
60. SCREEN _NEWIMAGE(WW, WH, 32)
61. _SCREENMOVE _MIDDLE ' ah this is working better now! is it the 64X64 version?
62. RANDOMIZE TIMER
63.  
64. 'The MAP:
65. 'Decided to use integer values with Descriptive CONST names, thanks Tempodibasic
66. 'There will be a 1 SQ Border around the Map, the actual squares for game action run 1 to MAPW, 1 to MAPH
67. DIM SHARED MAP(MAPW + 2, MAPH + 2) AS INTEGER
68. DIM SHARED HC AS COORDINATE 'Hero Coordinate
69. DIM SHARED HDC AS COORDINATE 'Hero Destination Coordinate
70. DIM SHARED MX AS COORDINATE 'Map Exit
71. 'This will be a map used for getting paths from HC = Hero Coordinate  to HDC = Hero Destination Coordinate
72. DIM SHARED STEPMAP(MAPW + 2, MAPH + 2) AS INTEGER
73. DIM SHARED STEPS(MAPH * MAPW) AS COORDINATE
74. DIM SHARED STEPSI AS INTEGER 'counts steps
75. DIM SHARED OFFX, OFFY, HAULERMODE AS _BYTE
76. DIM t AS COORDINATE
77. OFFX = (WW - SQ * (MAPW + 2)) / 2
78. OFFY = (WH - SQ * (MAPH + 2)) / 2
79. 'f = _LOADFONT("cyberbit.ttf", 8, "monospace") ' I copy/pasted into my Pathfinder Folder
80. 'currFont& = _FONT(0)
81. HAULERMODE = 0
82. DO
83.  
84.     'this part sets up a sample map and get's the Backtracking build into map
85.  
86.     RandomMap .7
87.     HC.x = Rand(1, MAPW): HC.y = Rand(1, MAPH)
88.     MAP(HC.x, HC.y) = HERO
89.  
90.  
91.     'this parts displays the ability to find a path to blue square anywhere in the maze
92.  
93.     _TITLE "Click maze to display from Hero (white) a path to blue square (if any), c = clear, n = new map, esc = quit"
94.     displayMap
95.     DO
96.         'CLS
97.         displayMap
98.         WHILE _MOUSEINPUT: WEND
99.         IF _MOUSEBUTTON(1) THEN
100.             xm = _MOUSEX - OFFX - .5 * SQ
101.             ym = _MOUSEY - OFFY - .5 * SQ
102.             t.x = xm / SQ: t.y = ym / SQ 'type error
103.             LINE (t.x * SQ + OFFX + 1, t.y * SQ + OFFY + 1)-STEP(SQ - 3, SQ - 3), _RGB32(255, 0, 0), BF
104.             IF t.x >= 1 AND t.x <= MAPW AND t.y >= 1 AND t.y <= MAPH THEN
105.                 HDC.x = t.x: HDC.y = t.y
106.                 'path HDC
107.                 _DISPLAY
108.                 '_FONT f
109.                 'prepStepMap t
110.                 '_FONT currFont&
111.                 'path t
112.                 'IF STEPSI <> 0 THEN
113.                 '    displayMap
114.                 '    FOR s = 1 TO STEPSI
115.                 '        LINE (STEPS(s).x * SQ + OFFX + 2, STEPS(s).y * SQ + OFFY + 2)-STEP(SQ - 6, SQ - 6), _RGB32(255, 255, 0), BF
116.                 '        _LIMIT 5
117.                 '    NEXT
118.                 '    _DELAY 1
119.                 'END IF
120.                 'KH& = _KEYHIT
121.                 'WHILE KH& = 0: KH& = _KEYHIT: _LIMIT 100: WEND
122.             END IF
123.         END IF
124.         KH& = _KEYHIT
125.         SELECT CASE KH&
126.             CASE 104 'h
127.                 IF HAULERMODE THEN HAULERMODE = FALSE ELSE HAULERMODE = TRUE
128.             CASE 18432 'up
129.                 IF MAP(HC.x, HC.y - 1) = SPACER THEN
130.                     IF HAULERMODE AND MAP(HC.x, HC.y + 1) < -2 THEN
131.                         MAP(HC.x, HC.y - 1) = MAP(HC.x, HC.y)
132.                         MAP(HC.x, HC.y) = MAP(HC.x, HC.y + 1)
133.                         MAP(HC.x, HC.y + 1) = SPACER
134.                         HC.y = HC.y - 1
135.                     ELSEIF HAULERMODE = FALSE THEN
136.                         MAP(HC.x, HC.y - 1) = MAP(HC.x, HC.y)
137.                         MAP(HC.x, HC.y) = SPACER
138.                         HC.y = HC.y - 1
139.                     END IF
140.                 END IF
141.             CASE 20480 'down
142.                 IF MAP(HC.x, HC.y + 1) = SPACER THEN
143.                     IF HAULERMODE = TRUE AND MAP(HC.x, HC.y - 1) < -2 THEN
144.                         MAP(HC.x, HC.y + 1) = MAP(HC.x, HC.y)
145.                         MAP(HC.x, HC.y) = MAP(HC.x, HC.y - 1)
146.                         MAP(HC.x, HC.y - 1) = SPACER
147.                         HC.y = HC.y + 1
148.                     ELSEIF HAULERMODE = FALSE THEN
149.                         MAP(HC.x, HC.y + 1) = MAP(HC.x, HC.y)
150.                         MAP(HC.x, HC.y) = SPACER
151.                         HC.y = HC.y + 1
152.                     END IF
153.                 END IF
154.  
155.             CASE 19200 'left
156.                 IF MAP(HC.x - 1, HC.y) = SPACER THEN
157.                     IF HAULERMODE AND MAP(HC.x + 1, HC.y) < -2 THEN
158.                         MAP(HC.x - 1, HC.y) = MAP(HC.x, HC.y)
159.                         MAP(HC.x, HC.y) = MAP(HC.x + 1, HC.y)
160.                         MAP(HC.x + 1, HC.y) = SPACER
161.                         HC.x = HC.x - 1
162.                     ELSEIF HAULERMODE = FALSE THEN
163.                         MAP(HC.x - 1, HC.y) = MAP(HC.x, HC.y)
164.                         MAP(HC.x, HC.y) = SPACER
165.                         HC.x = HC.x - 1
166.                     END IF
167.                 END IF
168.  
169.             CASE 19712 'right
170.                 IF MAP(HC.x + 1, HC.y) = SPACER THEN
171.                     IF HAULERMODE = TRUE AND MAP(HC.x - 1, HC.y) < -2 THEN
172.                         MAP(HC.x + 1, HC.y) = MAP(HC.x, HC.y)
173.                         MAP(HC.x, HC.y) = MAP(HC.x - 1, HC.y)
174.                         MAP(HC.x - 1, HC.y) = SPACER
175.                         HC.x = HC.x + 1
176.                     ELSEIF HAULERMODE = FALSE THEN
177.                         MAP(HC.x + 1, HC.y) = MAP(HC.x, HC.y)
178.                         MAP(HC.x, HC.y) = SPACER
179.                         HC.x = HC.x + 1
180.                     END IF
181.                 END IF
182.  
183.                 'diagonal moves , so can use Pathfinder for routes
184.             CASE 18176 'left + up
185.                 IF MAP(HC.x - 1, HC.y - 1) = SPACER THEN
186.                     MAP(HC.x - 1, HC.y - 1) = MAP(HC.x, HC.y)
187.                     MAP(HC.x, HC.y) = SPACER
188.                     HC.x = HC.x - 1: HC.y = HC.y - 1
189.                 END IF
190.             CASE 18688 'right + up
191.                 IF MAP(HC.x + 1, HC.y - 1) = SPACER THEN
192.                     MAP(HC.x + 1, HC.y - 1) = MAP(HC.x, HC.y)
193.                     MAP(HC.x, HC.y) = SPACER
194.                     HC.x = HC.x + 1: HC.y = HC.y - 1
195.                 END IF
196.             CASE 20736 'right + down
197.                 IF MAP(HC.x + 1, HC.y + 1) = SPACER THEN
198.                     MAP(HC.x + 1, HC.y + 1) = MAP(HC.x, HC.y)
199.                     MAP(HC.x, HC.y) = SPACER
200.                     HC.x = HC.x + 1: HC.y = HC.y + 1
201.                 END IF
202.             CASE 20224 'left + down
203.                 IF MAP(HC.x - 1, HC.y + 1) = SPACER THEN
204.                     MAP(HC.x - 1, HC.y + 1) = MAP(HC.x, HC.y)
205.                     MAP(HC.x, HC.y) = SPACER
206.                     HC.x = HC.x - 1: HC.y = HC.y + 1
207.                 END IF
208.  
209.         END SELECT
210.  
211.         IF _KEYDOWN(27) THEN END
212.         IF _KEYDOWN(ASC("n")) THEN EXIT DO
213.         IF _KEYDOWN(ASC("c")) THEN displayMap
214.  
215.         '_DISPLAY
216.         _LIMIT 100
217.     LOOP
218. LOOP UNTIL _KEYDOWN(27)
219.  
220. SUB path (ptB AS COORDINATE)
221.     'path is from hero (DIM SHATED HC as COORDINATE) to ptB
222.     prepStepMap ptB
223.     dist = STEPMAP(HC.x, HC.y) 'STEPMAP is DIM SHARED as INTEGER
224.     IF dist = 0 THEN
225.         STEPSI = 0
226.         LOCATE 1, 1: PRINT "Hero cannot connect to destination."
227.         EXIT SUB
228.     ELSE
229.         LOCATE 1, 1: PRINT "Hero distance is: "; dist
230.     END IF
231.  
232.     STEPSI = 0 'DIM SHARED error signal
233.     cx = HC.x: cy = HC.y
234.     WHILE dist >= 2
235.         'LOCATE 2, 1: PRINT "cx, cy: "; cx, cy '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< debug
236.         cf = 0
237.         FOR y = cy - 1 TO cy + 1
238.             FOR x = cx - 1 TO cx + 1
239.                 'PRINT "x, y, STEPMAP(x, y) "; x, y, STEPMAP(x, y)
240.                 IF STEPMAP(x, y) = dist - 1 THEN
241.                     STEPSI = STEPSI + 1
242.                     STEPS(STEPSI).x = x: STEPS(STEPSI).y = y
243.                     'LINE (STEPS(STEPSI).x * SQ + OFFX, STEPS(STEPSI).y * SQ + OFFY)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 0), B
244.                     cf = 1: EXIT FOR
245.                 END IF
246.             NEXT
247.             IF cf = 1 THEN EXIT FOR
248.         NEXT
249.         IF cf = 0 THEN 'lost path
250.             EXIT SUB
251.         ELSE
252.             cx = STEPS(STEPSI).x: cy = STEPS(STEPSI).y
253.             dist = dist - 1
254.             ' _LIMIT 10
255.         END IF
256.     WEND
257. END SUB
258.  
259. 'this is Steve McNeil's method optimised to skip over needless or redundant checks
260. SUB prepStepMap (target AS COORDINATE)
261.     FOR y = 1 TO MAPH
262.         FOR x = 1 TO MAPW
263.             STEPMAP(x, y) = 0
264.         NEXT
265.     NEXT
266.     STEPMAP(target.x, target.y) = 1: tick = 1: changes = 1
267.     WHILE changes
268.         tick = tick + 1: changes = 0
269.         ystart = max(target.y - tick, 1): ystop = min(target.y + tick, MAPH)
270.         FOR y = ystart TO ystop
271.             xstart = max(target.x - tick, 1): xstop = min(target.x + tick, MAPW)
272.             FOR x = xstart TO xstop
273.                 'check out the neighbors
274.                 IF MAP(x, y) = SPACER OR MAP(x, y) = HERO THEN
275.                     cf = 0
276.                     FOR yy = y - 1 TO y + 1
277.                         FOR xx = x - 1 TO x + 1
278.                             IF NOT (xx = x AND yy = y) THEN
279.                                 IF STEPMAP(xx, yy) = tick - 1 AND STEPMAP(x, y) = 0 THEN 'found a parent to assign to cell
280.                                     STEPMAP(x, y) = tick
281.                                     '_PRINTSTRING (x * SQ + OFFX + 2, y * SQ + OFFY + 5), LTRIM$(STR$(STEPMAP(x, y)))
282.                                     changes = 1: cf = 1: EXIT FOR
283.                                 END IF
284.                             END IF
285.  
286.                         NEXT
287.                         IF cf THEN EXIT FOR
288.                     NEXT
289.                 END IF
290.             NEXT
291.         NEXT
292.         '_LIMIT 10
293.     WEND
294. END SUB
295.  
296. SUB displayMap
297.     'MAP is shared, 0 based with width mapw, height maph that are constants
298.     DIM k AS LONG
299.     path HDC
300.     FOR y = 0 TO MAPH + 1
301.         FOR x = 0 TO MAPW + 1
302.             SELECT CASE MAP(x, y)
303.                 'CASE HERO: k = _RGB32(255, 255, 255)
304.                 CASE BORDER: k = _RGB32(255, 128, 64)
305.                 CASE OBSTACLE: k = _RGB32(0, 128, 0)
306.                 CASE SPACER: k = _RGB32(0, 0, 0)
307.                 CASE DOOR: k = _RGB32(0, 0, 255)
308.             END SELECT
309.             LINE (x * SQ + OFFX, y * SQ + OFFY)-STEP(SQ - 2, SQ - 2), k, BF
310.         NEXT
311.     NEXT
312.     IF STEPSI <> 0 THEN
313.         'displayMap
314.         FOR s = 1 TO STEPSI
315.             LINE (STEPS(s).x * SQ + OFFX + 2, STEPS(s).y * SQ + OFFY + 2)-STEP(SQ - 6, SQ - 6), _RGB32(255, 255, 0), BF
316.             '_LIMIT 5
317.         NEXT
318.         '_DELAY 1
319.     END IF
320.     LINE (HC.x * SQ + OFFX + 1, HC.y * SQ + OFFY + 1)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 255), BF
321.     LOCATE 1, 72: PRINT SPACE$(20)
322.     LOCATE 1, 72: PRINT "Hauler Mode is ";
323.     IF HAULERMODE THEN PRINT "ON" ELSE PRINT "OFF"
324.     _DISPLAY
325.     _LIMIT 30
326. END SUB
327.  
328. 'someone might start with this a build a map or levels editor!
329. 'load a shared MAP(1 to mapw, 1 to maph)
330. SUB RandomMap (obstacleDensity!)
331.     'clear old
332.     FOR y = 1 TO MAPH
333.         FOR x = 1 TO MAPW
334.             MAP(x, y) = SPACER
335.         NEXT
336.     NEXT
337.  
338.     'borders
339.     FOR x = 0 TO MAPW + 1
340.         MAP(x, 0) = BORDER
341.         MAP(x, MAPH + 1) = BORDER
342.     NEXT
343.     FOR y = 0 TO MAPH + 1
344.         MAP(0, y) = BORDER
345.         MAP(MAPW + 1, y) = BORDER
346.     NEXT
347.  
348.     'convert this part into walls, buildings, jewels, potions...
349.     'with these obstacles there is no guarantee a path will exist
350.     FOR I = 1 TO MAPW * MAPH * obstacleDensity!
351.         ox = Rand(1, MAPW): oy = Rand(1, MAPH)
352.         MAP(ox, oy) = OBSTACLE
353.     NEXT
354.  
355.     'door
356.     wall = Rand(1, 4)
357.     SELECT CASE wall
358.         CASE 1: MX.x = 1: MX.y = Rand(2, MAPH - 2)
359.         CASE 2: MX.x = MAPW: MX.y = Rand(2, MAPH - 2)
360.         CASE 3: MX.x = Rand(2, MAPW - 2): MX.y = 1
361.         CASE 4: MX.x = Rand(2, MAPW - 2): MX.y = MAPH
362.     END SELECT
363.     MAP(MX.x, MX.y) = DOOR
364.  
365. END SUB
366.  
367. FUNCTION Rand% (lo%, hi%)
368.     Rand% = INT(RND * (hi% - lo% + 1)) + lo%
369. END FUNCTION
370. FUNCTION min (n1, n2)
371.     IF n1 > n2 THEN min = n2 ELSE min = n1
372. END FUNCTION
373. FUNCTION max (n1, n2)
374.     IF n1 < n2 THEN max = n2 ELSE max = n1
375. END FUNCTION
376. FUNCTION leftOf$ (source$, of$)
377.     posOf = INSTR(source$, of$)
378.     IF posOf > 0 THEN leftOf$ = MID$(source$, 1, posOf - 1)
379. END FUNCTION
380. FUNCTION rightOf$ (source$, of$)
381.     posOf = INSTR(source$, of$)
382.     IF posOf > 0 THEN rightOf$ = MID$(source$, posOf + LEN(of$))
383. END FUNCTION
384. FUNCTION trim$ (s$)
385.     trim$ = LTRIM$(RTRIM$(s$))
386. END FUNCTION
387.  
388.  

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!

Title: Re: B+ Pathfinder
Post by: bplus 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. END TYPE
85.  
86. SCREEN _NEWIMAGE(WW, WH, 32)
87. _SCREENMOVE _MIDDLE ' ah this is working better now! is it the 64X64 version?
88. RANDOMIZE TIMER
89.  
90. 'The MAP:
91. 'There will be a 1 SQ Border around the Map, the actual squares for game action run 1 to MAPW, 1 to MAPH
92. DIM SHARED MAP(MAPW + 2, MAPH + 2) AS INTEGER
93. DIM SHARED HC AS COORDINATE 'Hero Coordinate
94. DIM SHARED HDC AS COORDINATE 'Hero Destination Coordinate
95. DIM SHARED MX AS COORDINATE 'Map Exit, AKA Door
96.  
97. 'This will be a map used for getting paths from HC = Hero Coordinate  to HDC = Hero Destination Coordinate
98. DIM SHARED STEPMAP(MAPW + 2, MAPH + 2) AS INTEGER
99. DIM SHARED STEPS(MAPH * MAPW) AS COORDINATE
100. DIM SHARED STEPSI AS INTEGER 'counts steps
101. DIM SHARED XOFF, YOFF, HAULMODE AS _BYTE, PUSHMODE AS _BYTE
102. DIM t AS COORDINATE
103. XOFF = (WW - SQ * (MAPW + 2)) / 2
104. YOFF = (WH - SQ * (MAPH + 2)) / 2
105. HAULMODE = 0: PUSHMODE = 0
106. DO
107.  
108.     'this part sets up a sample map, and here the door is created
109.     RandomMap .7
110.     'set door as first destination for pathing
111.     HDC.X = MX.X: HDC.Y = MX.Y
112.  
113.     'find free space to start hero
114.     DO
115.         testx = Rand(1, MAPW): testy = Rand(1, MAPH)
116.     LOOP UNTIL MAP(testx, testy) = SPACER
117.     HC.X = testx: HC.Y = testy
118.  
119.     'this part displays the ability to find a path to blue square anywhere in the maze
120.  
121.     _TITLE "ctrl+Arrow <haul, shift+Arrow >push, Click to set destination, n or blue door for new map, esc=quit"
122.     DO
123.  
124.         WHILE _MOUSEINPUT: WEND
125.         IF _MOUSEBUTTON(1) THEN
126.             xm = _MOUSEX - XOFF - .5 * SQ
127.             ym = _MOUSEY - YOFF - .5 * SQ
128.             t.X = xm / SQ: t.Y = ym / SQ
129.             IF t.X >= 1 AND t.X <= MAPW AND t.Y >= 1 AND t.Y <= MAPH THEN
130.                 HDC.X = t.X: HDC.Y = t.Y
131.             END IF
132.         END IF
133.         KH& = _KEYHIT
134.         IF _KEYDOWN(100306) THEN HAULMODE = TRUE ELSE HAULMODE = fales 'ctrl
135.         IF _KEYDOWN(100304) THEN PUSHMODE = TRUE ELSE PUSHMODE = FALSE 'shft
136.         IF PUSHMODE AND HAULMODE THEN PUSHMODE = FALSE: HAULMODE = FALSE
137.         SELECT CASE KH&
138.             CASE 18432 'up
139.                 IF MAP(HC.X, HC.Y - 1) = DOOR THEN EXIT DO
140.                 IF MAP(HC.X, HC.Y - 1) = SPACER THEN
141.                     IF HAULMODE AND MAP(HC.X, HC.Y + 1) < -2 THEN
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 HAULMODE = FALSE AND PUSHMODE = FALSE THEN
146.                         HC.Y = HC.Y - 1
147.                     END IF
148.                 ELSEIF MAP(HC.X, HC.Y - 2) = SPACER AND MAP(HC.X, HC.Y - 1) < -2 AND PUSHMODE THEN
149.                     MAP(HC.X, HC.Y - 2) = MAP(HC.X, HC.Y - 1)
150.                     MAP(HC.X, HC.Y - 1) = MAP(HC.X, HC.Y)
151.                     HC.Y = HC.Y - 1
152.                 END IF
153.  
154.             CASE 20480 'down
155.                 IF MAP(HC.X, HC.Y + 1) = DOOR THEN EXIT DO
156.                 IF MAP(HC.X, HC.Y + 1) = SPACER THEN
157.                     IF HAULMODE = TRUE AND MAP(HC.X, HC.Y - 1) < -2 THEN
158.                         MAP(HC.X, HC.Y) = MAP(HC.X, HC.Y - 1)
159.                         MAP(HC.X, HC.Y - 1) = SPACER
160.                         HC.Y = HC.Y + 1
161.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
162.                         HC.Y = HC.Y + 1
163.                     END IF
164.                 ELSEIF MAP(HC.X, HC.Y + 2) = SPACER AND MAP(HC.X, HC.Y + 1) < -2 AND PUSHMODE THEN
165.                     MAP(HC.X, HC.Y + 2) = MAP(HC.X, HC.Y + 1)
166.                     MAP(HC.X, HC.Y + 1) = MAP(HC.X, HC.Y)
167.                     HC.Y = HC.Y + 1
168.                 END IF
169.  
170.             CASE 19200 'left
171.                 IF MAP(HC.X - 1, HC.Y) = DOOR THEN EXIT DO
172.                 IF MAP(HC.X - 1, HC.Y) = SPACER THEN
173.                     IF HAULMODE AND MAP(HC.X + 1, HC.Y) < -2 THEN
174.                         MAP(HC.X, HC.Y) = MAP(HC.X + 1, HC.Y)
175.                         MAP(HC.X + 1, HC.Y) = SPACER
176.                         HC.X = HC.X - 1
177.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
178.                         HC.X = HC.X - 1
179.                     END IF
180.                 ELSEIF MAP(HC.X - 2, HC.Y) = SPACER AND MAP(HC.X - 1, HC.Y) < -2 AND PUSHMODE THEN
181.                     MAP(HC.X - 2, HC.Y) = MAP(HC.X - 1, HC.Y)
182.                     MAP(HC.X - 1, HC.Y) = SPACER
183.                     HC.X = HC.X - 1
184.                 END IF
185.  
186.             CASE 19712 'right
187.                 IF MAP(HC.X + 1, HC.Y) = DOOR THEN EXIT DO
188.                 IF MAP(HC.X + 1, HC.Y) = SPACER THEN
189.                     IF HAULMODE = TRUE AND MAP(HC.X - 1, HC.Y) < -2 THEN
190.                         MAP(HC.X, HC.Y) = MAP(HC.X - 1, HC.Y)
191.                         MAP(HC.X - 1, HC.Y) = SPACER
192.                         HC.X = HC.X + 1
193.                     ELSEIF HAULMODE = FALSE AND PUSHMODE = FALSE THEN
194.                         HC.X = HC.X + 1
195.                     END IF
196.                 ELSEIF MAP(HC.X + 2, HC.Y) = SPACER AND MAP(HC.X + 1, HC.Y) < -2 AND PUSHMODE THEN
197.                     MAP(HC.X + 2, HC.Y) = MAP(HC.X + 1, HC.Y)
198.                     MAP(HC.X + 1, HC.Y) = MAP(HC.X, HC.Y)
199.                     HC.X = HC.X + 1
200.                 END IF
201.  
202.         END SELECT
203.  
204.         IF _KEYDOWN(27) THEN END
205.         IF _KEYDOWN(ASC("n")) THEN EXIT DO
206.         displayMap
207.         _LIMIT 100
208.     LOOP
209. LOOP UNTIL _KEYDOWN(27)
210.  
211. SUB path (ptB AS COORDINATE)
212.     'path is from hero (DIM SHARED HC as COORDINATE) to ptB (DIM SHARED HDC
213.     prepStepMap ptB
214.     dist = STEPMAP(HC.X, HC.Y) 'STEPMAP is DIM SHARED as INTEGER
215.     STEPSI = 0 'DIM SHARED, no path is signaled if still 0 after this sub
216.     IF dist = 0 THEN EXIT SUB
217.     cx = HC.X: cy = HC.Y
218.     'count dist down to destination
219.     WHILE dist >= 2
220.         cf = 0
221.         IF STEPMAP(cx, cy - 1) = dist - 1 THEN
222.             cf = 1: cy = cy - 1
223.         ELSEIF STEPMAP(cx - 1, cy) = dist - 1 THEN
224.             cf = 1: cx = cx - 1
225.         ELSEIF STEPMAP(cx + 1, cy) = dist - 1 THEN
226.             cf = 1: cx = cx + 1
227.         ELSEIF STEPMAP(cx, cy + 1) = dist - 1 THEN
228.             cf = 1: cy = cy + 1
229.         END IF
230.         IF cf = 0 THEN 'lost path, this should not happen until it is done
231.             EXIT SUB
232.         ELSE
233.             'add next step to steps array, set next search target
234.             STEPSI = STEPSI + 1: STEPS(STEPSI).X = cx: STEPS(STEPSI).Y = cy
235.             dist = dist - 1
236.         END IF
237.     WEND
238. END SUB
239.  
240. 'this is Steve McNeil's method optimised to skip over needless or redundant checks
241. SUB prepStepMap (target AS COORDINATE)
242.     FOR y = 1 TO MAPH
243.         FOR x = 1 TO MAPW
244.             STEPMAP(x, y) = 0
245.         NEXT
246.     NEXT
247.     STEPMAP(target.X, target.Y) = 1: tick = 1: changes = 1
248.     'from an ever broadening area around destination find neighbor to step from
249.     WHILE changes
250.         t = tick: tick = tick + 1: changes = 0
251.         ystart = max(target.Y - tick, 1): ystop = min(target.Y + tick, MAPH)
252.         FOR y = ystart TO ystop
253.             xstart = max(target.X - tick, 1): xstop = min(target.X + tick, MAPW)
254.             FOR x = xstart TO xstop
255.                 'check out the neighbors
256.                 IF MAP(x, y) = SPACER THEN
257.                     IF STEPMAP(x, y) = 0 THEN
258.                         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
259.                             'there is a step close by to step from
260.                             STEPMAP(x, y) = tick: changes = 1 'next step
261.                         END IF
262.                     END IF 'stepmap = 0
263.                 END IF 'map = spacer
264.             NEXT
265.         NEXT
266.     WEND
267. END SUB
268.  
269. SUB displayMap 'all drawing instructions conatined here
270.     'MAP is shared, 1 based with width =  mapw, height = maph that are constants
271.     DIM k AS LONG 'kolor tiles
272.     CLS
273.     FOR y = 0 TO MAPH + 1
274.         FOR x = 0 TO MAPW + 1
275.             SELECT CASE MAP(x, y)
276.                 'CASE HERO: k = _RGB32(255, 255, 255)   'not embedded in map anymore
277.                 CASE BORDER: k = _RGB32(255, 128, 64)
278.                 CASE OBSTACLE: k = _RGB32(0, 128, 0)
279.                 CASE SPACER: k = _RGB32(0, 0, 0)
280.                 CASE DOOR: k = _RGB32(0, 0, 255)
281.             END SELECT
282.             LINE (x * SQ + XOFF, y * SQ + YOFF)-STEP(SQ - 2, SQ - 2), k, BF
283.         NEXT
284.     NEXT
285.  
286.     'loads steps array with steps from hero to destination from prepared stepmap array,
287.     'stepsI is number of steps to destination unless = 0
288.     path HDC
289.     IF STEPSI <> 0 THEN
290.         FOR s = 1 TO STEPSI
291.             LINE (STEPS(s).X * SQ + XOFF + 10, STEPS(s).Y * SQ + YOFF + 10)-STEP(SQ - 20, SQ - 20), _RGB32(255, 255, 0), BF
292.         NEXT
293.     END IF
294.  
295.     'draw target or destination
296.     FOR i = 6 TO 10 STEP 2
297.         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
298.         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
299.     NEXT
300.  
301.     'draw hero
302.     LINE (HC.X * SQ + XOFF + 1, HC.Y * SQ + YOFF + 1)-STEP(SQ - 4, SQ - 4), _RGB32(255, 255, 255), BF
303.  
304.     'special keys = powers
305.     LOCATE 1, 90: PRINT SPACE$(30)
306.     IF PUSHMODE THEN LOCATE 1, 90: PRINT "Push Mode is ON."
307.     IF HAULMODE THEN LOCATE 1, 90: PRINT "Haul Mode is ON."
308.     _DISPLAY
309. END SUB
310.  
311. 'someone might start with this a build a map or levels editor!
312. 'load a shared MAP(1 to mapw, 1 to maph)
313. SUB RandomMap (obstacleDensity!) ' obstacleDensity! = fraction of map squares to make obstacles
314.     'MAP is shared, 1 based with width =  mapw, height = maph that are constants
315.     'clear last map
316.     FOR y = 1 TO MAPH
317.         FOR x = 1 TO MAPW
318.             MAP(x, y) = SPACER
319.         NEXT
320.     NEXT
321.  
322.     'borders
323.     FOR x = 0 TO MAPW + 1
324.         MAP(x, 0) = BORDER
325.         MAP(x, MAPH + 1) = BORDER
326.     NEXT
327.     FOR y = 0 TO MAPH + 1
328.         MAP(0, y) = BORDER
329.         MAP(MAPW + 1, y) = BORDER
330.     NEXT
331.  
332.     'convert this part into walls, buildings, jewels, potions...
333.     'with these obstacles there is no guarantee a path will exist
334.     FOR I = 1 TO MAPW * MAPH * obstacleDensity!
335.         ox = Rand(1, MAPW): oy = Rand(1, MAPH)
336.         MAP(ox, oy) = OBSTACLE
337.     NEXT
338.  
339.     'door, exit to next map near a border?
340.     wall = Rand(1, 4)
341.     SELECT CASE wall
342.         CASE 1: MX.X = 1: MX.Y = Rand(2, MAPH - 2)
343.         CASE 2: MX.X = MAPW: MX.Y = Rand(2, MAPH - 2)
344.         CASE 3: MX.X = Rand(2, MAPW - 2): MX.Y = 1
345.         CASE 4: MX.X = Rand(2, MAPW - 2): MX.Y = MAPH
346.     END SELECT
347.     MAP(MX.X, MX.Y) = DOOR
348. END SUB
349.  
350. 'handy functions
351. FUNCTION Rand% (lo%, hi%)
352.     Rand% = INT(RND * (hi% - lo% + 1)) + lo%
353. END FUNCTION
354. FUNCTION min (n1, n2)
355.     IF n1 > n2 THEN min = n2 ELSE min = n1
356. END FUNCTION
357. FUNCTION max (n1, n2)
358.     IF n1 < n2 THEN max = n2 ELSE max = n1
359. END FUNCTION
360.  
361.  

Title: Re: B+ Pathfinder
Post by: PMACKAY 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.

Title: Re: B+ Pathfinder
Post by: bplus 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.

Title: Re: B+ Pathfinder
Post by: PMACKAY 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.

Title: Re: B+ Pathfinder
Post by: OldMoses on September 09, 2018, 02:39:03 pm

Quote from: bplus on August 14, 2018, 10:56:37 am

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...

Title: Re: B+ Pathfinder
Post by: bplus on September 09, 2018, 03:57:49 pm

Wow! that is pretty elaborate!

Text Only | Text with Attachments