Mirage Source

Public Const MAX_PLAYER_PARTY As Byte = 5
Public Const MAX_PARTY As Long = MAX_PLAYERS

Public Type PartyRec
    PartyPlayers(1 To MAX_PLAYER_PARTY) As String
    PartyCount As Long
    Used As Boolean
End Type
Public Party(1 To MAX_PARTY) As PartyRec

Public Sub Party_Clear_All()
Dim i As Long
    For i = 1 To MAX_PARTY
        Party_Clear i
    Next
End Sub

Public Sub Party_Clear(PartyIndex As Long)
    ZeroMemory ByVal VarPtr(Party(PartyIndex)), LenB(Party(PartyIndex))
End Sub

Public Function Party_Create(ByVal Index As Long) As Boolean
Dim i As Long

    For i = 1 To MAX_PARTY
        ' Check if the party is being used
        If Not Party(i).Used Then
            ' Set the first person to the user - First person is leader
            Party(i).PartyPlayers(1) = Current_Name(Index)
            Party(i).PartyCount = 1
            Party(i).Used = True
           
            Player(Index).InParty = True
            Player(Index).PartyIndex = i
            Party_Create = True
            Exit Function
        End If
    Next
    Party_Create = False
End Function

Public Sub Party_Invite(ByVal Index As Long, ByVal Invitee As Long)
Dim PartyIndex As Long

    ' Can't invite self
    If Index = Invitee Then
        SendPlayerMsg Index, "You can not invite yourself.", ActionColor
        Exit Sub
    End If
   
    ' Check if you're in a party
    If Not Player(Index).InParty Then
        ' Create the party
        If Not Party_Create(Index) Then
            SendPlayerMsg Index, "Could not start a party at this time.", ActionColor
            Exit Sub
        End If
    End If
   
    PartyIndex = Player(Index).PartyIndex
   
    ' Check if you are party leader
    If Party(PartyIndex).PartyPlayers(1) <> Current_Name(Index) Then
        SendPlayerMsg Index, "Only party leaders can invite people.", ActionColor
        Exit Sub
    End If
   
    ' Check for an open slot
    If Party(PartyIndex).PartyCount = MAX_PLAYER_PARTY Then
        SendPlayerMsg Index, "Party is full.", ActionColor
        Exit Sub
    End If
   
    ' Check if other player is in party
    If Player(Invitee).InParty Then
        SendPlayerMsg Index, Current_Name(Invitee) + " is currently in a party.", ActionColor
        Exit Sub
    End If
   
    ' Check if other person is already invited to a party
    If Player(Invitee).PartyInvitedBy <> vbNullString Then
        If Player(Invitee).PartyInvitedBy = Current_Name(Index) Then
            SendPlayerMsg Index, "You already invited this player.", ActionColor
        Else
            SendPlayerMsg Index, Current_Name(Invitee) + " has already been invited to a party.", ActionColor
        End If
        Exit Sub
    End If
   
    ' Set the invitees party index
    Player(Invitee).PartyInvitedBy = Current_Name(Index)
    Player(Invitee).PartyIndex = Player(Index).PartyIndex
   
    SendPlayerMsg Index, "You have invited " + Current_Name(Invitee) + " to your party.", ActionColor
    SendPlayerMsg Invitee, Current_Name(Index) + " has invited you to a party.", ActionColor
End Sub

Public Sub Party_Join(ByVal Index As Long)
Dim PartyIndex As Long
Dim i As Long

    ' Check if you're in a party
    If Player(Index).InParty Then
        SendPlayerMsg Index, "You are currently in a party.", ActionColor
        Exit Sub
    End If
   
    PartyIndex = Player(Index).PartyIndex
   
    ' Check if you were invited
    If PartyIndex = 0 Then
        SendPlayerMsg Index, "You have not been invited to a party.", ActionColor
        Exit Sub
    End If
   
    ' Check if the party leader is different then the one who invited you
    If Party(PartyIndex).PartyPlayers(1) <> Player(Index).PartyInvitedBy Then
        SendPlayerMsg Index, "Party error.", ActionColor
        Player(Index).PartyIndex = 0
        Player(Index).PartyInvitedBy = vbNullString
        Exit Sub
    End If
   
    ' Check if somehow the party got filled up
    If Party(PartyIndex).PartyCount = MAX_PLAYER_PARTY Then
        SendPlayerMsg Index, "Party is now full.", ActionColor
        Player(Index).PartyIndex = 0
        Player(Index).PartyInvitedBy = vbNullString
        Exit Sub
    End If
   
    ' Add to party
    ' Find the first open slot
    For i = 1 To MAX_PLAYER_PARTY
        If Party(PartyIndex).PartyPlayers(i) = vbNullString Then
            Party(PartyIndex).PartyPlayers(i) = Current_Name(Index)
            Party(PartyIndex).PartyCount = Party(PartyIndex).PartyCount + 1
           
            Player(Index).InParty = True
            Player(Index).PartyInvitedBy = vbNullString
           
            SendPartyMsg PartyIndex, Current_Name(Index) + " joined the party.", BrightBlue
            Exit Sub
        End If
    Next
   
    SendPlayerMsg Index, "Party error.", ActionColor
    Player(Index).PartyIndex = 0
    Player(Index).PartyInvitedBy = vbNullString
End Sub

Public Sub Party_Decline(ByVal Index As Long)

    ' Check if in party
    If Player(Index).InParty Then
        SendPlayerMsg Index, "You are currently in a party.", ActionColor
        Exit Sub
    End If
   
    ' Check if had party invite
    If Player(Index).PartyIndex = 0 Then
        SendPlayerMsg Index, "You were not invited to a party.", ActionColor
        Exit Sub
    End If
   
    Dim n As Long
    n = FindPlayer(Player(Index).PartyInvitedBy)
    If n > 0 Then
        SendPlayerMsg n, Current_Name(Index) + " has declined your invitation.", ActionColor
    End If
   
    SendPlayerMsg Index, "You have declined the party invition.", ActionColor
    Player(Index).PartyIndex = 0
    Player(Index).PartyInvitedBy = vbNullString
End Sub

Public Sub Party_Quit(ByVal Index As Long)
Dim PartyIndex As Long
Dim i As Long

    ' Check if in party
    If Not Player(Index).InParty Then
        SendPlayerMsg Index, "You are not in a party.", ActionColor
        Exit Sub
    End If
   
    PartyIndex = Player(Index).PartyIndex
   
    ' Check if you are the party leader
    If Party(PartyIndex).PartyPlayers(1) = Current_Name(Index) Then
        ' Clear all players out of party
        For i = 1 To MAX_PLAYER_PARTY
            If Party(PartyIndex).PartyPlayers(i) <> vbNullString Then
                Player(i).InParty = False
                Player(i).PartyIndex = 0
                Player(i).PartyInvitedBy = vbNullString
                SendPlayerMsg i, "The party has been disbanded.", BrightBlue
            End If
        Next
        Party_Clear PartyIndex
    Else
        For i = 1 To MAX_PLAYER_PARTY
            ' Find the player
            If Party(PartyIndex).PartyPlayers(i) = Current_Name(Index) Then
                ' Clear this player out
                Party(PartyIndex).PartyPlayers(i) = vbNullString
                Party(PartyIndex).PartyCount = Party(PartyIndex).PartyCount - 1
               
                Player(Index).InParty = False
                Player(Index).PartyIndex = 0
                Player(Index).PartyInvitedBy = vbNullString
               
                SendPartyMsg PartyIndex, Current_Name(Index) + " has left the party.", BrightBlue
                Exit Sub
            End If
        Next
    End If
End Sub

Public Sub MapNpc_OnDeath(ByVal MapNum As Long, ByVal MapNpcNum As Long)
Dim Exp As Long
Dim NpcNum As Long
Dim i As Long, n As Long
Dim keyArray As Variant, element As Variant

Dim PartyDict As Dictionary
Dim PartyIndex As Long

    NpcNum = MapData(MapNum).MapNpc(MapNpcNum).Num

    Set PartyDict = New Dictionary
   
    ' Get the keyarray
    keyArray = MapData(MapNum).MapNpc(MapNpcNum).Damage.Keys
    For Each element In keyArray
        ' Get the index of the player
        i = FindPlayer(element)
        If i > 0 Then
            ' Check if in party
            If Not Player(i).InParty Then
                ' Check if on the same map
                If Current_Map(i) = MapNum Then
                    Exp = Clamp(Npc_Exp(NpcNum) * (1 + 0.1 * (Npc_Level(NpcNum) - Current_Level(i))), 0, MAX_LONG)
                    Exp = Exp * (MapData(MapNum).MapNpc(MapNpcNum).Damage.Item(element) / Npc_MaxVital(NpcNum, Vitals.HP))
               
                    SendActionMsg MapNum, "+" & Exp & " EXP!", Yellow, ACTIONMSG_SCROLL, Current_X(i), Current_Y(i), i
                    Update_Exp i, Current_Exp(i) + Exp
                End If
            Else
                ' If in party, add up all other users in party of who did damage
                ' Check if it's in the dictionary
                ' If it is, add the damage
                ' If not in the dictionary, add the partyindex and damage
                PartyIndex = Player(i).PartyIndex
                If PartyDict.Exists(PartyIndex) Then
                    PartyDict.Item(PartyIndex) = PartyDict.Item(PartyIndex) + MapData(MapNum).MapNpc(MapNpcNum).Damage.Item(element)
                Else
                    PartyDict.Add PartyIndex, MapData(MapNum).MapNpc(MapNpcNum).Damage.Item(element)
                End If
            End If
        End If
    Next
   
    If PartyDict.Count > 0 Then
        ' Party exp: Exp is based off the highest player
        keyArray = PartyDict.Keys
        For Each element In keyArray
            ' Calculate exp based off the highest level in the party
            ' Exp is then divided evenally among the amount of people in the party
            ' For each person in the party, there is a bonus of 10%, 2 people 20%, 3 people 30%, so on
            Exp = Clamp(Npc_Exp(NpcNum) * (1 + 0.1 * (Npc_Level(NpcNum) - Party(element).HighLevel)), 0, MAX_LONG)
            Exp = Exp * (PartyDict.Item(element) / Npc_MaxVital(NpcNum, Vitals.HP))
            If Party(element).PartyCount > 1 Then
                Exp = Exp + (Exp * (Party(element).PartyCount * 0.1))
                Exp = Exp / Party(element).PartyCount
            End If
           
            ' Give exp to each party member
            For i = 1 To MAX_PLAYER_PARTY
                If Party(element).PartyPlayers(i) <> vbNullString Then
                    n = FindPlayer(Party(element).PartyPlayers(i))
                    If n > 0 Then
                        ' Check if they are on the same map
                        If Current_Map(n) = MapNum Then
                            ' Check if they are in a 10 level range
                            If Current_Level(n) > Party(element).HighLevel - 10 Then
                                SendActionMsg MapNum, "+" & Exp & " EXP!", Yellow, ACTIONMSG_SCROLL, Current_X(n), Current_Y(n), i
                                Update_Exp n, Current_Exp(n) + Exp
                            End If
                        End If
                    End If
                End If
            Next
        Next
    End If
   
    ' Drop goods
    For i = 1 To 4
        If Npc(NpcNum).Drop(i).Chance < Rand(0, 100) Then
            SpawnItem Npc(NpcNum).Drop(i).Item, Npc(NpcNum).Drop(i).ItemValue, MapNum, MapData(MapNum).MapNpc(MapNpcNum).X, MapData(MapNum).MapNpc(MapNpcNum).Y, GetTickCount
        End If
    Next
   
    MapNpc_Kill MapNum, MapNpcNum
End Sub

Public Declare Sub ZeroMemory Lib "Kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)

Sub SendPartyMsg(ByVal PartyIndex As Long, ByVal Msg As String, ByVal Color As Byte)
Dim Buffer As clsBuffer

    Set Buffer = New clsBuffer
   
    Buffer.PreAllocate Len(Msg) + 9
    Buffer.WriteLong CMsgChatMsg
    Buffer.WriteString Msg
    Buffer.WriteByte Color

    SendDataToParty PartyIndex, Buffer.ToArray()
End Sub

Sub SendDataToParty(PartyIndex As Long, ByRef Data() As Byte)
Dim i As Long
Dim n As Long
    For i = 1 To MAX_PLAYER_PARTY
        If LenB(Party(PartyIndex).PartyPlayers(i)) > 0 Then
            n = FindPlayer(Party(PartyIndex).PartyPlayers(i))
            If n > 0 Then
                SendDataTo n, Data
            End If
        End If
    Next
End Sub