Code:
Public Function FindPath(sX, sY, eX, eY) As String
Dim LastPathReally As String 'the final path, really, I swear ;)
For a = 1 To 7 'Find many routs, then get the shortest
ReDim AIBoard(1 To BR, 1 To HG) 'Clear out the AiBoard
FinalPath = "" 'empty the path string
OnRoute sX, sY, eX, eY, "" 'Start genetrating a route
If LastPathReally = "" Then LastPathReally = FinalPath 'if this is the first path store it
If Len(FinalPath) > 0 And Len(FinalPath) < Len(LastPathReally) Then LastPathReally = FinalPath 'if the aquierd path is shorter than the current, store it
FinalPath = "" 'empty once more to not leave anything
Next a
FindPath = LastPathReally 'apply the found path
LastPathReally = ""
End Function
Public Function OnRoute(X, Y, gX, gY, PathSoFar) As String
Dim Checked(1 To 4) As Boolean
NewDire:
If FinalPath <> "" Then Exit Function
If Checked(1) And Checked(2) And Checked(3) And Checked(4) Then
OnRoute = PathSoFar
Exit Function
End If
a = Int(Rnd * 4) + 1
If Checked(a) Then GoTo NewDire:
'a = 1
Select Case a
Case 1
Checked(a) = True
If Movable(X - 1, Y) Then
PathSoFar = PathSoFar & "l"
If X - 1 = gX And Y = gY Then GoTo FoundRoute
AIBoard(X, Y) = True
OnRoute = OnRoute(X - 1, Y, gX, gY, PathSoFar)
If OnRoute = PathSoFar Then 'No way found
OnRoute = Left(OnRoute, Len(OnRoute) - 1)
PathSoFar = OnRoute
GoTo NewDire
End If
Else: GoTo NewDire
End If
Case 2
Checked(a) = True
If Movable(X, Y + 1) Then
PathSoFar = PathSoFar & "d"
If X = gX And Y + 1 = gY Then GoTo FoundRoute
AIBoard(X, Y) = True
OnRoute = OnRoute(X, Y + 1, gX, gY, PathSoFar)
If OnRoute = PathSoFar Then 'No way found
OnRoute = Left(OnRoute, Len(OnRoute) - 1)
PathSoFar = OnRoute
GoTo NewDire
End If
Else: GoTo NewDire
End If
Case 3
Checked(a) = True
If Movable(X + 1, Y) Then
PathSoFar = PathSoFar & "r"
If X + 1 = gX And Y = gY Then GoTo FoundRoute
AIBoard(X, Y) = True
OnRoute = OnRoute(X + 1, Y, gX, gY, PathSoFar)
If OnRoute = PathSoFar Then 'No way found
OnRoute = Left(OnRoute, Len(OnRoute) - 1)
PathSoFar = OnRoute
GoTo NewDire
End If
Else: GoTo NewDire
End If
Case 4
Checked(a) = True
If Movable(X, Y - 1) Then
PathSoFar = PathSoFar & "u"
If X = gX And Y - 1 = gY Then GoTo FoundRoute
AIBoard(X, Y) = True
OnRoute = OnRoute(X, Y - 1, gX, gY, PathSoFar)
If OnRoute = PathSoFar Then 'No way found
OnRoute = Left(OnRoute, Len(OnRoute) - 1)
PathSoFar = OnRoute
GoTo NewDire
End If
Else: GoTo NewDire
End If
End Select
Stop 'it should NEVER get here
Exit Function
FoundRoute:
OnRoute = PathSoFar
FinalPath = PathSoFar
End Function
'THIS I HAVE TO CHANGE
Function Movable(X, Y) As Boolean
'Check if player can move, return false if no, true if yes
End Function
To set path : Player(Index).Char(charnum).Path = FindPath(currentX, currentY, targetX, targetY)
To move player
Code:
Public Sub MovePlayer() 'check if we can move to this square
If Player(Index).Char(charnum).Path <> "" Then
Select Case Mid(Player(Index).Char(charnum).Path, 1, 1)
Case "l": P1.X = move player left plz
Case "d": P1.Y = move player down plz
Case "r": P1.X = move player right plz
Case "u": P1.Y = move player up plz
End Select
Player(Index).Char(charnum).Path = Right(Player(Index).Char(charnum).Path , Len(Player(Index).Char(charnum).Path ) - 1)
End If
End Sub
All of this is ripped of course. But it should be rather fast + use little memory. Untested of course. Fuck yeah.
and
Dim FinalPath As String
Public AIBoard() As Boolean
of course. Also dim Player().Path in the correct Rec somewhere.