Mirage Source
Pathfindah - Printable Version

+- Mirage Source (https://mirage-engine.uk/forums)
+-- Forum: Mirage Source (Nostalgia) (https://mirage-engine.uk/forums/forumdisplay.php?fid=61)
+--- Forum: Archive (2006-2011) (https://mirage-engine.uk/forums/forumdisplay.php?fid=18)
+---- Forum: Source Code Development (https://mirage-engine.uk/forums/forumdisplay.php?fid=51)
+----- Forum: Mirage Source 4 (Visual Basic 6) (https://mirage-engine.uk/forums/forumdisplay.php?fid=44)
+------ Forum: Tutorials (https://mirage-engine.uk/forums/forumdisplay.php?fid=13)
+------ Thread: Pathfindah (/showthread.php?tid=2434)

Pathfindah - Joost - 15-12-2008

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.

Re: Pathfindah - William - 15-01-2009

Looks interesting, from what source was it ripped?

Re: Pathfindah - Dragoons Master - 15-01-2009

Use my AI to make the same thing.
I use it in my game to make mouse moving.
viewtopic.php?f=75&t=2305

Re: Pathfindah - William - 15-01-2009

I havn't really gotten indeapth on either of them cause I never planned on having things controlled by the mouse. But now I do.

Re: Pathfindah - Doomy - 15-01-2009

i looked through it
and it seems likes its one of those codes that
its click to move
but it moves around blocks and stuff and i right?

Re: Pathfindah - William - 15-01-2009

doomteam1 Wrote:i looked through it
and it seems likes its one of those codes that
its click to move
but it moves around blocks and stuff and i right?
Not the code joost posted, you cant use it without editing.

Re: Pathfindah - Doomy - 15-01-2009

im guessing because of stuff like this
Quote:move player up plz


Re: Pathfindah - William - 15-01-2009

doomteam1 Wrote:im guessing because of stuff like this
Quote:move player up plz
There is no Movable function too.