_TITLE "PathFinder 1a, press spacebar to continue whenever it stops, press esc to quit" 'QB64 X 64 version 1.2 20180228/86 from git b301f92
'started 2018-08-11 when Colbalt asked about A* pathfinder
' He has now 2018-08-12 posted a QB64 version that is nice!
' 2018-08-11 started PathFinder 1
' 2018-08-12 almost working but buggy backtract to point A after point B is found.
' 2018-08-13 PathFinder 1a.bas I think I have a fix for buggy path BackTrack but major surgery so this new version
' 8:38 PM 28 times in a row it worked, now diddle the size of array and loose the board text view
' 9:09 PM I have run 2 dozen tests more at least and zero bugs! on smaller and more squares.
' 9:25 PM Still no failures! Ready to show the world.
board(x, y) = " "
'with these obstacles there is no guarantee a path will exist
FOR i
= 1 TO maxx
* maxy
* .8 ox = rand(1, maxx): oy = rand(1, maxy)
ox = rand(1, maxx): oy = rand(1, maxy)
board(ox, oy) = "O"
ax = rand(1, maxx): ay = rand(1, maxy)
bx = rand(1, maxx): by = rand(1, maxy)
bx = rand(1, maxx): by = rand(1, maxy)
board(ax, ay) = "A"
board(bx, by) = "B"
displayB
parentF = 1: tick = 0: parentx = 0
parentF = 0: tick = tick + 1: changes$ = ""
'IF tick > maxx * maxy THEN EXIT WHILE 'this was crude infinite loop stopper
ystart = max(ay - tick, 1): ystop = min(ay + tick, maxy)
xstart = max(ax - tick, 1): xstop = min(ax + tick, maxx)
'PRINT ystart, ystop, xstart, xstop
'END
'check out the neighbors
IF x
- 1 >= 1 THEN xxstart
= x
- 1 ELSE xxstart
= x
IF x
+ 1 <= maxx
THEN xxstop
= x
+ 1 ELSE xxstop
= x
IF y
- 1 >= 1 THEN yystart
= y
- 1 ELSE yystart
= y
IF y
+ 1 <= maxy
THEN yystop
= y
+ 1 ELSE yystop
= y
cf = 0
FOR yy
= yystart
TO yystop
FOR xx
= xxstart
TO xxstop
' This had ne stuck for awhile!
'LOGIC BUG board(x, y) = LTRIM$(STR$(xx)) + "," + LTRIM$(STR$(yy))
'can't change board until all are checked!!!! so save up changes
rec (x - 1) * sq + 3, (y - 1) * sq + 3, x * sq - 3, y * sq - 3, 555
parentF = 1 'so will continue looping
FOR yy
= yystart
TO yystop
FOR xx
= xxstart
TO xxstop
parentx = x: parenty = y 'from this we should be able to backtrack to A
jump1:
'update board with cells assigned parents
new$ = leftOf$(changes$, "}")
changes$ = rightOf$(changes$, "}")
newxy$ = leftOf$(new$, "{")
newParent$ = rightOf$(new$, "{")
u
= VAL(leftOf$
(newxy$
, ",")): v
= VAL(rightOf$
(newxy$
, ",")) board(u, v) = leftOf$(newParent$, ",") + "," + rightOf$(newParent$, ",")
'_DISPLAY
'displayB
'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
BackTrack$ = ""
IF parentx
THEN 'backtrack to A note: B could be right next to A!!! 'IF parentx <> ax AND parenty <> ay THEN
frec (parentx - 1) * sq + 3, (parenty - 1) * sq + 3, sq - 6, sq - 6, 990
'END IF
'this had me stuck for the longest time! parentx was the fix! (along with removal of blunders)
WHILE parentx
'trace the path back ps$ = board(parentx, parenty)
parentx
= VAL(leftOf$
(ps$
, ",")) parenty
= VAL(rightOf$
(ps$
, ","))
'IF parentx <> ax AND parenty <> ay THEN
frec (parentx - 1) * sq + 3, (parenty - 1) * sq + 3, sq - 6, sq - 6, 990
'END IF
'IF parentx <> ax AND parenty <> ay THEN EXIT WHILE
'_DISPLAY
rgb 999
'for this to be of any use, I need to format the print to exact same size, well thats easy
'
' this is why board is string * 6 type
' maxx = 16 maxy = 12 or less
'rgb 999
'CLS
'FOR y = 1 TO maxy
' FOR x = 1 TO maxx
' PRINT board(x, y);
' NEXT
' PRINT: PRINT
'NEXT
'WHILE NOT _KEYDOWN(32)
' IF _KEYDOWN(27) THEN END
' _LIMIT 100
'WEND
'WHILE _KEYDOWN(32): _LIMIT 100: WEND
'CASE ELSE: k = 30
frec (x - 1) * sq, (y - 1) * sq, sq, sq, k
SUB rec
(x1
, y1
, x2
, y2
, rgbN
) rgb rgbN
LINE (x1
, y1
)-(x2
, y2
), , B
SUB frec
(x1
, y1
, w
, h
, rgbN
) rgb rgbN
SUB rgb
(n
) ' New (even less typing!) New Color System 1000 colors with up to 3 digits rand%
= INT(RND * (hi%
- lo%
+ 1)) + lo%
posOf
= INSTR(source$
, of$
) IF posOf
> 0 THEN leftOf$
= MID$(source$
, 1, posOf
- 1) posOf
= INSTR(source$
, of$
)