Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
- End With
- End Sub
- Public Sub Refuse_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(.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.
- Call Matching(.Searching(ID).Team_ID_Accept, UserList(ID).Search_Retos.Type_Reto)
- Call Cancel_Search(ID)
- End If
- End With
- 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 Max_Search
- 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)
- '@@ 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
- 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
- For LoopC = 1 To UserList(ID).Search_Retos.Type_Reto
- 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
- .MMR = 0
- .Team = 0
- .Type_Reto = 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
- End With
- .Searching(UserList(ID).Search_Retos.Team).Users(LoopC) = 0
- Next LoopC
- .Searching(UserList(ID).Search_Retos.Team).Time_Searching = 0
- .Searching(UserList(ID).Search_Retos.Team).Accepting = False
- .Searching(UserList(ID).Search_Retos.Team).Accepts = 0
- End With
- End Sub
- Private Function Can_Search(ByRef ID() As Integer, Optional ByVal Sender As Boolean) As Boolean
- Dim LoopC As Long
- Can_Search = False
- If UserList(ID(1)).Search_Retos.send = True Then
- Call WriteConsoleMsg(ID(1), "Ya enviaste una solicitud para buscar un reto.", FontTypeNames.FONTTYPE_INFOBOLD)
- Exit Function
- End If
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement