Parties

Option Explicit

'**************************************************
''      FENIX XIII.
''      AUTOR; G Toyz.
''      FECHA; 04/17
''      SISTEMA; Party.
''      ACLARACIÓN; Party. Party. MAB cof cof se la come cof cof no es grupo.
'**************************************************

Public Const MAX_PARTICIPANTES_PARTY As Byte = 10          '    «   Cantidad máxima de participantes en una party.
Private Const MAX_PARTIES As Byte = 50                                      '    «   Cantidad máxima de parties.

Private Type tUsuarios              '   «   Información del usuario.
    UsuarioIndex As Integer        '   «   ID (userindex) del usuario (userlist()).
    Porcentaje As Byte                '   «   Porcentaje de la experiencia recaudada que le pertenece.
    Experiencia As Long             '   «   Experiencia que lleva acumulada.
End Type

Private Type tGeneral                                                                                       '   «   Datos generales de las parties.
    Participantes(1 To MAX_PARTICIPANTES_PARTY) As tUsuarios      '   «   Participantes de la party.
    Solicitudes(1 To MAX_PARTICIPANTES_PARTY) As Integer               '   «   Solicitudes de ingreso a la party.
    CantidadParticipantes As Byte                                                                   '   «   Cantidad de participantes que tiene la party.
    Lider As Byte                                                                                                 '   «    ID (de Participantes()) del lider de la party.
End Type

Public Parties(1 To MAX_PARTIES) As tGeneral    '   «   Todas las parties.

Public Sub AñadirParty(ByVal UsuarioIndex As Integer)   '   «   Método para crear una nueva party. _
                                                                                                           (Añadir hace referencia por el array Parties())

    Dim PartyIndex As Byte

    PartyIndex = DamePartyIndex()

    With UserList(UsuarioIndex)
        '   «   ¿Ya está en una party el usuario?
        If .Party.PartyIndex > 0 Then
            Call WriteConsoleMsg(UsuarioIndex, "Primero debes " & IIf(.Party.Lider, "disolver", "abandonar") & " la party para poder fundar una.", FontTypeNames.FONTTYPE_CONSEJO)
            Exit Sub
        End If

        .Party.PartyIndex = PartyIndex
        .Party.ParticipanteIndex = 1
    End With

    With Parties(PartyIndex)
        .CantidadParticipantes = 1
        .Lider = 1      '       ««  El que la crea es el lider.
        .Participantes(.Lider).UsuarioIndex = UsuarioIndex
        .Participantes(.Lider).Porcentaje = 100     '      «  Default
    End With

    Call WriteConsoleMsg(UsuarioIndex, "Has fundado una party.", FontTypeNames.FONTTYPE_CONSEJO)
End Sub


Public Sub EnviarSolicitudIngreso(ByVal UsuarioIndex As Integer, ByVal LiderIndex As Integer) '   «  Método para enviar una _
                                                                                                                                                                            Solicitud de ingreso a la party.

    Dim SolicitudIndex As Byte

    If LiderIndex = 0 Then
        Call WriteConsoleMsg(UsuarioIndex, "Clickea al lider de la party.", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    If Not UserList(LiderIndex).Party.Lider Then
        Call WriteConsoleMsg(UsuarioIndex, "El usuario no es lider de ninguna party.", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    SolicitudIndex = DameSolicitudIndex(UserList(LiderIndex).Party.PartyIndex)

    If SolicitudIndex = 0 Then
        Call WriteConsoleMsg(UsuarioIndex, "La party ya tiene muchas solicitudes de ingreso, intente más tarde", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    Parties(UserList(LiderIndex).Party.PartyIndex).Solicitudes(SolicitudIndex) = UsuarioIndex

    Call WriteActualizarDatosParty(LiderIndex)
End Sub

Public Sub AñadirParticipante(ByVal SolicitudIndex As Byte, ByVal PartyIndex As Byte)  '   «   Método para añadir un participante _
                                                                                                                                                                 a la party.

    Dim ParticipanteIndex As Byte
    Dim UsuarioIndex As Integer
    UsuarioIndex = Parties(PartyIndex).Solicitudes(SolicitudIndex)
    ParticipanteIndex = DameParticipanteIndex(PartyIndex)

    With UserList(UsuarioIndex)
        If .Party.PartyIndex > 0 Then
            Call WriteConsoleMsg(UsuarioIndex, "Primero debes " & IIf(.Party.Lider, "disolver", "abandonar") & " la party para poder entrar a una.", FontTypeNames.FONTTYPE_CONSEJO)
            Exit Sub
        End If

        .Party.PartyIndex = PartyIndex
        .Party.ParticipanteIndex = ParticipanteIndex

        Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg(.Name & " ha ingresado a la party.", FontTypeNames.FONTTYPE_CONSEJO))
    End With

    Parties(PartyIndex).CantidadParticipantes = Parties(PartyIndex).CantidadParticipantes + 1
    With Parties(PartyIndex).Participantes(PartyIndex)
        .Experiencia = 0
        .UsuarioIndex = UsuarioIndex
        ResetearPorcentajes PartyIndex
    End With

    Parties(PartyIndex).Solicitudes(SolicitudIndex) = 0
    Call WriteActualizarDatosParty(UsuarioIndex)
End Sub

Public Sub QuitarParticipante(ByVal UsuarioIndex As Integer)    '   «   Método para quitar a un participante de la party.
    Call SendData(SendTarget.ToPartyArea, UserList(UsuarioIndex).Party.PartyIndex, PrepareMessageConsoleMsg(UserList(UsuarioIndex).Name & " abandona la party.", FontTypeNames.FONTTYPE_CONSEJO))
    Call WriteConsoleMsg(UsuarioIndex, "Abandonas la party.", FontTypeNames.FONTTYPE_CONSEJO)
    With Parties(UserList(UsuarioIndex).Party.PartyIndex)
        DarExperiencia UsuarioIndex, .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).Experiencia
        .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).Experiencia = 0
        .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).Porcentaje = 0
        .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).UsuarioIndex = 0
        .CantidadParticipantes = .CantidadParticipantes - 1
        ResetearPorcentajes UserList(UsuarioIndex).Party.PartyIndex
    End With
End Sub

Public Sub RepartirExperiencia(ByVal PartyIndex As Byte, ByVal Experiencia As Long)  '   «   Método para repartir la experiencia _
                                                                                                                                                                 recaudada en el momento.

    Dim LoopC As Long

    With Parties(PartyIndex)
        For LoopC = 1 To MAX_PARTICIPANTES_PARTY
            If .Participantes(LoopC).UsuarioIndex > 0 Then
                Experiencia = CLng(Round(Experiencia * .Participantes(LoopC).Porcentaje / 100))
                .Participantes(LoopC).Experiencia = Experiencia
            End If
        Next LoopC
    End With
End Sub

Private Sub DarExperiencia(ByVal UsuarioIndex As Integer, ByVal Experiencia As Long) '  « Método para entregar la experiencia _
                                                                                                                                                               recaudada hasta el momento a un usuario.
    With UserList(UsuarioIndex)
        .Stats.Exp = .Stats.Exp + Experiencia
        If .Stats.Exp > MAXEXP Then _
            .Stats.Exp = MAXEXP
        Call WriteConsoleMsg(UsuarioIndex, "Has ganado " & Experiencia & " puntos de experiencia durante la party.", FontTypeNames.FONTTYPE_CONSEJO)
        Call CheckUserLevel(UsuarioIndex)
    End With
End Sub

Private Sub ResetearPorcentajes(ByVal PartyIndex As Byte)   '   «   Método para restablecer los porcentajes a default.

    Dim Porcentaje As Byte
    Dim LoopC As Long

    With Parties(PartyIndex)
        Porcentaje = CByte(Round(100 / .CantidadParticipantes))

        For LoopC = 1 To .CantidadParticipantes
            .Participantes(LoopC).Porcentaje = Porcentaje
        Next LoopC
        Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg("Los porcentajes han sido reseteados.", FontTypeNames.FONTTYPE_CONSEJO))
    End With

End Sub

Public Sub EnviarToParty(ByRef dataTosend As String, ByVal sndIndex As Byte)    '   «   Método readaptado del anterior sistema. _
                                                                                                                                                        Este cumple enviar data a todos los _
                                                                                                                                                        participantes de la party.

    Dim LoopC  As Long

    For LoopC = 1 To MAX_PARTICIPANTES_PARTY
        With Parties(sndIndex)
            If .Participantes(LoopC).UsuarioIndex > 0 Then
                Call EnviarDatosASlot(.Participantes(LoopC).UsuarioIndex, dataTosend)
            End If
        End With
    Next LoopC

End Sub

Public Sub DisolverParty(ByVal UsuarioIndex As Byte)    '   «   Método para disolver la party.

    Dim LoopC As Long

    With Parties(UserList(UsuarioIndex).Party.PartyIndex)

        If Not .Lider = UserList(UsuarioIndex).Party.ParticipanteIndex Then Exit Sub

        For LoopC = 1 To MAX_PARTICIPANTES_PARTY
            If .Participantes(LoopC).UsuarioIndex > 0 Then
                Call QuitarParticipante(.Participantes(LoopC).UsuarioIndex)
            End If
        Next LoopC

        .Lider = 0
        .CantidadParticipantes = 0
        Erase .Participantes()
        Erase .Solicitudes()
    End With
End Sub

Private Function DameSolicitudIndex(ByVal PartyIndex As Byte) As Byte   '   «   Método para devolver el ID libre del array Solicitudes().

    Dim LoopC As Long

    With Parties(PartyIndex)
        For LoopC = 1 To MAX_PARTICIPANTES_PARTY
            If .Solicitudes(LoopC) = 0 Then
                DameSolicitudIndex = LoopC
                Exit Function
            End If
        Next LoopC
    End With

End Function

Private Function DameParticipanteIndex(ByVal PartyIndex As Byte) As Byte    '   «   Método para devolver el ID libre del array Participantes().

    Dim LoopC As Long

    With Parties(PartyIndex)
        For LoopC = 1 To MAX_PARTICIPANTES_PARTY
            If .Participantes(LoopC).UsuarioIndex = 0 Then
                DameParticipanteIndex = LoopC
                Exit Function
            End If
        Next LoopC
    End With

End Function

Private Function DamePartyIndex() As Byte   '   « Método para devolver el ID libre del array Parties().

    Dim LoopC As Long

    For LoopC = 1 To MAX_PARTIES
        '   Si la party tiene líder. Todas las partys tienen, obligatoriamente, líder. En caso de que no tenga líder es porque esa party no existe.
        If Parties(LoopC).Lider = 1 Then
            DamePartyIndex = LoopC
            Exit Function
        End If
    Next LoopC

End Function