Nuevo sistema de retos! [13.0]

Ir abajo

Nuevo sistema de retos! [13.0]

Mensaje por Toyz el 6/10/2016, 2:29 am

Buenas, este sistema consiste en buscar retos en base al MMR del usuario si ambos usuarios que buscan un reto tienen un parentesco en el MMR los manda a reto. A medida de que pasa el tiempo agranda ese "parentesco" para buscar más usuarios hasta que llega a un límite. El ganador gana un poco de MMR. El MMR es un número que especifica la habilidad de un usuario.

Esto es una base, le faltan detalles pero lo principal (Sistema de búsqueda, sistema de emparejamiento, mandarlos a arenas, definir ganador y perdedor, darles MMR, etc) está hecho, más que nada tienen que hacer unas condicionales cuando muere el usuario, más algunas llamadas y paquetes (los paquetes son super fáciles)

Testeé al 100% el sistema de emparejamiento y búsqueda. El sistema de retos (con rounds, etc) no está testeado al 100%, agradezco al que compruebe que ande bien. Igual, dudo que tenga errores.

Reutilicé código del aporte de Santo. http://www.gs-zone.org/temas/retos-1vs1-2-rounds-cr-items-y-oro-6-arenas.95341/

Cualquier duda o problema que presente el sistema, avisar.

Pronto haré el 2vs2, aunque mucho no cambia Very Happy

Módulo:


Código:

Option Explicit

'@@ Autor: G Toyz
'@@ Fecha: 04/10
'@@ Creación: 22:23

Private Const Max_Search      As Byte = 20 '@@ Máximo de usuarios buscando.
Private Const refError        As String = "No cumples los requisitos"
Private Const MAX_ARENAS As Byte = 10

Private Type uRetos
    ID              As Integer
    Rounds          As Byte
    Pos            As WorldPos
    X              As Byte
    Y              As Byte
End Type

Private Type Retos
    Players(1 To 2) As uRetos
    MAP_Arena      As Byte
    Count          As Byte
    Occupied        As Boolean
End Type

Private Type User_Searching
    ID                        As Integer  '@@ ID del usuario.
    Time_Searching            As Integer  '@@ Tiempo buscando.
    MMR_Rank                  As Integer  '@@ Rango de MMR.
End Type

Private Type Searching
    Searching(1 To Max_Search) As User_Searching
    Users_Searching            As Byte      '@@ Usuarios buscando.
    Emergency                  As Boolean
End Type
Private Retos_Searching        As Searching
Private Retos(1 To MAX_ARENAS) As Retos
'_

Public Sub Search(ByVal ID As Integer)

    '@@ Lo ponemos en búsqueda de reto.
    '@@ Llamadas: Nuevo paquete.

    If Can_Search(ID) = False Then Exit Sub

    With Retos_Searching
   
        .Users_Searching = .Users_Searching + 1
        .Searching(.Users_Searching).ID = ID
        .Searching(.Users_Searching).MMR_Rank = 100
        .Searching(.Users_Searching).Time_Searching = 0
        UserList(ID).flags.ArraySearching = .Users_Searching
        Call WriteConsoleMsg(ID, "Buscando reto...", FontTypeNames.FONTTYPE_INFOBOLD)
        Call Matching(ID)
    End With

End Sub
Private Sub Matching(ByVal ID As Integer)

    '@@ Tratamos de emparejar.

    Dim LoopC As Long

    With Retos_Searching
   
        For LoopC = 1 To Max_Search
            If Compare_MMR(.Searching(LoopC).ID, ID) = True Then
                If .Searching(LoopC).ID = ID Then Exit Sub
                    Call GO_Arena(.Searching(LoopC).ID, ID)
                    Call Cancel_Search(.Searching(LoopC).ID, False)
                    Call Cancel_Search(ID, False)
                    Call WriteConsoleMsg(ID, "Has encontrado un rival!", FontTypeNames.FONTTYPE_INFOBOLD)
                    Call WriteConsoleMsg(.Searching(LoopC).ID, "Has encontrado un rival!", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit For
            End If
        Next LoopC
    End With

End Sub
Private Function Compare_MMR(ByVal Searcher_Old As Integer, ByVal Searcher_New As Integer) As Boolean

    '@@ Comparamos MMR.

    Compare_MMR = False

        If UserList(Searcher_Old).Stats.MMR > UserList(Searcher_New).Stats.MMR + Retos_Searching.Searching(UserList(Searcher_New).flags.ArraySearching).MMR_Rank Then Exit Function
        If UserList(Searcher_Old).Stats.MMR < UserList(Searcher_New).Stats.MMR - Retos_Searching.Searching(UserList(Searcher_New).flags.ArraySearching).MMR_Rank Then Exit Function

    Compare_MMR = True

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

    Dim LoopC As Long

    With Retos_Searching
        For LoopC = UserList(ID).flags.ArraySearching To .Users_Searching - 1
            .Searching(LoopC).ID = .Searching(LoopC + 1).ID
        Next LoopC
            .Searching(.Users_Searching).ID = 0
            UserList(ID).flags.ArraySearching = 0
            .Users_Searching = .Users_Searching - 1
            If No_Message = False Then _
            WriteConsoleMsg ID, "Has cancelado la búsqueda", FontTypeNames.FONTTYPE_INFOBOLD
    End With

End Sub

Private Function Can_Search(ByVal ID As Integer) As Boolean

  '@@ ¿Puede buscar retos?

    Can_Search = False

    With UserList(ID)

        If .flags.ArraySearching > 0 Then
            Call WriteConsoleMsg(ID, refError, FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
   
        If .flags.Muerto Then
            Call WriteConsoleMsg(ID, refError, FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If

        If Retos_Searching.Users_Searching = 20 Then
            Call WriteConsoleMsg(ID, "Búsqueda de retos llena", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
   
        If There_Arena() = 0 Then
            Call WriteConsoleMsg(ID, "En estos momentos no se puede buscar retos, espere unos momentos", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If

    End With

    Can_Search = True

End Function

Private Sub Extend_MMR_Rank(ByVal ID As Integer)

    '@@ Extendemos el rango de su MMR a medida que pasa el tiempo buscando.

    With Retos_Searching
        If .Searching(ID).Time_Searching Mod 10 = 0 Then
            .Searching(ID).MMR_Rank = .Searching(ID).MMR_Rank + 10
            Call Matching(ID)
        End If
    End With

End Sub

Public Sub Extend_MMR_Rank_Time(ByVal ID As Integer)

    '@@ El tiempo que lleva buscando un reto...
    '@@ Llamadas: Timer de 1 segundo.

    With Retos_Searching
        If UserList(ID).flags.ArraySearching > 0 Then
            If .Emergency = True Then Exit Sub
            .Searching(UserList(ID).flags.ArraySearching).Time_Searching = .Searching(UserList(ID).flags.ArraySearching).Time_Searching + 1
            If .Searching(UserList(ID).flags.ArraySearching).MMR_Rank = 200 Then Exit Sub
            Call Extend_MMR_Rank(ID)
        End If
    End With

End Sub

Private Sub Start_Arenas(ByVal N_Arena As Integer, _
                        ByVal MAP_Arena As Byte, _
                        ByVal Player1_X As Byte, _
                        ByVal Player1_Y As Byte, _
                        ByVal Player2_X As Byte, _
                        ByVal Player2_Y As Byte)

    With Retos(N_Arena)
        .MAP_Arena = MAP_Arena
        .Players(1).X = Player1_X
        .Players(1).Y = Player1_Y
        .Players(2).X = Player2_X
        .Players(2).Y = Player2_Y
    End With

End Sub

Public Sub Load_Arenas()

    '@@ Pongan sus mapas y coordenadas.
    '@@ Llamadas: Main.

    Call Start_Arenas(1, 1, 50, 50, 70, 70)
    Call Start_Arenas(2, 1, 50, 50, 70, 70)
    Call Start_Arenas(3, 1, 50, 50, 70, 70)
    Call Start_Arenas(4, 1, 50, 50, 70, 70)
    Call Start_Arenas(5, 1, 50, 50, 70, 70)
    Call Start_Arenas(6, 1, 50, 50, 70, 70)
    Call Start_Arenas(7, 1, 50, 50, 70, 70)
    Call Start_Arenas(8, 1, 50, 50, 70, 70)
    Call Start_Arenas(9, 1, 50, 50, 70, 70)
    Call Start_Arenas(10, 1, 50, 50, 70, 70)

End Sub

Private Sub GO_Arena(ByVal Player1_ID As Integer, ByVal Player2_ID As Integer)

    '@@ Los llevamos al área de batalla.

    Dim Arena As Byte

    Arena = There_Arena()

    With Retos(Arena)

        .Players(1).ID = Player1_ID
        .Players(2).ID = Player2_ID
   
        .Occupied = True
   
        UserList(.Players(1).ID).flags.Arena = Arena
        UserList(.Players(2).ID).flags.Arena = Arena
   
        UserList(Player1_ID).flags.Reto = 1
        UserList(Player2_ID).flags.Reto = 1
   
        .Players(1).Pos = UserList(.Players(1).ID).Pos
        .Players(2).Pos = UserList(.Players(2).ID).Pos
   
        Call WarpUserChar(.Players(1).ID, .MAP_Arena, .Players(1).X, .Players(1).Y, False)
        Call WarpUserChar(.Players(2).ID, .MAP_Arena, .Players(2).X, .Players(2).Y, False)
   
        Call WritePauseToggle(.Players(1).ID)
        Call WritePauseToggle(.Players(2).ID)

    End With

End Sub

Public Sub Count()

    Dim LoopC As Long

    For LoopC = 1 To MAX_ARENAS
        With Retos(LoopC)
   
            If .Count = 0 Then
                .Count = -1
                If .Players(1).ID > 0 Then
                    Call WriteConsoleMsg(.Players(1).ID, "Reto> YA", FontTypeNames.FONTTYPE_INFOBOLD)
                    Call WritePauseToggle(.Players(1).ID)
                End If
                If .Players(2).ID > 0 Then
                    Call WriteConsoleMsg(.Players(2).ID, "Reto> YA", FontTypeNames.FONTTYPE_INFOBOLD)
                    Call WritePauseToggle(.Players(2).ID)
                End If
            End If
       
            If .Count >= 1 Then
                If .Players(1).ID > 0 Then
                    Call WriteConsoleMsg(.Players(1).ID, "Reto> " & .Count, FontTypeNames.FONTTYPE_INFOBOLD)
                End If
                If .Players(2).ID > 0 Then
                  Call WriteConsoleMsg(.Players(2).ID, "Reto> " & .Count, FontTypeNames.FONTTYPE_INFOBOLD)
                End If
                .Count = .Count - 1
            End If
       
        End With
    Next LoopC

End Sub

Public Sub Death(ByVal ID As Integer)

    Dim Not_Death As Byte

    With Retos(UserList(ID).flags.Arena)
        If UserList(ID).flags.Arena = 0 Then Exit Sub
   
        Call RevivirUsuario(ID)

        With UserList(ID)
            .Stats.MinHp = .Stats.MaxHp
            .Stats.MinMAN = .Stats.MaxMAN
            Call WriteUpdateUserStats(ID)
        End With

        If .Players(1).ID = ID Then Not_Death = 2 Else Not_Death = 1
        .Players(Not_Death).Rounds = .Players(Not_Death).Rounds + 1
   
        If .Players(Not_Death).Rounds = 2 Then
            Call Finish(Not_Death, ID)
        Else
            Call WarpUserChar(.Players(1).ID, .MAP_Arena, .Players(1).X, .Players(1).Y, False)
            Call WarpUserChar(.Players(2).ID, .MAP_Arena, .Players(2).X, .Players(2).Y, False)
            Call WritePauseToggle(.Players(1).ID)
            Call WritePauseToggle(.Players(2).ID)
            .Count = 10
        End If
    End With

End Sub

Public Sub Finish(ByVal ID_Winner As Integer, ByVal ID_Loser As Integer)

    With Retos(UserList(ID_Winner).flags.Arena)

        Call WarpUserChar(.Players(1).ID, .Players(1).Pos.Map, .Players(1).Pos.X, .Players(1).Pos.Y, True)
        Call WarpUserChar(.Players(2).ID, .Players(2).Pos.Map, .Players(2).Pos.X, .Players(2).Pos.Y, True)

        Call WriteConsoleMsg(ID_Winner, "Has ganado el reto, felicidades!", FontTypeNames.FONTTYPE_INFOBOLD)
        Call WriteConsoleMsg(ID_Loser, "Has perdido el reto, siga practicando!", FontTypeNames.FONTTYPE_INFOBOLD)

        With UserList(ID_Winner)
            .Stats.MMR = .Stats.MMR + 50
            .flags.Arena = 0
            .flags.Reto = 0
            .flags.Paralizado = 0
        End With

        With UserList(ID_Loser)
            .Stats.MMR = .Stats.MMR - 50
            .flags.Arena = 0
            .flags.Reto = 0
            .flags.Paralizado = 0
        End With
   
   
        .Occupied = False
   
        .Players(1).ID = 0
        .Players(2).ID = 0
   
        .Players(1).Rounds = 0
        .Players(2).Rounds = 0
   
    End With
End Sub

Private Function There_Arena() As Byte

    Dim LoopC As Long

    For LoopC = 1 To MAX_ARENAS
        If Retos(LoopC).Occupied = False Then
            Retos_Searching.Emergency = False
            There_Arena = LoopC
            Exit Function
        End If
    Next LoopC

    Retos_Searching.Emergency = True
    There_Arena = 0

End Function
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5046
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Nuevo sistema de retos! [13.0]

Mensaje por Enmascarado el 6/10/2016, 6:13 pm

No se mucho de programación.. por lo tanto mi pregunta sería, ¿Tengo que añadir el sistema de retos de "Santo" que dejaste vos en el post para que luego ese sistema se involucre con este?
avatar
Enmascarado
Nivel 3
Nivel 3

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 85
Edad : 26
Localización : En la compu
Fecha de inscripción : 09/08/2011

Ver perfil de usuario

Volver arriba Ir abajo

Re: Nuevo sistema de retos! [13.0]

Mensaje por Toyz el 6/10/2016, 6:37 pm

No. Yo utilicé algunos algoritmos de Santo, nada más.

Igual si la gente no puede distinguir eso, dudo que lo puedan implementar y balancear.
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5046
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Nuevo sistema de retos! [13.0]

Mensaje por Metrosersuah el 13/12/2016, 7:57 am

@Enmascarado escribió:No se mucho de programación.. por lo tanto mi pregunta sería, ¿Tengo que añadir el sistema de retos de "Santo" que dejaste vos en el post para que luego ese sistema se involucre con este?

Si no sabes mucho de programación por que abajo tenes %80 (?.)
Buen aporte.
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 234
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Re: Nuevo sistema de retos! [13.0]

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.