Mirage Source

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

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