Should be fairly straightforward to implement. If you need help just shoot JosephE a pm on the just basic forums.
If you have improvements just post below.
Thanks to tsh73, cassiope01 (especially), and DaveG for their help!
EDIT: Updated code a tad to clean up and avoid possible bugs. Replaced the display function with the one Stefan posted below. Thanks Stefan!
EDIT:
Thanks to cassiope01 again, it seems to now find the shortest path! (with a major delay in speed, however)
Oh, and thanks stefan for the tip! It now uses spaces instead of Ascii 0.
EDIT:
We were close, but it wasn't quite finding the shortest path. So cassiope and I have updated it to this! Thanks cassiope! And it also is faster on my computer by about half a second.
http://justbasic.conforums.com/index.cg ... 1274378779
Code: Select all
' Required for pathfinding library:
Dim Con(0,0)
Dim Path(0,0)
Dim Path.Open.X(0) ' Open List
Dim Path.Open.Y(0)
Dim Path.Open.ParentX(0)
Dim Path.Open.ParentY(0)
Dim Path.Open.Cost(0)
Dim Path.Open.PCost(0)
Dim Path.Closed.X(0) ' Closed list
Dim Path.Closed.Y(0)
Dim Path.Closed.ParentX(0)
Dim Path.Closed.ParentY(0)
Global Path.Width, Path.Height
Global Path.StartX, Path.StartY
Global Path.EndX, Path.EndY
Global Path.Closed, Path.Open ' The number of items in
' the open and closed list
' -------------------------------------------------------------------------------------------- '
worldWidth = 26
worldHeight = 16
' Let's make our own world.
' Each row 26 characters long and there are 16 rows:
world$ = _
" ";_ ' 1
" ";_ ' 2
" ";_ ' 3
" +++++++ ";_ ' 4
" + + ";_ ' 5
" + + ";_ ' 6
" + + a+ + + ";_ ' 7
" ++++++++++ + + ";_ ' 8
" + + + ";_ ' 9
" +++++++++ +++++ ";_ ' 10
" + ";_ ' 11
" +++++ ";_ ' 12
" + ++++++ ";_ ' 13
" ++ ";_ ' 14
" + + b ";_ ' 15
" + +++ " ' 16
Call Path.Load world$, worldWidth, worldHeight
start = Time$("ms")
test = Path.Find(s$)
print "time: "; (time$("ms") - start)
Print "result: ";test
Call Path.Print
Print "answer: ";s$
End
Function Path.Find(BYREF answer$)
' Returns 0 (false) if a path was not found.
' Otherwise the answer is the number of coordinates in answer$
' To get to the location.
' The coordinates placed in answer$ are like this:
' XX_YY XX_YY ... and so on.
' So you could get them by:
' cord1$ = Word$(answer$,1)
' cord1x = Val(Word$(cord1$,1,"_"))
' cord1y = Val(Word$(cord1$,2,"_"))
Dim Dir.X(4)
Dim Dir.Y(4)
Dir.X(1) = 0 : Dir.Y(1) = -1 ' Up
Dir.X(2) = 1 : Dir.Y(2) = 0 ' Right
Dir.X(3) = -1 : Dir.Y(3) = 0 ' Left
Dir.X(4) = 0 : Dir.Y(4) = 1 ' Down
' Start at the start location.
x = Path.StartX : y = Path.StartY
ppp = 0
' Put the starting location on the closed list:
Call Path.ClosedPush Path.StartX, Path.StartY,0,0
Do
For i = 1 To 4
' Check all the directions:
nextX = x + Dir.X(i)
nextY = y + Dir.Y(i)
If Path(nextX,nextY) = 32 Then ' Square is open...so...
' Calculate the cost of the neighboring square:
cost = ppp + Abs(Path.EndX - nextX) + Abs(Path.EndY - nextY)
If nextX = Path.EndX And nextY = Path.EndY Then
' Arrived at destination
success = 1
GoTo [GetOut]
Else
' Haven't arrived at our destination:
If Not(Path.IsClosed(nextX, nextY)) Then
' Current square isn't on the closed list
isOpen = Path.IsOpen(nextX,nextY) ' If the box is in the open list, this is the array index to the box's values.
If Not(isOpen) Then
' Path isn't on the open list, so we push it in there
Call Path.OpenPush nextX,nextY,x,y,cost,ppp
' (x,y) is the parent location for the new open list item: (nextX,nextY)
Else
' Path is on the open list, so we compare costs.
If cost < Path.Open.Cost(isOpen) Then
' Current cost is below the cost of that box in the open list.
' So we update the parent and the cost?
Path.Open.ParentX(isOpen) = x
Path.Open.ParentY(isOpen) = y
Path.Open.PCost(isOpen) = ppp
Path.Open.Cost(isOpen) = cost
End If
End If
End If
End If
End If
Next i
Select Case Path.Open ' The number of cells in the open list...
Case 0
' Nothing left...
GoTo [GetOut]
Case 1
' The only one left? Then of course we'll take it!
selectedBox = 1
Case Else
' Locate the box that has the lowest value in the open list.
' Last box put on the list to reference against:
lastCost = Path.Open.Cost(Path.Open)
selectedBox = Path.Open
' ----------------------------------------------- '
For n = Path.Open To 1 Step -1 ' Look for it going backwards...
referenceCost = Path.Open.Cost(n)
If referenceCost < lastCost Then
lastCost = referenceCost
selectedBox = n ' Location of the box with the smallest cost.
End If
Next n
End Select
' Now let's take the box with the smallest cost and put it in the closed list.
' Becomes the new cell...and the new parent of other cells.
oldX = x : oldY = y
x = Path.Open.X(selectedBox)
y = Path.Open.Y(selectedBox)
ppp = Path.Open.PCost(selectedBox) + 1
Call Path.ClosedPush x,y,Path.Open.ParentX(selectedBox),Path.Open.ParentY(selectedBox) ' Add it to the closed list
Call Path.OpenRemove selectedBox ' Remove it from the open list
Loop Until success
[GetOut]
If success Then
' Figure out the path...
i = Path.IsClosed(x,y)
While i
x = Path.Closed.ParentX(i) : y = Path.Closed.ParentY(i) : c = Path.Open.PCost(i)
If x <> 0 And y <> 0 Then
answer$ = Trim$(x;"_";y;" ";answer$)
Con(x,y) = Asc("P") ' Show what's going on for debugging purposes. P = Path
Path.Find = Path.Find + 1
End If
i = Path.IsClosed(x,y)
WEnd
End If
End Function
Sub Path.ClosedPush x,y,parentX,parentY
' Push the square (x,y) onto the closed list.
Path.Closed = Path.Closed + 1
Path.Closed.X(Path.Closed) = x
Path.Closed.Y(Path.Closed) = y
Path.Closed.ParentX(Path.Closed) = parentX
Path.Closed.ParentY(Path.Closed) = parentY
End Sub
Sub Path.OpenPush x,y,parentX,parentY,cost,ppp
' Pushes the square (x,y) with the (parentX,parentY) and (cost)
' onto the open list.
Path.Open = Path.Open + 1
Path.Open.X(Path.Open) = x
Path.Open.Y(Path.Open) = y
Path.Open.Cost(Path.Open) = cost
Path.Open.ParentX(Path.Open) = parentX
Path.Open.ParentY(Path.Open) = parentY
Path.Open.PCost(Path.Open) = ppp
End Sub
Sub Path.OpenRemove index
' Removes the item with the index 'index' from the open list.
If index = 0 Then Exit Sub
For i = index+1 To Path.Open
b = i - 1
Path.Open.X(b) = Path.Open.X(i)
Path.Open.Y(b) = Path.Open.Y(i)
Path.Open.ParentX(b) = Path.Open.ParentX(i)
Path.Open.ParentY(b) = Path.Open.ParentY(i)
Path.Open.Cost(b) = Path.Open.Cost(i)
Path.Open.PCost(b) = Path.Open.PCost(i)
Next i
o = Path.Open
Path.Open.X(o) = 0 : Path.Open.Y(o) = 0 : Path.Open.ParentX(o) = 0
Path.Open.ParentY(o) = 0 : Path.Open.Cost(o) = 0 : Path.Open.PCost(o) = 0
Path.Open = Path.Open - 1
End Sub
Function Path.IsClosed(x,y)
' Returns a number greater than 0 if the box (x,y) is on the closed list.
' This number is the array index of the item on the closed list.
For i = 1 To Path.Closed
If Path.Closed.X(i) = x And Path.Closed.Y(i) = y Then
Path.IsClosed = i
Exit Function
End If
Next i
End Function
Function Path.IsOpen(x,y)
' Returns a number greater than 0 if the box (x,y) is on the open list.
' This number is the array index of the item on the open list.
For i = 1 To Path.Open
If Path.Open.X(i) = x And Path.Open.Y(i) = y Then
Path.IsOpen = i
Exit Function
End If
Next i
End Function
Sub Path.Load string$, width, height
' Takes a string of characters representing a world
' map and loads them into the array for pathfinding.
' It considers the edges as walls.
' " " (space) is considered an empty space
' "+" is considered a wall
' "a" is considered the starting point.
' "b" is considered the ending point.
ReDim Con(width,height)
ReDim Path(width,height)
ReDim Path.Open.X(width*height)
ReDim Path.Open.Y(width*height)
ReDim Path.Open.ParentX(width*height)
ReDim Path.Open.ParentY(width*height)
ReDim Path.Open.Cost(width*height)
ReDim Path.Open.PCost(width*height)
ReDim Path.Closed.X(width*height)
ReDim Path.Closed.Y(width*height)
ReDim Path.Closed.ParentX(width*height)
ReDim Path.Closed.ParentY(width*height)
Path.StartX = 0 : Path.StartY = 0
Path.EndX = 0 : Path.EndY = 0
y = 1
For i = 1 To width * height
x = x + 1
char = Asc(Mid$(string$,i,1))
If x = 1 Or x = width Then char = 43 ' Borders ... 43 = wall
If y = 1 Or y = height Then char = 43
If char = 97 Then
' Start location (97 = asc("a"))
' Set the global variables:
Path.StartX = x
Path.StartY = y
End If
If char = 98 Then
' End location (98 = asc("b"))
' Set the global variables:
Path.EndX = x
Path.EndY = y
char = 32 ' Make it a blank space...
End If
Path(x,y) = char
Con(x,y) = char
If x = width Then
' Start the row over:
x = 0
y = y + 1
End If
Next i
' Set the global path width and height:
Path.Width = width : Path.Height = height
End Sub
Sub Path.Print
' Display the loaded world map
Con(Path.StartX,Path.StartY) = asc("S")
Con(Path.EndX,Path.EndY) = asc("E")
For y = 1 To Path.Height
line$ = ""
For x = 1 To Path.Width
line$ = line$;Chr$(Con(x,y))
Next x
print line$
Next y
End Sub
