QB64 Phoenix Edition
A path finding algorithm - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: A path finding algorithm (/showthread.php?tid=2972)



A path finding algorithm - aadityap0901 - 08-22-2024

A path finding algorithm:
optimized for making a path when the map updates, and entities can find their path by going to its neighbor tile with the lowest value.
Code: (Select All)
DefInt A-Z
Screen _NewImage(640, 640, 32)
Dim Shared As _Unsigned Integer Grid(1 To 40, 1 To 40), Grid2(1 To 40, 1 To 40)
Dim As _Unsigned Integer StartPoint_X, StartPoint_Y, EndPoint_X, EndPoint_Y
Dim As Integer X, Y, L
StartPoint_X = 10
StartPoint_Y = 10
EndPoint_X = 25
EndPoint_Y = 20
Dim Shared Queue$
DISPLAY = -1
Do
    _Limit 60
    While _MouseInput: Wend
    If _KeyDown(49) Then
        StartPoint_X = _MouseX \ 16 + 1
        StartPoint_Y = _MouseY \ 16 + 1
        DISPLAY = -1
    End If
    If _KeyDown(50) Then
        EndPoint_X = _MouseX \ 16 + 1
        EndPoint_Y = _MouseY \ 16 + 1
        DISPLAY = -1
    End If
    If _MouseButton(1) Then
        Grid(_MouseX \ 16 + 1, _MouseY \ 16 + 1) = 0
        DISPLAY = -1
    End If
    If _MouseButton(2) Then
        Grid(_MouseX \ 16 + 1, _MouseY \ 16 + 1) = 65535
        DISPLAY = -1
    End If
    If DISPLAY = 0 Then _Continue
    Cls
    For I = LBound(Grid2, 1) To UBound(Grid2, 1): For J = LBound(Grid2, 2) To UBound(Grid, 2)
            Grid2(I, J) = Grid(I, J)
    Next J, I
    Queue$ = ListNew$
    QueueAdd EndPoint_X, EndPoint_Y
    Do
        If ListLength(Queue$) = 0 Then Exit Do
        QueueRemove X, Y
        If X < UBound(Grid2, 1) Then If Grid2(X + 1, Y) = 0 Then QueueAdd X + 1, Y: Grid2(X + 1, Y) = Grid2(X, Y) + 1
        If X > LBound(Grid2, 1) Then If Grid2(X - 1, Y) = 0 Then QueueAdd X - 1, Y: Grid2(X - 1, Y) = Grid2(X, Y) + 1
        If Y < UBound(Grid2, 2) Then If Grid2(X, Y + 1) = 0 Then QueueAdd X, Y + 1: Grid2(X, Y + 1) = Grid2(X, Y) + 1
        If Y > LBound(Grid2, 2) Then If Grid2(X, Y - 1) = 0 Then QueueAdd X, Y - 1: Grid2(X, Y - 1) = Grid2(X, Y) + 1
    Loop
    For X = LBound(Grid2, 1) To UBound(Grid2, 1): For Y = LBound(Grid2, 2) To UBound(Grid2, 2)
            If Grid2(X, Y) = 65535 Then Line (X * 16 - 16, Y * 16 - 16)-(X * 16, Y * 16), _RGB32(255), BF
    Next Y, X
    CPX = StartPoint_X
    CPY = StartPoint_Y
    Do
        Line (CPX * 16 - 16, CPY * 16 - 16)-(CPX * 16, CPY * 16), _RGB32(191, 191, 0), BF
        If CPX < UBound(Grid2, 1) Then If Grid2(CPX + 1, CPY) < Grid2(CPX, CPY) Then CPX = CPX + 1: _Continue
        If CPX > LBound(Grid2, 1) Then If Grid2(CPX - 1, CPY) < Grid2(CPX, CPY) Then CPX = CPX - 1: _Continue
        If CPY < UBound(Grid2, 2) Then If Grid2(CPX, CPY + 1) < Grid2(CPX, CPY) Then CPY = CPY + 1: _Continue
        If CPY > LBound(Grid2, 2) Then If Grid2(CPX, CPY - 1) < Grid2(CPX, CPY) Then CPY = CPY - 1: _Continue
        Exit Do
        If CPX = EndPoint_X And CPY = EndPoint_Y Then Exit Do
    Loop
    Line (StartPoint_X * 16 - 16, StartPoint_Y * 16 - 16)-(StartPoint_X * 16, StartPoint_Y * 16), _RGB32(0, 255, 0), BF
    Line (EndPoint_X * 16 - 16, EndPoint_Y * 16 - 16)-(EndPoint_X * 16, EndPoint_Y * 16), _RGB32(255, 0, 0), BF
    _Display
    DISPLAY = 0
Loop Until Inp(&H60) = 1
System
Sub QueueAdd (X As Integer, Y As Integer)
    Queue$ = ListAdd$(Queue$, MKI$(X) + MKI$(Y))
End Sub
Sub QueueRemove (X As Integer, Y As Integer)
    T$ = ListGet$(Queue$, 1)
    X = CVI(Left$(T$, 2))
    Y = CVI(Right$(T$, 2))
    Queue$ = ListDelete$(Queue$, 1)
End Sub
Function ListNew$
    ListNew$ = MKL$(0)
End Function
Function ListLength~& (__List As String)
    ListLength~& = CVL(Mid$(__List, 1, 4))
End Function
Function ListAdd$ (__List As String, __Item As String)
    ListAdd$ = MKL$(CVL(Mid$(__List, 1, 4)) + 1) + Mid$(__List, 5) + MKI$(Len(__Item)) + __Item
End Function
Function ListInsert$ (__List As String, __ItemNumber As _Unsigned Long, __Item As String)
    Dim As _Unsigned Long __nItems, __I, __OFFSET
    Dim As _Unsigned Integer __LEN
    __nItems = CVL(Mid$(__List, 1, 4))
    __OFFSET = 5
    If __ItemNumber > __nItems Then
        If __ItemNumber = __nItems + 1 Then ListInsert$ = ListAdd$(__List, __Item) Else Exit Function
    End If
    For __I = 1 To __ItemNumber - 1
        __LEN = CVI(Mid$(__List, __OFFSET, 2))
        Print Mid$(__List, __OFFSET + 2, __LEN)
        __OFFSET = __OFFSET + __LEN + 2
    Next __I
    ListInsert$ = MKL$(CVL(Mid$(__List, 1, 4)) + 1) + Mid$(__List, 5, __OFFSET - 5) + MKI$(Len(__Item)) + __Item + Mid$(__List, __OFFSET)
End Function
Sub ListPrint (__List As String)
    Dim As _Unsigned Long __nItems, __I, __OFFSET
    Dim As _Unsigned Integer __LEN
    __nItems = CVL(Mid$(__List, 1, 4))
    __OFFSET = 5
    Print "[";
    For __I = 1 To __nItems
        __LEN = CVI(Mid$(__List, __OFFSET, 2))
        Print Mid$(__List, __OFFSET + 2, __LEN);
        If __I < __nItems Then Print ",";
        __OFFSET = __OFFSET + __LEN + 2
    Next __I
    Print "]"
End Sub
Function ListGet$ (__List As String, __ItemNumber As _Unsigned Long)
    Dim As _Unsigned Long __nItems, __I, __OFFSET
    Dim As _Unsigned Integer __LEN
    __nItems = CVL(Mid$(__List, 1, 4))
    If __ItemNumber > __nItems Then Exit Function
    __OFFSET = 5
    For __I = 1 To __nItems
        __LEN = CVI(Mid$(__List, __OFFSET, 2))
        If __I = __ItemNumber Then ListGet$ = Mid$(__List, __OFFSET + 2, __LEN): Exit Function
        __OFFSET = __OFFSET + __LEN + 2
    Next __I
End Function
Function ListDelete$ (__List As String, __ItemNumber As _Unsigned Long)
    Dim As _Unsigned Long __nItems, __I, __OFFSET
    Dim As _Unsigned Integer __LEN
    __nItems = CVL(Mid$(__List, 1, 4))
    __OFFSET = 5
    For __I = 1 To __nItems
        __LEN = CVI(Mid$(__List, __OFFSET, 2))
        If __I = __ItemNumber Then
            ListDelete$ = MKL$(__nItems - 1) + Mid$(__List, 5, __OFFSET - 5) + Mid$(__List, __OFFSET + __LEN + 2)
            Exit Function
        End If
        __OFFSET = __OFFSET + __LEN + 2
    Next __I
End Function



RE: A path finding algorithm - SierraKen - 08-22-2024

That's pretty cool! It can be used with mazes. For years I've been trying to make a random maze making program. I've made many similar ones, but nothing perfect yet. It has to do with remembering where X and Y goes as it makes it, and going backwards when you come to a dead end and making a new hallway. The hard part is trying to use up every single space and only making one abled path to go and also not making it impossible. lol


RE: A path finding algorithm - aadityap0901 - 08-23-2024

Check out this new game clone (Xeno Tactic) I made with this algorithm:

.zip   XenoTactic_v1.zip (Size: 41.36 KB / Downloads: 82)

All controls are mouse based
It's a bit buggy...


RE: A path finding algorithm - bplus - 08-23-2024

Quote:Instructions might help folks that have no idea what this is supposed to do.



RE: A path finding algorithm - aadityap0901 - 08-24-2024

Oh yes, instructions:
The goal is to kill all the aliens which appear level by level from the left red box in the area
you are given some types of turrets with which you can kill them
you can upgrade them with money, which comes from killing aliens
you can even sell turrets to get 75% money back
turrets:
    vulcan: normal turret with nothing special
    plasma: fast
    sam: splash damage with the range of half of the game area, if you upgrade it enough
    freeze: decreases aliens' speed
Big Grin
The biggest bug:
you can cover the start point (the left red box with turrets) and they wouldn't be able to get out Smile


RE: A path finding algorithm - aadityap0901 - 08-27-2024

New Version:

.bas   diagonal_path-finding_algorithm.bas (Size: 5.62 KB / Downloads: 13)
Xeno Tactic:

.zip   XenoTactic_v2.zip (Size: 41.33 KB / Downloads: 46)