modParties

Option Explicit

'Autor: G Toyz.

Public Const MAX_PARTICIPANTES_PARTY As Byte = 10 ' No exceder este límite 10 (diez).
Private Const MAX_PARTIES As Byte = 50

Private Type tUsuarios
    UsuarioIndex As Integer
    Porcentaje As Byte
    Experiencia As Long
End Type

Private Type tGeneral
    Participantes(1 To MAX_PARTICIPANTES_PARTY) As tUsuarios
    Solicitudes(1 To MAX_PARTICIPANTES_PARTY) As Integer
    CantidadParticipantes As Byte
    Activa As Boolean
    Lider As Byte
End Type

Public Parties(1 To MAX_PARTIES) As tGeneral

Public Sub AñadirParty(ByVal UsuarioIndex As Integer)

    Dim PartyIndex As Byte

    With UserList(UsuarioIndex)
        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

    PartyIndex = DamePartyIndex()
    With Parties(PartyIndex)
        .CantidadParticipantes = 1
        .Activa = True
        .Lider = 1      '       ««  El que la crea es el lider.
        .Participantes(.Lider).UsuarioIndex = UsuarioIndex
    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)

    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)

    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)
    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)

    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)
    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)

    Dim Porcentaje As Byte       '    «   Porcentaje para cada usuario
    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)

    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 SetearPorcentajes(ByVal PartyIndex As Byte, ByVal ParticipanteIndex As Byte, ByVal Porcentaje As Byte)
    Parties(PartyIndex).Participantes(ParticipanteIndex).Porcentaje = Porcentaje
    Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg("El porcentaje de " & UserList(Parties(PartyIndex).Participantes(ParticipanteIndex).UsuarioIndex).Name & " ahora es de " & Porcentaje, FontTypeNames.FONTTYPE_CONSEJO))
End Sub

Public Sub DisolverParty(ByVal UsuarioIndex As Byte)

    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

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

Private Function DameSolicitudIndex(ByVal PartyIndex As Byte) As Byte

    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

    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

    Dim LoopC As Long

    For LoopC = 1 To MAX_PARTIES
        If Parties(LoopC).Activa = False Then
            DamePartyIndex = LoopC
            Exit Function
        End If
    Next LoopC

End Function