Attribute VB_Name = "Controler"
Option Explicit

Private Type TYPE_XY
    X As Long
    Y As Long
End Type

Private Type TYPE_XYCOUNT
    X As Long
    Y As Long
    Count As Long
    CloseToNewArea As Long
End Type
Private Function GetDirection(OldX As Long, NewX As Long, OldY As Long, NewY As Long) As Byte
    Select Case (NewX - OldX + 1) Or (NewY - OldY + 1) * 4
        Case 1 'north
            GetDirection = 1
        Case 6 'east
            GetDirection = 2
        Case 9 'south
            GetDirection = 3
        Case 4 'west
            GetDirection = 4
        Case Else
            MsgBox "Error at GetDirection! Trying to go " & NewX - OldX & " x " & NewY - OldY & " and can go only to north, east, south or west by one step!", vbCritical
    End Select
End Function
Private Function GetX(ByVal Direction As Byte, ByVal X As Long) As Long
    Select Case Direction
        Case 2 'east
            GetX = X + 1
        Case 4 'west
            GetX = X - 1
        Case Else
            GetX = X
    End Select
End Function
Private Function GetY(ByVal Direction As Byte, ByVal Y As Long) As Long
    Select Case Direction
        Case 1 'north
            GetY = Y - 1
        Case 3 'south
            GetY = Y + 1
        Case Else
            GetY = Y
    End Select
End Function
Private Function TranslateDirection(ByVal Direction As Byte) As String
    Select Case Direction
        Case 1
            TranslateDirection = "North"
        Case 2
            TranslateDirection = "East"
        Case 3
            TranslateDirection = "South"
        Case 4
            TranslateDirection = "West"
    End Select
End Function
Public Sub StartGame()
    Dim Unchecked() As TYPE_XY, GoneThrough() As TYPE_XYCOUNT, DoNotGo() As TYPE_XY
    Dim NextGo() As Long, WasItG As Boolean
    Dim UCount As Long, GCount As Long, DCount As Long
    Dim UIndex As Long, GIndex As Long, DIndex As Long
    Dim LookAt(3) As Boolean, CurX As Long, CurY As Long
    Dim A As Long, B As Long, LastDir As Byte, PreferTurn As Boolean, WasOpenArea As Long
    Dim Advanced As Boolean, NonWiseCheck As Byte
    
    Advanced = MsgBox("Do you wish to use advanced pathfinding?", vbYesNo, "Merri") = vbYes
    
    ReDim Unchecked(999)
    ReDim GoneThrough(999)
    ReDim DoNotGo(999)
    Randomize
    NonWiseCheck = Int(Rnd * 11)
    With frmMain
        'north, east, south, west
        .LookAbout LookAt(0), LookAt(1), LookAt(2), LookAt(3)
        'check the first directions so we can come up with some data to go to
        For A = 0 To 3
            If LookAt(A) Then
                With Unchecked(UCount)
                    .X = GetX(A + 1, CurX)
                    .Y = GetY(A + 1, CurY)
                End With
                UCount = UCount + 1
            Else
                With DoNotGo(DCount)
                    .X = GetX(A + 1, CurX)
                    .Y = GetY(A + 1, CurY)
                End With
                DCount = DCount + 1
            End If
        Next A
        If UCount = 0 Then
            'self explanary
            MsgBox "Can't go anywhere!", vbCritical
            Exit Sub
        ElseIf UCount = 1 Then
            'set the first item never to go into
            With DoNotGo(DCount)
                .X = CurX
                .Y = CurY
            End With
            DCount = DCount + 1
        Else
            'set the first item to maybe get later back to
            With GoneThrough(0)
                .X = CurX
                .Y = CurY
                .Count = 1
            End With
            GCount = 1
        End If
        'loop until all places are checked
        Do
            'first look for a place to go next
            ReDim NextGo(0)
            For UIndex = 0 To UCount - 1
                With Unchecked(UIndex)
                    If (((.X - CurX) = -1 Or (.X - CurX) = 1) And .Y = CurY) Or (((.Y - CurY) = -1 Or (.Y - CurY) = 1) And .X = CurX) Then
                        NextGo(UBound(NextGo)) = UIndex
                        ReDim Preserve NextGo(UBound(NextGo) + 1)
                    End If
                End With
            Next UIndex
            'if there is still nowhere to go, check previously gone through areas...
            If UBound(NextGo) = 0 Then
                If Advanced Then
                    For GIndex = 0 To GCount - 1
                        GoneThrough(GIndex).CloseToNewArea = 0
                    Next GIndex
                    For UIndex = 0 To UCount - 1
                        For GIndex = 0 To GCount - 1
                            With GoneThrough(GIndex)
                                If ((((.X - Unchecked(UIndex).X) = -1 Or (.X - Unchecked(UIndex).X) = 1) And .Y = Unchecked(UIndex).Y) Or (((.Y - Unchecked(UIndex).Y) = -1 Or (.Y - Unchecked(UIndex).Y) = 1) And .X = Unchecked(UIndex).X)) Then
                                    GoneThrough(GIndex).CloseToNewArea = GoneThrough(GIndex).CloseToNewArea + 1
                                End If
                            End With
                        Next GIndex
                    Next UIndex
                    For GIndex = 0 To GCount - 1
                        With GoneThrough(GIndex)
                            If .CloseToNewArea > 0 Then
                                If (((.X - CurX) = -1) And ((.X - CurX) = 1) And ((.Y - CurY) = 0)) Or (((.Y - CurY) = -1) And ((.Y - CurY) = 1) And ((.X - CurX) = 0)) Then Exit For
                                NextGo(UBound(NextGo)) = GIndex
                                ReDim Preserve NextGo(UBound(NextGo) + 1)
                            End If
                        End With
                    Next GIndex
                    If GIndex = GCount Then
                        Do
                            For A = 0 To UBound(NextGo) - 1
                                For GIndex = 0 To GCount - 1
                                    With GoneThrough(GIndex)
                                        If .CloseToNewArea = 0 Then
                                            If ((((.X - GoneThrough(NextGo(A)).X) = -1 Or (.X - GoneThrough(NextGo(A)).X) = 1) And .Y = GoneThrough(NextGo(A)).Y) Or (((.Y - GoneThrough(NextGo(A)).Y) = -1 Or (.Y - GoneThrough(NextGo(A)).Y) = 1) And .X = GoneThrough(NextGo(A)).X)) Then
                                                .CloseToNewArea = .CloseToNewArea + 1
                                                If (((.X - CurX) = -1) And ((.X - CurX) = 1) And ((.Y - CurY) = 0)) Or (((.Y - CurY) = -1) And ((.Y - CurY) = 1) And ((.X - CurX) = 0)) Then Exit Do
                                                    NextGo(UBound(NextGo)) = GIndex
                                                    ReDim Preserve NextGo(UBound(NextGo) + 1)
                                            End If
                                        End If
                                    End With
                                Next GIndex
                            Next A
                            For A = 0 To UBound(NextGo) - 1
                                With GoneThrough(NextGo(A))
                                    .CloseToNewArea = .CloseToNewArea + 1
                                End With
                            Next A
                            If B = A Then Exit Do
                            B = A
                            If Forms.Count = 0 Then Exit Do
                            DoEvents
                        Loop
                    End If
                    'Debug.Print UBound(NextGo)
                    ReDim NextGo(0)
                    'UIndex = &HFFFFFF
                    DIndex = 0
                    For GIndex = 0 To GCount - 1
                        With GoneThrough(GIndex)
                            If ((((.X - CurX) = -1 Or (.X - CurX) = 1) And .Y = CurY) Or (((.Y - CurY) = -1 Or (.Y - CurY) = 1) And .X = CurX)) And (.CloseToNewArea >= DIndex) Then '.Count <= UIndex And
                                'prefer places we've least gone through from
                                If DIndex < .CloseToNewArea Then 'UIndex > .Count Or
                                    'UIndex = .Count
                                    DIndex = .CloseToNewArea
                                    'if number of items differs...
                                    If UBound(NextGo) <> 1 Then ReDim NextGo(1)
                                    'set the index to list
                                    NextGo(0) = GIndex
                                Else
                                    'just a new item with the same amount of visits as other places in the array
                                    NextGo(UBound(NextGo)) = GIndex
                                    ReDim Preserve NextGo(UBound(NextGo) + 1)
                                End If
                            End If
                        End With
                    Next GIndex
                Else
                    UIndex = &HFFFFFF
                    'DIndex = 0
                    For GIndex = 0 To GCount - 1
                        With GoneThrough(GIndex)
                            If ((((.X - CurX) = -1 Or (.X - CurX) = 1) And .Y = CurY) Or (((.Y - CurY) = -1 Or (.Y - CurY) = 1) And .X = CurX)) And .Count <= UIndex Then
                                'prefer places we've least gone through from
                                If UIndex > .Count Then
                                    UIndex = .Count
                                    'if number of items differs...
                                    If UBound(NextGo) <> 1 Then ReDim NextGo(1)
                                    'set the index to list
                                    NextGo(0) = GIndex
                                Else
                                    'just a new item with the same amount of visits as other places in the array
                                    NextGo(UBound(NextGo)) = GIndex
                                    ReDim Preserve NextGo(UBound(NextGo) + 1)
                                End If
                            End If
                        End With
                    Next GIndex
                End If

                'check if we can't go anywhere
                If UBound(NextGo) = 0 Then
                    'nowhere to go!
                    MsgBox "No exit was found!", vbCritical
                    Exit Sub
                End If
                WasItG = True
            Else
                WasItG = False
            End If
            'everywhere we might go are always of equal value
            'thus: randomize where to go!
            Select Case WasItG
                Case False
                    If UBound(NextGo) > 1 And NonWiseCheck = 0 Then
                        PreferTurn = Int(Rnd * (2 + WasOpenArea)) = 1
                        For A = 0 To UBound(NextGo) - 1
                            UIndex = NextGo(A)
                            If GetDirection(CurX, Unchecked(UIndex).X, CurY, Unchecked(UIndex).Y) = LastDir Then Exit For
                        Next A
                        If A = UBound(NextGo) Then
                            UIndex = NextGo(Int(Rnd * UBound(NextGo)))
                        ElseIf PreferTurn Then
                            Do Until UIndex <> NextGo(A)
                                UIndex = NextGo(Int(Rnd * UBound(NextGo)))
                            Loop
                        End If
                        'If PreferTurn Then
                        '    Debug.Print "Wanted to turn"
                        'Else
                        '    Debug.Print "Wanted to go straight ahead"
                        'End If
                    Else
                        UIndex = NextGo(0)
                    End If
                    'Debug.Print "Checking the new place!"
                    A = GetDirection(CurX, Unchecked(UIndex).X, CurY, Unchecked(UIndex).Y)
                    'error, exit
                    If A = 0 Then Exit Sub
                    If LastDir <> A And NonWiseCheck > 0 Then NonWiseCheck = NonWiseCheck - 1: Debug.Print "Direction change at " & Unchecked(UIndex).X & " x " & Unchecked(UIndex).Y
                    LastDir = A
                    If Forms.Count = 0 Then Exit Sub
                    'go to the new location: exit if completed
                    If .MovePlayer(A) Then Exit Sub
                    'set the location we are in
                    CurX = Unchecked(UIndex).X
                    CurY = Unchecked(UIndex).Y
                    'remove the entry from unchecked
                    UCount = UCount - 1
                    For A = UIndex To UCount - 1
                        With Unchecked(A)
                            .X = Unchecked(A + 1).X
                            .Y = Unchecked(A + 1).Y
                        End With
                    Next A
                    'check for other directions around the current location
                    DIndex = 0
                    For A = 1 To 4
                        UIndex = UCount
                        If UIndex < GCount Then UIndex = GCount
                        If UIndex < DCount Then UIndex = DCount
                        For GIndex = 0 To UIndex - 1
                            If GIndex < UCount Then
                                If Unchecked(GIndex).X = GetX(A, CurX) And Unchecked(GIndex).Y = GetY(A, CurY) Then DIndex = DIndex + 1: Exit For
                            End If
                            If GIndex < GCount Then
                                If GoneThrough(GIndex).X = GetX(A, CurX) And GoneThrough(GIndex).Y = GetY(A, CurY) Then DIndex = DIndex + 1: Exit For
                            End If
                            If GIndex < DCount Then
                                If DoNotGo(GIndex).X = GetX(A, CurX) And DoNotGo(GIndex).Y = GetY(A, CurY) Then Exit For
                            End If
                        Next GIndex
                        'if we have no previous data on this location, check it!
                        If GIndex = UIndex Then
                            If Forms.Count = 0 Then Exit Sub
                            If .Look(A) Then
                                If UCount > UBound(Unchecked) Then
                                    ReDim Preserve Unchecked(UBound(Unchecked) + UBound(Unchecked) + 1)
                                End If
                                Unchecked(UCount).X = GetX(A, CurX)
                                Unchecked(UCount).Y = GetY(A, CurY)
                                UCount = UCount + 1
                                DIndex = DIndex + 1
                            Else
                                If DCount > UBound(DoNotGo) Then
                                    ReDim Preserve DoNotGo(UBound(DoNotGo) + UBound(DoNotGo) + 1)
                                End If
                                DoNotGo(DCount).X = GetX(A, CurX)
                                DoNotGo(DCount).Y = GetY(A, CurY)
                                DCount = DCount + 1
                            End If
                        End If
                    Next A
                    If DIndex > 2 Then
                        'If WasOpenArea = 0 Then Debug.Print "Entered open area!"
                        WasOpenArea = WasOpenArea + DIndex - 2
                    ElseIf WasOpenArea > 0 Then
                        'Debug.Print "Left open area! It was as big as " & WasOpenArea
                        WasOpenArea = WasOpenArea \ ((WasOpenArea \ 2) + 2)
                    End If
                    'If WasOpenArea > 0 Then Debug.Print WasOpenArea
                    If DIndex > 1 Then
                        If GCount > UBound(GoneThrough) Then
                            ReDim Preserve GoneThrough(UBound(GoneThrough) + UBound(GoneThrough) + 1)
                        End If
                        'add the entry to gonethrough
                        GoneThrough(GCount).X = CurX
                        GoneThrough(GCount).Y = CurY
                        GoneThrough(GCount).Count = 1
                        'increase counter
                        GCount = GCount + 1
                    ElseIf DIndex = 1 Then
                        Debug.Print "Not coming back!"
                        If DCount > UBound(DoNotGo) Then
                            ReDim Preserve DoNotGo(UBound(DoNotGo) + UBound(DoNotGo) + 1)
                        End If
                        'add the entry to where not to go anymore, because there is no way to go
                        DoNotGo(DCount).X = CurX
                        DoNotGo(DCount).Y = CurY
                        DCount = DCount + 1
                    Else
                        MsgBox "Can't go anywhere anymore! Stuck!", vbCritical
                        Exit Sub
                    End If
                Case True
                    If UBound(NextGo) > 1 And NonWiseCheck = 0 Then
                        PreferTurn = Int(Rnd * (3 + WasOpenArea)) = 1
                        For A = 0 To UBound(NextGo) - 1
                            GIndex = NextGo(A)
                            If GetDirection(CurX, GoneThrough(GIndex).X, CurY, GoneThrough(GIndex).Y) = LastDir Then Exit For
                        Next A
                        If A = UBound(NextGo) Then
                            GIndex = NextGo(Int(Rnd * UBound(NextGo)))
                        ElseIf PreferTurn Then
                            Do Until GIndex <> NextGo(A)
                                GIndex = NextGo(Int(Rnd * UBound(NextGo)))
                            Loop
                        End If
                        'If PreferTurn Then
                        '    Debug.Print "Wanted to turn"
                        'Else
                        '    Debug.Print "Wanted to go straight ahead"
                        'End If
                    Else
                        GIndex = NextGo(0)
                    End If
                    'Debug.Print "Been here before " & GoneThrough(GIndex).Count & " times..."
                    A = GetDirection(CurX, GoneThrough(GIndex).X, CurY, GoneThrough(GIndex).Y)
                    'error, exit
                    If A = 0 Then Exit Sub
                    If LastDir <> A And NonWiseCheck > 0 Then NonWiseCheck = NonWiseCheck - 1
                    LastDir = A
                    'go to the new location: exit if completed
                    If .MovePlayer(A) Then Exit Sub
                    'set to new location
                    CurX = GoneThrough(GIndex).X
                    CurY = GoneThrough(GIndex).Y
                    'check for other directions around the current location
                    DIndex = 0
                    B = 0
                    For A = 1 To 4
                        UIndex = UCount
                        If UIndex < GCount Then UIndex = GCount
                        For UIndex = 0 To UIndex - 1
                            If UIndex < UCount Then
                                If Unchecked(UIndex).X = GetX(A, CurX) And Unchecked(UIndex).Y = GetY(A, CurY) Then DIndex = DIndex + 1: B = B + 1: Exit For
                            End If
                            If UIndex < GCount Then
                                If GoneThrough(UIndex).X = GetX(A, CurX) And GoneThrough(UIndex).Y = GetY(A, CurY) Then DIndex = DIndex + 1: Exit For
                            End If
                        Next UIndex
                    Next A
                    If DIndex > 2 Then
                        'If WasOpenArea = 0 Then Debug.Print "Entered open area!"
                        WasOpenArea = WasOpenArea + DIndex - 2
                    ElseIf WasOpenArea > 0 Then
                        'Debug.Print "Left open area! It was as big as " & WasOpenArea
                        'WasOpenArea = 0
                        WasOpenArea = WasOpenArea \ ((WasOpenArea \ 2) + 2)
                    End If
                    'If WasOpenArea > 0 Then Debug.Print WasOpenArea
                    If DIndex > 1 Then
                        'increase count we've been in here
                        GoneThrough(GIndex).Count = GoneThrough(GIndex).Count + 1
                    ElseIf DIndex = 0 Then
                        MsgBox "Can't go anywhere anymore! Stuck!", vbCritical
                        Exit Sub
                    ElseIf DIndex = 1 Then
                        Debug.Print "Not coming back!"
                        'this position is a dead end, remove it
                        GCount = GCount - 1
                        For A = GIndex To GCount - 1
                            With GoneThrough(A)
                                .X = GoneThrough(A + 1).X
                                .Y = GoneThrough(A + 1).Y
                                .Count = GoneThrough(A + 1).Count
                            End With
                        Next A
                        If DCount > UBound(DoNotGo) Then
                            ReDim Preserve DoNotGo(UBound(DoNotGo) + UBound(DoNotGo) + 1)
                        End If
                        'add to position to never go to again
                        DoNotGo(DCount).X = CurX
                        DoNotGo(DCount).Y = CurY
                        DCount = DCount + 1
                    End If
            End Select
        Loop
    End With
End Sub