A* pathfinding in QB64

[Cobalt]

Does anybody know of someone trying to implement an A* Pathfinding routine in QB64. the examples I've found are in other languages and trying to convert it to QB64 just isn't happening for me. I think I understand it but for some reason my mind just wont convert it to basic code. its probably easier than I think it should be and thats why but its just not happening for me yet.

[bplus]

HiCobalt,

I remember a discussion not long ago:
https://www.qb64.org/forum/index.php?topic=321.0

There is a method for Windows of creating a temp file in a shell of a directory listing from which you can get files and/or folders from which you access from QB64 for purposes of getting file(s) or subFolder lists. It is also possible to build a navigator from that. There is a fine example in Wiki from which I created a file retriever.

[Cobalt]

Wrong pathfinding bplus.
I mean from Point A to Point B on a map going around obstructions.

[FellippeHeitor]

Perhaps from Javascript and with a good tutor you can convert it easier:

[bplus]

Would a map be a listing of which point connects to which point?

And a path be a string of points from a to b?

And do you want the shortest path or any old path that gets you there?

[FellippeHeitor]

bplus: https://en.wikipedia.org/wiki/A*_search_algorithm

[bplus]

Thanks I found this

[Petr]

Maybe it help.... works not full correctly... press key for move. It is different solution. I use many IF conditions...

Code: QB64: [Select]

1.  
2. 'maze demo - quad go from sector A to sector B and respect walls:
3.  
4. DIM maze(99, 99) AS _BYTE
5. FOR Wall = 1 TO 1000
6.     begin:
7.     x = RND * 99
8.     y = RND * 99
9.     IF x > 99 OR y > 99 THEN GOTO begin
10.     IF maze(x, y) = 0 THEN maze(x, y) = 1 ELSE GOTO begin
11. NEXT Wall
12.  
13. 'let say, start position for point is 1,1, end position is 100,100
14. maze(1, 1) = 2: x = 0: y = 0
15. SCREEN _NEWIMAGE(1000, 1000, 256)
16.  
17. FOR x = 0 TO 99
18.     FOR y = 0 TO 99
19.  
20.         IF maze(x, y) = 2 THEN clr = 15
21.         IF maze(x, y) = 1 THEN clr = 9
22.         IF maze(x, y) = 0 THEN clr = 0
23.         LINE (x * 10, y * 10)-((x * 10) - 9, (y * 10) - 9), clr, B 'show map
24. NEXT y, x
25. mX = 1
26. mY = 1
27.  
28. DO WHILE INKEY$ <> CHR$(27)
29.     s:
30.  
31.     IF posX + mX > 98 OR posX + mX < 1 THEN mX = -1 * mX
32.     IF posY + mY > 98 OR posY + mY < 1 THEN mY = -1 * mY
33.  
34.  
35.     oldX = posX
36.     oldY = posY
37.  
38.     oldmx = mX
39.     oldmy = mY
40.  
41.  
42.     IF maze(posX + mX, posY + mY) <> 1 THEN
43.         posX = posX + mX
44.         posY = posY + mY
45.     END IF
46.  
47.     LINE (posX * 10, posY * 10)-((posX * 10) - 9, (posY * 10) - 9), 15, B 'show map
48.     LINE (oldX * 10, oldY * 10)-((oldX * 10) - 9, (oldY * 10) - 9), 0, B 'show map
49.  
50.  
51.  
52.  
53.  
54.  
55.  
56.     IF posX + mX > 0 AND posX + mX < 99 AND posY + mY > 0 AND posY + mY < 99 THEN
57.  
58.         t = RND * 10
59.         IF t > .55 THEN
60.  
61.             IF posY > 0 AND posY < 98 THEN
62.                 IF oldmx = mX AND maze(posX, posY - 1) <> 1 THEN mY = -1
63.                 IF oldmx = mX AND maze(posX, posY + 1) <> 1 THEN mY = 1
64.             END IF
65.  
66.             IF posX > 0 AND posX < 98 THEN
67.                 IF oldmy = mY AND maze(posX - 1, posY) <> 1 THEN mX = -1
68.                 IF oldmy = mY AND maze(posX + 1, posY) <> 1 THEN mX = 1
69.             END IF
70.  
71.         END IF
72.  
73.  
74.  
75.         IF maze(posX, posY - 1) <> 1 AND mY = 0 THEN mY = -1
76.         IF maze(posX, posY + 1) <> 1 AND mY = 0 THEN mY = 1
77.         IF maze(posX - 1, posY) <> 1 AND mX = 0 THEN mX = -1
78.         IF maze(posX + 1, posY) <> 1 AND mX = 0 THEN mX = 1
79.  
80.  
81.         IF maze(posX + mX, posY + mY) = 1 THEN
82.             BEEP
83.             IF maze(posX + 1, posY) <> 1 THEN mX = 1: mY = 0: GOTO s
84.             IF maze(posX, posY + 1) <> 1 THEN mX = 0: mY = 1: GOTO s
85.             IF maze(posX - 1, posY) <> 1 THEN mX = -1: mY = 0: GOTO s
86.             IF maze(posX, posY - 1) <> 1 THEN mX = 0: mY = -1: GOTO s
87.         END IF
88.  
89.     END IF
90.     SLEEP
91. LOOP
92.  
93.  

[Petr]

But if  you meant way, how to draw lines between two points (as LINE, but step by step with PSET), so i have writed program for it, he works correctly now in all directions,

[Petr]

Fellippe, thank you for link. This way can be used for new PAINT program - not limited to 1 border color.

[Cobalt]

Thanks guys. I think I'm finally getting my head wrapped round this.
And somehow I managed to find this bit of code actually written in QB64.

 by u/ybycomh around 4 years ago.

Code: QB64: [Select]

1. REM $dynamic
2.  
3. TYPE Coord: x AS INTEGER: y AS INTEGER: END TYPE
4.  
5. TYPE PathCoord
6.     pos AS Coord ' Coordinates of position on map
7.     parent AS Coord ' Coordinates of previous position on path
8.     g AS INTEGER ' G cost value
9.     h AS INTEGER ' H cost value
10.     f AS INTEGER ' F = G + H (total movement cost)
11.     status AS INTEGER ' 0 for unsearched, 1 for open, 2 for closed (explored)
12. END TYPE
13.  
14. DIM SHARED TargetFound
15. DIM Start AS Coord, Target AS Coord
16.  
17. CONST RandomSearch = 1 ' 1 => Randomly decide intesnity of search estimations (rush)
18. CONST DEBUG = 50 ' 0 => Debug mode off
19. '''''''''''''''''' DEBUG > 0 => Debug mode on, where DEBUG is animation speed
20. '''''''''''''''''' -1 => Debug mode on with SLEEPs between frames
21. CONST Resx = 1024 ' Set Screen Resolution
22. CONST Resy = 768 ' If you change it, the map will automatically fill the screen
23. CONST FPS = 20 ' Animation Speed
24. CONST TileSize = 10 ' Set size of square tiles
25. CONST MinMapDensity = 10 ' Set range of density to fill generated maps with walls
26. CONST MaxMapDensity = 35
27. CONST MinWallLength = MinMapDensity / 2
28. CONST MaxWallLength = MaxMapDensity / 2
29.  
30. Mapx = INT((Resx * .95) / TileSize) ' Dimension SampleMap to fit to screen
31. Mapy = INT((Resy * .95) / TileSize)
32. DIM SampleMap(Mapx, Mapy)
33.  
34. MaxPathLength = Mapx * Mapy * 0.5 ' Max number of saved path positions
35. DIM Path(MaxPathLength) AS Coord '' Dimension array of path coords to be filled in later
36.  
37. CLS: SCREEN _NEWIMAGE(Resx, Resy, 256)
38.  
39. RANDOMIZE TIMER / 3
40. DO
41.     REDIM Path(MaxPathLength) AS Coord, SampleMap(Mapx, Mapy)
42.  
43.     FOR ix = 0 TO Mapx
44.         SampleMap(ix, 0) = 1: SampleMap(ix, Mapy) = 1
45.     NEXT
46.     FOR iy = 0 TO Mapy
47.         SampleMap(0, iy) = 1: SampleMap(Mapx, iy) = 1
48.     NEXT
49.  
50.     MapDensity = INT((MaxMapDensity - MinMapDensity) * RND) + MinMapDensity
51.     FOR ix = 0 TO Mapx
52.         FOR iy = 0 TO Mapy
53.             RandNumber = INT(100 * RND) + 1
54.             IF RandNumber < MapDensity THEN SampleMap(ix, iy) = 1
55.         NEXT
56.     NEXT
57.  
58.     FOR i = 0 TO (MapDensity * 2)
59.         WallDirection = INT(2 * RND) + 1
60.         WallLength = INT((MaxWallLength - MinWallLength) * RND) + MinWallLength
61.  
62.         IF WallDirection = 1 THEN
63.             WallX = INT((Mapx) * RND)
64.             IF WallX + WallLength > Mapx THEN WallX = Mapx - WallLength
65.             iy = INT(Mapy * RND)
66.             FOR ix = WallX TO (WallX + WallLength)
67.                 SampleMap(ix, iy) = 1
68.             NEXT
69.         END IF
70.  
71.         IF WallDirection = 2 THEN
72.             WallY = INT((Mapy) * RND)
73.             IF WallY + WallLength > Mapy THEN WallY = Mapy - WallLength
74.             ix = INT(Mapx * RND)
75.             FOR iy = WallY TO (WallY + WallLength)
76.                 SampleMap(ix, iy) = 1
77.             NEXT
78.         END IF
79.     NEXT
80.  
81.     DO
82.         Start.x = INT((Mapx - 2) * RND) + 2 ' Set start position
83.         Start.y = INT((Mapy - 2) * RND) + 2
84.         IF Collision(Start, SampleMap()) = 0 THEN EXIT DO
85.     LOOP
86.     DO
87.         Target.x = INT((Mapx - 2) * RND) + 2 ' Set target position
88.         Target.y = INT((Mapy - 2) * RND) + 2
89.         IF Collision(Target, SampleMap()) = 0 THEN EXIT DO
90.     LOOP
91.  
92.     CALL SetPath(Path(), Start, Target, SampleMap())
93.  
94.     i = 0
95.     DO: _LIMIT FPS: CLS
96.  
97.         FOR ix = 0 TO Mapx
98.             FOR iy = 0 TO Mapy
99.                 IF SampleMap(ix, iy) = 1 THEN CALL DrawBlock(ix, iy, 15)
100.             NEXT
101.         NEXT
102.  
103.         COLOR 4
104.         IF TargetFound = 0 THEN LOCATE 5, 5: PRINT "TARGET CANNOT BE REACHED": _DISPLAY: _DELAY 2: EXIT DO
105.  
106.         i = i + 1
107.         CALL DrawBlock(Path(i).x, Path(i).y, 10)
108.         CALL DrawBlock(Target.x, Target.y, 4)
109.  
110.         IF Path(i).x = Target.x AND Path(i).y = Target.y THEN EXIT DO
111.         IF i = MaxPathLength THEN EXIT DO
112.         IF INKEY$ = CHR$(27) THEN END
113.         _DISPLAY
114.     LOOP
115.     i = 0
116.     ERASE Path
117.     ERASE SampleMap
118.     TargetFound = 0
119.     IF INKEY$ = CHR$(27) THEN END
120. LOOP
121.  
122. SUB SetPath (Path() AS Coord, StartPos AS Coord, TargetPos AS Coord, Map())
123.  
124. MaxPathLength = UBOUND(path)
125. Mapx = UBOUND(Map, 1)
126. Mapy = UBOUND(Map, 2)
127.  
128. DIM PathMap(Mapx, Mapy) AS PathCoord
129.  
130. FOR ix = 0 TO Mapx
131.     FOR iy = 0 TO Mapy
132.         PathMap(ix, iy).pos.x = ix
133.         PathMap(ix, iy).pos.y = iy
134.     NEXT
135. NEXT
136.  
137. DIM Cpos AS Coord: Cpos = StartPos
138. DIM SearchPathSet(4) AS PathCoord, OpenPathSet(MaxPathLength) AS PathCoord
139.  
140. DO
141.  
142.     PathMap(Cpos.x, Cpos.y).status = 2
143.     count = count + 1
144.  
145.     IF PathMap(TargetPos.x, TargetPos.y).status = 2 THEN TargetFound = 1: EXIT DO
146.     IF count > MaxPathLength THEN EXIT DO
147.  
148.     SearchPathSet(0) = PathMap(Cpos.x, Cpos.y)
149.     SearchPathSet(1) = PathMap(Cpos.x + 1, Cpos.y)
150.     SearchPathSet(2) = PathMap(Cpos.x - 1, Cpos.y)
151.     SearchPathSet(3) = PathMap(Cpos.x, Cpos.y + 1)
152.     SearchPathSet(4) = PathMap(Cpos.x, Cpos.y - 1)
153.  
154.     FOR i = 1 TO 4
155.         IF Collision(SearchPathSet(i).pos, Map()) <> 1 THEN
156.  
157.             IF SearchPathSet(i).status = 1 THEN
158.                 NewG = PathGCost(SearchPathSet(0).g)
159.                 IF NewG < SearchPathSet(i).g THEN SearchPathSet(i).g = NewG
160.             END IF
161.  
162.             IF SearchPathSet(i).status = 0 THEN
163.                 SearchPathSet(i).parent = SearchPathSet(0).pos
164.                 SearchPathSet(i).status = 1
165.                 SearchPathSet(i).g = PathGCost(SearchPathSet(0).g)
166.                 SearchPathSet(i).h = PathHCost(SearchPathSet(i), TargetPos)
167.                 SearchPathSet(i).f = SearchPathSet(i).g + SearchPathSet(i).h
168.  
169.                 OpenPathSet(OpenPathCount) = SearchPathSet(i)
170.                 OpenPathCount = OpenPathCount + 1
171.             END IF
172.         END IF
173.     NEXT
174.  
175.     PathMap(Cpos.x + 1, Cpos.y) = SearchPathSet(1)
176.     PathMap(Cpos.x - 1, Cpos.y) = SearchPathSet(2)
177.     PathMap(Cpos.x, Cpos.y + 1) = SearchPathSet(3)
178.     PathMap(Cpos.x, Cpos.y - 1) = SearchPathSet(4)
179.  
180.     IF OpenPathCount > (MaxPathLength - 4) THEN EXIT DO
181.  
182.     LowF = 32000: ixOptimal = 0: iyOptimal = 0
183.     FOR i = 0 TO OpenPathCount
184.         IF OpenPathSet(i).status = 1 AND OpenPathSet(i).f <> 0 THEN
185.             IF OpenPathSet(i).f < LowF THEN
186.                 LowF = OpenPathSet(i).f
187.                 ixOptimal = OpenPathSet(i).pos.x
188.                 iyOptimal = OpenPathSet(i).pos.y
189.                 OptimalPath_i = i
190.             END IF
191.         END IF
192.     NEXT
193.  
194.     IF ixOptimal = 0 AND iyOptimal = 0 THEN EXIT DO
195.     Cpos = PathMap(ixOptimal, iyOptimal).pos
196.     OpenPathSet(OptimalPath_i).status = 2
197.  
198.     IF DEBUG <> 0 THEN
199.         CLS
200.         FOR ix = 0 TO Mapx
201.             FOR iy = 0 TO Mapy
202.                 IF Map(ix, iy) = 1 THEN CALL DrawBlock(ix, iy, 15)
203.             NEXT
204.         NEXT
205.         CALL DrawBlock(TargetPos.x, TargetPos.y, 4)
206.         FOR ix = 0 TO Mapx
207.             FOR iy = 0 TO Mapy
208.                 IF PathMap(ix, iy).status = 1 THEN CALL DrawBlock(ix, iy, 3)
209.                 IF PathMap(ix, iy).status = 2 THEN CALL DrawBlock(ix, iy, 10)
210.             NEXT
211.         NEXT
212.         _DISPLAY
213.         IF INKEY$ = CHR$(27) THEN END
214.         IF DEBUG > 0 THEN _DELAY (.2 * (1 / DEBUG))
215.         IF DEBUG = -1 THEN SLEEP
216.     END IF
217. LOOP
218.  
219. IF TargetFound = 1 THEN
220.  
221.     DIM backpath(MaxPathLength) AS PathCoord
222.     backpath(0).pos = PathMap(TargetPos.x, TargetPos.y).pos
223.  
224.     FOR i = 1 TO count
225.         backpath(i).pos = PathMap(backpath(i - 1).pos.x, backpath(i - 1).pos.y).parent
226.         IF (startreached = 0) AND (backpath(i).pos.x = Start.Pos.x) AND (backpath(i).pos.y = Start.Pos.y) THEN
227.             pathlength = i: startreached = 1
228.         END IF
229.     NEXT
230.  
231.     i = 0: startreached = 0
232.     FOR iback = pathlength TO 0 STEP -1
233.         IF startreached = 1 THEN i = i + 1: Path(i) = backpath(iback).pos
234.         IF (startreached = 0) AND (backpath(iback).pos.x = Start.Pos.x) AND (backpath(iback).pos.y = Start.Pos.y) THEN
235.             Path(i) = backpath(iback).pos
236.             startreached = 1
237.         END IF
238.     NEXT iback
239. END IF
240.  
241. END SUB
242.  
243. FUNCTION PathGCost (ParentG)
244. PathGCost = ParentG + 10
245. END SUB
246.  
247. FUNCTION PathHCost (TilePath AS PathCoord, TargetPos AS Coord)
248. dx = ABS(TilePath.pos.x - TargetPos.x)
249. dy = ABS(TilePath.pos.y - TargetPos.y)
250. distance = SQR((TargetPos.x - TilePath.pos.x) ^ 2 + (TargetPos.y - TilePath.pos.y) ^ 2)
251. IF RandomSearch = 1 THEN SearchIntensity = INT(RND * 10)
252. PathHCost = ((SearchIntensity / 20) + 10) * (dx + dy + ((SearchIntensity / 10) * distance))
253. END FUNCTION
254.  
255. FUNCTION Collision (Position AS Coord, Map())
256. IF Map(Position.x, Position.y) <> 0 THEN c = 1
257. Collision = c
258. END FUNCTION
259.  
260. SUB DrawBlock (x, y, blockcolor)
261. x0 = ((x * TileSize) - (TileSize / 2)) + TileSize + 20
262. y0 = ((y * TileSize) - (TileSize / 2)) + TileSize
263. x1 = ((x * TileSize) + (TileSize / 2)) + TileSize + 20
264. y1 = ((y * TileSize) + (TileSize / 2)) + TileSize
265. LINE (x0, y0)-(x1, y1), blockcolor, BF
266. END SUB

[bplus]

That is pretty cool!

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

[Petr]

So that's something! Thank you for sharing, I have what to study.