TDN - MMR

Option Explicit

'@@ Autor: G Toyz
'@@ Fecha: 04/10
'@@ Creación: 22:23
'@@ Modificación: 28/10 - 10:21 PM _
    Agrego para que se puedan buscar otros tipos de retos.

Private Const Gold                        As Long = 100000 '@@ Cantidad de oro que sale cada reto.
Private Const Max_Search                  As Byte = 30 '@@ Máximo de equipos buscando.
Private Const refError                    As String = "No cumples los requisitos"
Private Const Count_Retos                 As Byte = 3  '@@ Cantidad de retos que haya _
                                                        en el servidor, 1vs1, 2vs2, 3vs3 = 3
Private Type Team_Searching
    Users()                               As Integer  '@@ Usuarios en el equipo.
    Time_Searching                        As Integer  '@@ Tiempo que llevan buscando.
    MMR_Rank                              As Integer  '@@ Rango de MMR para emparejar.
    MMR                                   As Integer  '@@ MMR del equipo (promedio).
    Accepting                             As Boolean  '@@ ¿Están aceptando un emparejamiento?
    Accepts                               As Byte     '@@ ¿Cuántos aceptaron ese emparejamiento?
    Team_ID_Accept                        As Byte     '@@ ¿Contra quién los emparejó?
End Type

Private Type Searching
    Searching(1 To Max_Search)            As Team_Searching '@@ Equipos buscando.
    Teams_Searching                       As Byte           '@@ Cantidad de equipos buscando.
End Type

Private Retos_Searching(1 To Count_Retos) As Searching '@@ ¿Qué tipo de retos quiere buscar?
'_

Public Sub Load()

    '@@ Redimensiono los arrays de Usuarios.

    Dim LoopC As Long
    Dim loopX As Long

    For LoopC = 1 To Count_Retos
        For loopX = 1 To Max_Search
            ReDim Retos_Searching(LoopC).Searching(loopX).Users(1 To LoopC)
        Next loopX
    Next LoopC

End Sub

Public Sub Send_Search(ByRef ID() As Integer, ByVal n_Reto As Byte)

    If Can_Search(ID(), True) = False Then Exit Sub

    Dim LoopC As Long
    Dim loopX As Long
    Dim Names As String

    UserList(ID(1)).Search_Retos.send = True
    UserList(ID(1)).Search_Retos.Type_Reto = n_Reto
    UserList(ID(1)).Search_Retos.Amount_Accept = 1
    UserList(ID(1)).Search_Retos.accept = True
    ReDim UserList(ID(1)).Search_Retos.Send_IDS(1 To n_Reto)

    For LoopC = 1 To n_Reto
        UserList(ID(1)).Search_Retos.Send_IDS(LoopC) = ID(LoopC)
        If Names = "" Then
            Names = UserList(ID(LoopC)).name
        Else
            Names = Names & ", " & UserList(ID(LoopC)).name
        End If
    Next LoopC

    If n_Reto = 1 Then
        Call Search(ID(), n_Reto)
        Exit Sub
    End If

    For loopX = 1 To n_Reto
        Call WriteConsoleMsg(ID(loopX), "El usuario " & UserList(ID(1)).name & " los ha invitado a participar en las clasificatorias del reto " & n_Reto & " vs " & n_Reto & " con los usuarios [" & Names & "]. Ponga /ACEPTAR " & UserList(ID(1)).name & " para aceptar la invitación.", FontTypeNames.FONTTYPE_INFOBOLD)
    Next loopX

End Sub

Public Sub Accept_Search(ByVal ID As Integer, ByVal ID_Send As Integer)

    Dim LoopC As Long
    Dim NoYes As Boolean

    If ID_Send = 0 Then Exit Sub

    NoYes = False
    For LoopC = 1 To UserList(ID_Send).Search_Retos.Type_Reto
        If UserList(ID_Send).Search_Retos.Send_IDS(LoopC) = ID Then _
            NoYes = True
    Next LoopC

    If NoYes = False Then _
        Call WriteConsoleMsg(ID, "El usuario " & UserList(ID_Send).name & " no te ha invitado a ninguna clasificatoria.", FontTypeNames.FONTTYPE_INFOBOLD)

    If UserList(ID).Search_Retos.accept = True Then _
        Call WriteConsoleMsg(ID, "Ya has aceptado una invitación.", FontTypeNames.FONTTYPE_INFOBOLD)

    UserList(ID).Search_Retos.accept = True
    UserList(ID_Send).Search_Retos.Amount_Accept = UserList(ID_Send).Search_Retos.Amount_Accept + 1

    If UserList(ID_Send).Search_Retos.Amount_Accept = UserList(ID_Send).Search_Retos.Type_Reto Then _
        Call Search(UserList(ID_Send).Search_Retos.Send_IDS(), UserList(ID_Send).Search_Retos.Type_Reto)

End Sub

Public Sub Send_Matching(ByVal Team1 As Byte, ByVal Team2 As Byte, ByVal n_Reto As Byte)

    '@@ Hacer un paquete (Write_Send_Matching) que obligue aceptar el reto al usuario.

    Dim LoopC As Long

    With Retos_Searching(n_Reto)
        For LoopC = 1 To n_Reto
            Call WriteSend_Accept_Matching(.Searching(Team1).Users(LoopC))
            Call WriteSend_Accept_Matching(.Searching(Team2).Users(LoopC))
        Next LoopC
        .Searching(Team1).Accepting = True
        .Searching(Team2).Accepting = True
        .Searching(Team1).Accepts = 0
        .Searching(Team2).Accepts = 0
    End With

End Sub

Public Sub Accept_Matching(ByVal ID As Integer)

    If UserList(ID).Search_Retos.Type_Reto = 0 Then Exit Sub

    With Retos_Searching(UserList(ID).Search_Retos.Type_Reto)
        If .Searching(UserList(ID).Search_Retos.Team).Accepting = True Then
            .Searching(UserList(ID).Search_Retos.Team).Accepts = .Searching(UserList(ID).Search_Retos.Team).Accepts + 1
            If .Searching(UserList(ID).Search_Retos.Team).Accepts = UserList(ID).Search_Retos.Type_Reto And .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).Accepts = UserList(ID).Search_Retos.Type_Reto Then
                Call Test_Retos(UserList(ID).Search_Retos.Team, .Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept, UserList(ID).Search_Retos.Type_Reto)
            End If
        End If
    End With

End Sub

Private Sub Test_Retos(ByVal Team1 As Byte, ByVal Team2 As Byte, ByVal n_Retos As Byte)

    Dim LoopC As Long
    Dim loopX As Long

    With Retos_Searching(n_Retos)
        For LoopC = 1 To n_Retos
            Call WarpUserChar(.Searching(Team1).Users(LoopC), 1, 60, 50 + LoopC, False)
            Call WarpUserChar(.Searching(Team2).Users(LoopC), 1, 60, 55 + LoopC, False)
        Next LoopC
        Call Cancel_Search(.Searching(Team1).Users(1), True)
        Call Cancel_Search(.Searching(Team2).Users(1), True)
    End With

End Sub

Public Sub Refuse_Matching(ByVal ID As Integer)

    On Error GoTo Error_SearchRetos

    If UserList(ID).Search_Retos.Type_Reto = 0 Then Exit Sub

    Dim LoopC As Long

    With Retos_Searching(UserList(ID).Search_Retos.Type_Reto)
        If .Searching(UserList(ID).Search_Retos.Team).Accepting = True Then
            .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).Accepting = False
            .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).Accepts = 0
            .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).Team_ID_Accept = 0
            .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).Time_Searching = 0
            .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).MMR_Rank = 100 'Inicial.
            For LoopC = 1 To UserList(ID).Search_Retos.Type_Reto
                WriteConsoleMsg .Searching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept).Users(LoopC), "¡El otro equipo rechazó el encuentro! Has vuelto a la cola.", FontTypeNames.FONTTYPE_INFOBOLD
            Next LoopC
            Call Matching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept, UserList(ID).Search_Retos.Type_Reto)
            Call Cancel_Search(ID)
        End If
    End With

    Exit Sub

Error_SearchRetos:
    Call LogError("Error en Refuse_Matching (Cola de retos). Número " & Err.Number & " Descripción: " & Err.description)

End Sub

Private Sub Search(ByRef ID() As Integer, ByVal n_Reto As Byte)

    '@@ Lo ponemos en búsqueda de reto.

  '  If Can_Search(ID()) = False Then Exit Sub

    Dim LoopC As Long

    With Retos_Searching(n_Reto)
        .Teams_Searching = .Teams_Searching + 1
        For LoopC = 1 To n_Reto
            .Searching(.Teams_Searching).Users(LoopC) = ID(LoopC)
            UserList(ID(LoopC)).Search_Retos.Type_Reto = n_Reto
            UserList(ID(LoopC)).Search_Retos.Team = .Teams_Searching
            WriteConsoleMsg (ID(LoopC)), "Buscando reto...", FontTypeNames.FONTTYPE_INFOBOLD
        Next LoopC
        .Searching(.Teams_Searching).MMR_Rank = 100
        .Searching(.Teams_Searching).Time_Searching = 0
        .Searching(.Teams_Searching).MMR = MMR_Amount(ID())
        Call Matching(.Teams_Searching, n_Reto)
    End With

End Sub

Private Sub Matching(ByVal ID_Team As Byte, ByVal n_Reto As Byte)

    '@@ Tratamos de emparejar.

    Dim Team_LoopC As Long

    With Retos_Searching(n_Reto)
        For Team_LoopC = 1 To .Teams_Searching
            If Compare_MMR(ID_Team, Team_LoopC, n_Reto) = True Then
                If ID_Team = Team_LoopC Then Exit Sub
                If .Searching(Team_LoopC).Accepting = True Then Exit Sub
                .Searching(ID_Team).Team_ID_Accept = Team_LoopC
                .Searching(Team_LoopC).Team_ID_Accept = ID_Team
                Call Send_Matching(ID_Team, Team_LoopC, n_Reto)
                Exit For
            End If
        Next Team_LoopC
    End With

End Sub

Private Function Compare_MMR(ByVal Team_1 As Byte, ByVal Team_2 As Byte, ByVal n_Reto As Byte) As Boolean

    '@@ Comparamos MMR.

    Compare_MMR = False

    With Retos_Searching(n_Reto)

        If .Searching(Team_1).MMR > .Searching(Team_2).MMR + .Searching(Team_1).MMR_Rank Then _
            Exit Function

        If .Searching(Team_1).MMR < .Searching(Team_2).MMR - .Searching(Team_1).MMR_Rank Then _
            Exit Function

    End With

    Compare_MMR = True

End Function

Private Function MMR_Amount(ByRef Players() As Integer) As Integer

    MMR_Amount = 0

    Dim LoopC As Long
    Dim MMR As Integer

    For LoopC = 1 To UBound(Players())
        MMR = MMR + UserList(Players(LoopC)).Search_Retos.MMR
    Next LoopC

    MMR_Amount = (MMR / UBound(Players()))

End Function

Public Sub Cancel_Search(ByVal ID As Integer, Optional ByVal No_Message As Boolean)

    '@@ Cancela la búsqueda de un usuario, también sirve para cuando se desconecta _
        y para cuando entra a un reto.

    '@@ Llamadas: _
        CloseSocket _
        Nuevo paquete

    On Error GoTo Error_SearchRetos

    Dim LoopC As Long
    Dim loopX As Long

    With Retos_Searching(UserList(ID).Search_Retos.Type_Reto)
        .Searching(UserList(ID).Search_Retos.Team).MMR = 0
        .Searching(UserList(ID).Search_Retos.Team).MMR_Rank = 0
        .Searching(UserList(ID).Search_Retos.Team).Time_Searching = 0
      '  If .Searching(UserList(ID).Search_Retos.Team).Accepting Then _
             Call Matching(.Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept, UserList(ID).Search_Retos.Type_Reto)
        .Searching(UserList(ID).Search_Retos.Team).Accepting = False
        .Searching(UserList(ID).Search_Retos.Team).Accepts = 0
        .Searching(UserList(ID).Search_Retos.Team).Team_ID_Accept = 0
        For LoopC = 1 To UserList(ID).Search_Retos.Type_Reto
            If No_Message = False Then _
                WriteConsoleMsg .Searching(UserList(ID).Search_Retos.Team).Users(LoopC), "¡Se canceló la búsqueda por: " & UserList(ID).name & ".", FontTypeNames.FONTTYPE_INFOBOLD
            With UserList(.Searching(UserList(ID).Search_Retos.Team).Users(LoopC)).Search_Retos
                Retos_Searching(UserList(ID).Search_Retos.Type_Reto).Searching(UserList(ID).Search_Retos.Team).Users(LoopC) = 0
                If .send = True Then
                    For loopX = 1 To UserList(ID).Search_Retos.Type_Reto
                        .Send_IDS(loopX) = 0
                    Next loopX
                    .send = False
                End If
                .Team = 0
                .Type_Reto = 0
            End With
        Next LoopC
        .Teams_Searching = .Teams_Searching - 1
    End With

    Exit Sub

Error_SearchRetos:
    Call LogError("Error en Cancel_Search (Cola de retos). Número de error: " & Err.Number & " Descripción: " & Err.description)

End Sub

Private Function Can_Search(ByRef ID() As Integer, Optional ByVal Sender As Boolean) As Boolean

    Dim LoopC As Long

    Can_Search = False

    For LoopC = 1 To UBound(ID())
        With UserList(ID(LoopC))

            If .flags.Muerto Then
                Call WriteConsoleMsg(ID(1), "El usuario " & .name & " está muerto.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Sender = False Then _
                    Call WriteConsoleMsg(ID(LoopC), "¡Estás muerto!", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If

            If .Search_Retos.Team > 0 Then
                Call WriteConsoleMsg(ID(1), "El usuario " & .name & " ya está en reto.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Sender = False Then _
                    Call WriteConsoleMsg(ID(LoopC), "¡No puedes aceptar un reto estando en uno!", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If

        End With
    Next LoopC

    Can_Search = True

End Function

Public Sub Count()

    '@@ El tiempo que lleva buscando un reto...
    '@@ Llamadas: Timer de 1 segundo.
    '@@ Aviso: Saqué el paquete que se enviaba cada un segundo que mandaba al cliente _
               la cantidad de segundos que iba buscando, hacer en el cliente un timer _
               de un segundo y si se manda la búsqueda (o sea, si inicia) empezar a contar.

    Dim LoopC As Long
    Dim loopX As Long

    For LoopC = 1 To 3
        With Retos_Searching(LoopC)
            For loopX = 1 To Max_Search
                .Searching(loopX).Time_Searching = .Searching(loopX).Time_Searching + 1
                .Searching(loopX).MMR_Rank = .Searching(loopX).MMR_Rank + 1
                If .Searching(loopX).MMR_Rank = 200 Then Exit Sub
            Next loopX
        End With
    Next LoopC
End Sub