Pathfindah

[Joost]

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.