Death Clanes

Option Explicit

'**********************************************************************
' Autor: G Toyz.                                                      *
' Fecha de creación: 03/11                                            *
' Hora: 23:00                                                         *
' Descripción: Deathmatch de clanes automático.                       *
' Agradecimientos: CuiCui (Gastón)                                    *
'**********************************************************************

Private Const MAX_SlOTS As Byte = 5     '// Máxima cantidad de cupos.
Private Const USER_CLAN As Byte = 20    '// Máxima cantidad de usuarios en un clan.

Private Type tUser
    ID                  As Integer      '// ID del usuario.
    Last_Pos            As WorldPos     '// Última posición del usuario.
End Type

Private Type tTeams
    Users()             As tUser        '// Usuarios en el equipo.
    Name_Team           As Byte         '// Nombre del equipo.
    Points              As Byte         '// Puntos ganados.
    Deaths              As Byte         '// Cantidad de muertos que lleva en la arena. (Se resetea cuando termina un punto)
    Amount_Users        As Byte         '// Cantidad de usuarios que tiene el equipo.
    PosOccupied         As Byte         '// Posiciones que están ocupando.
End Type

Private Type tItems
    ID                  As Integer      '// ID del item.
    Amount              As Integer      '// Cantidad del item.
End Type

Private Type tBilling
    Gold                As Long         '// Cantidad de oro.
    Items()             As tItems       '// Cantidad de objetos.
End Type

Private Type tMax_Potions
    Red                 As Integer      '// Máximo de pociones rojas.
    Blue                As Integer      '// Máximo de pociones azules.
End Type

Private Type tPos
    X_Arena             As Byte         '// Posición X de la arena.
    Y_Arena             As Byte         '// Posición Y de la arena.
    Occupied            As Boolean      '// ¿Posiciones ocupadas?
End Type

Private Type tEvent
    Max_Potions         As tMax_Potions '// Cantidad máxima de pociones.
    Active              As Boolean      '// ¿Evento activo?
    Inscription         As tBilling     '// Inscripción por items o oro.
    Prize               As tBilling     '// Premio por items o oro.
    No_Inscription      As Boolean      '// No hay inscripción.
    InscriptionInPrize  As Boolean      '// ¿La inscripción se acumula en el premio?
    CountDown           As Integer      '// Cuenta regresiva.
    Time_Limit          As Integer      '// Tiempo límite para que se incie el evento.
    Drop                As Boolean      '// ¿Caen objetos?
    Teams()             As tTeams       '// Equipos en el evento.
    Pos(1 To MAX_SlOTS) As tPos         '// Posiciones de las arenas.
    Map_Event           As Integer      '// Mapa del evento.
    Slots               As Byte         '// Cantidad de cupos.
    Slots_Occupied      As Byte         '// Cantidad de cupos ocupados.
    Points              As Byte         '// Cantidad que de puntos que se necesita para ganar.
    X_Items             As Byte         '// Posiciones donde van a caer los items.
    Y_Items             As Byte         '// Posiciones donde van a caer los items.
    Initialize          As Boolean      '// ¿Inicializamos el evento aunque no se haya cumplido los cupos?
    Full_Guild          As Boolean      '// Todo los usuarios online del clan, no importa si son más o menos que otros.
    Slots_User          As Byte         '// Cantidad de usuarios por equipo.
    X_Death             As Byte         '// Posición X en donde van a ir a parar los muertos.
    Y_Death             As Byte         '// Posición Y en donde van a ir a parar los muertos.
End Type

Private DeathMatch      As tEvent       '// Evento.
'_

Public Sub Load()
    '@@ Sub main.
    '@@ Pongan sus coordenadas y mapa.
    With DeathMatch
        .Pos(1).X_Arena = 50
        .Pos(1).Y_Arena = 50
        .Pos(2).X_Arena = 50
        .Pos(2).Y_Arena = 50
        .Pos(3).X_Arena = 50
        .Pos(3).Y_Arena = 50
        .Pos(4).X_Arena = 50
        .Pos(4).Y_Arena = 50
        .Pos(5).X_Arena = 50
        .Pos(5).Y_Arena = 50
        .Map_Event = 1
        .X_Items = 40
        .Y_Items = 40
        .X_Death = 60
        .Y_Death = 60
    End With
End Sub
''
Public Sub Do_Event(ByRef Max_Potions As tMax_Potions, _
                    ByRef Inscription As tBilling, _
                    ByRef Prize As tBilling, _
                    ByVal InscriptionInPrize As Boolean, _
                    ByVal Drop As Boolean, _
                    ByVal Slots As Byte, _
                    ByVal Points As Byte, _
                    ByVal Initialize As Boolean, _
                    ByVal Full_Guild As Boolean, _
                    ByVal Slots_User As Byte, _
                    ByVal No_Inscription As Boolean)

    Dim LoopC As Long

    With DeathMatch
        .Active = True
        .Time_Limit = 120
        .Drop = Drop
        .Full_Guild = Full_Guild
        .Initialize = Initialize
        .Inscription = Inscription
        .InscriptionInPrize = InscriptionInPrize
        .Max_Potions = Max_Potions
        .Points = Points
        .Prize = Prize
        .Slots = Slots
        .Slots_User = Slots_User
        .No_Inscription = No_Inscription
        If .Full_Guild = True Then .Slots_User = MAXASPIRANTES: .InscriptionInPrize = False
        ReDim .Teams(1 To .Slots) As tTeams
        For LoopC = 1 To .Slots
            ReDim .Teams(LoopC).Users(1 To .Slots_User) As tUser
        Next LoopC
        '// MENSAJE VÍA FORMULARIO O CONSOLA.
    End With
End Sub
''
Public Sub Send_Event(ByRef ID() As Integer)

    Dim LoopC As Long
    '// Hacer que sólo el líder pueda mandar.
    With UserList(ID(1)).DeathMatch
        .Send = True
        ReDim .Players(1 To DeathMatch.Slots_User)
        For LoopC = 1 To DeathMatch.Slots_User
            .Players(LoopC) = ID(LoopC)
            '// Le avisamos a todos que los invitó X user (Vía formulario o consola).
        Next LoopC
        .Amount_Accept = 1
        .Accept_Invite = True
    End With
End Sub

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

    UserList(ID).DeathMatch.Accept_Invite = True

    With UserList(ID_Send).DeathMatch
        .Amount_Accept = .Amount_Accept + 1
        If .Amount_Accept = DeathMatch.Slots_User Then
            '// Llevarlos a sus posiciones.
            Call Clean_Send(ID_Send)
        End If
    End With
End Sub

Public Sub Enter_Event(ByRef ID() As Integer)

    Dim LoopC As Long
    Dim LoopX As Long
    Dim LoopZ As Long
    Dim Pos As Byte
    Pos = There_Pos()

    With DeathMatch
        .Slots_Occupied = .Slots_Occupied + 1
        For LoopC = 1 To UBound(ID())
            .Teams(.Slots_Occupied).Users(LoopC).ID = ID(LoopC)
            .Teams(.Slots_Occupied).Users(LoopC).Last_Pos = UserList(ID(LoopC)).Pos
            .Teams(.Slots_Occupied).Amount_Users = UBound(ID())
            .Teams(.Slots_Occupied).Name_Team = modGuilds.GuildName(UserList(ID(1)).GuildIndex)
            .Teams(.Slots_Occupied).PosOccupied = Pos
            .Pos(Pos).Occupied = True
            Call WarpUserChar(ID(LoopC), .Map_Event, .Pos(Pos).X_Arena + LoopC, .Pos(Pos).Y_Arena, False)
            UserList(ID(LoopC)).DeathMatch.Death = True
            UserList(ID(LoopC)).DeathMatch.ID_Team = .Slots_Occupied
            If .No_Inscription = False Then
                UserList(ID(LoopC)).Stats.GLD = UserList(ID(LoopC)).Stats.GLD - .Inscription.Gold
                Call WriteUpdateGold(ID(LoopC))
                For LoopX = 1 To UBound(.Inscription.Items())
                    Call QuitarObjetos(.Inscription.Items(LoopX).ID, .Inscription.Items(LoopX).Amount, ID(LoopC))
                    If .InscriptionInPrize Then
                        .Prize.Items(LoopX).ID = .Inscription.Items(LoopX).ID
                        .Prize.Items(LoopX).Amount = .Inscription.Items(LoopX).Amount
                    End If
                Next LoopX
                .Prize.Gold = .Prize.Gold + .Inscription.Gold
            End If
        Next LoopC
        If .Slots_Occupied = .Slots Then
            .CountDown = 15
            .Time_Limit = -1
        End If
    End With
End Sub

Public Sub Count()
    Dim LoopC As Long
    Dim LoopX As Long
    With DeathMatch
        If .Time_Limit = 0 Then
            .Time_Limit = -1
            If .Active = True Then
                If .Initialize = True Then _
                    .CountDown = 15
            End If
        End If
        If .Time_Limit > 0 Then _
            .Time_Limit = .Time_Limit - 1
        If .CountDown = 0 Then
            .CountDown = -1
            If .Active = True Then
                For LoopC = 1 To .Slots
                    For LoopX = 1 To .Slots_User
                        Call WritePauseToggle(.Teams(LoopC).Users(LoopX).ID)
                    Next LoopX
                Next LoopC
                Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch Clanes» Ya!", FontTypeNames.FONTTYPE_GUILD))
            End If
        End If
        If .CountDown > 0 Then
            Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch Clanes» " & .CountDown, FontTypeNames.FONTTYPE_GUILD))
            .CountDown = .CountDown - 1
        End If
    End With
End Sub

Private Function There_Pos() As Byte
    There_Pos = 0
    Dim LoopC As Long

    With DeathMatch
        For LoopC = 1 To .Slots
            If .Pos(LoopC).Occupied = False Then
                There_Pos = LoopC
                Exit For
            End If
        Next LoopC
    End With
End Function

Public Sub Clean_Send(ByVal ID As Integer)

    Dim LoopC As Long

    With UserList(ID).DeathMatch
        .Accept_Invite = False
        .Amount_Accept = 0
        .Send = False
        For LoopC = 1 To UBound(.Players())
            UserList(.Players(LoopC)).DeathMatch.Accept_Invite = False
            .Players(LoopC) = 0
        Next LoopC
    End With
End Sub

Public Sub Death(ByVal ID As Integer)
    With DeathMatch
        .Teams(UserList(ID).DeathMatch.ID_Team).Deaths = .Teams(UserList(ID).DeathMatch.ID_Team).Deaths + 1
    End With
End Sub