[Feature] Party System

[Jacob]

This is not a full tutorial.
It will give you most of the code needed to change the party system, but will not show how to integrate it. If parts are missing, you need to figure out how to do it.

MAX_PLAYER_PARTY is the max amount of people in a party.
MAX_PARTY is the amount of max parties at one time. I set it to the max amount of users online.

Code:

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

This is our Party UDT. Holds the party players, how many players are in the party and if the party is used.

Code:

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

The below will clear out parties.

Code:

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

Code:

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

Code:

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

Code:

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

Code:

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

Code:

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

Code:

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

This will give you the 'guts' of the party system. A lot of things will need to change for your game, but at least it's a start.

Below is how i do EXP. Each player who did damage will get a % of exp from the npc. If in a party, it will add all the other players who did damage and add them up so you don't get a bunch of small exp values. All players in a party share exp.
My source is very edited, so you probably won't get too much use out of this.

Code:

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

[genusis]

wow loading every player into the party into a Party dictionary very useful and faster Feature for getting the damage npcs and players =3.

[Joost]

I mentioned this before, but the post got deleted. In this set-up, the healer gets 0% exppoints and won't be able to level in parties. You'd be forcing a healer to level alone/switch to dps role to get exps.

[Jacob]

I mentioned this before, but the post got deleted. In this set-up, the healer gets 0% exppoints and won't be able to level in parties. You'd be forcing a healer to level alone/switch to dps role to get exps.

And I told you before, that's not how it works at all. This is also just an example of how I do exp. You can do whatever you would like.

If one person in the party does damage to the NPC, the whole party will share exp from that. Read the code.

[Joost]

Fine, your explanation is stupid, there are a few programming mistakes, and a lot of common sence mistakes.

"Below is how i do EXP. Each player who did damage will get a % of exp from the npc. If in a party, it will add all the other players who did damage and add them up so you don't get a bunch of small exp values."

Plus, you got a loop inside a loop. Even though you did comment on that part of the code yourself, it's pure evil.

Plus, there's no advantage from partying if exps is shared at exp / party members.

Plus, a level 100 can group with a level 1, beat some level 100 mobs, and the level 1 will recieve 50% from what the level 100 would normally obtain. I'd call that some fast leveling.

Plus, you don't check if party members are even on the same map before awarding exps.

Plus, the same mob can spawn 4 of the same items, aka, drop rate is 4 times higher than normal when in a party, regardless of amount of members.

[ShadowMaster]

I think that the exp should be divided base on how many members:

GiveXP= Exp÷Members+1

[Xlithan]

I want to use this in my MUD game. Now, I don't want to share exp with other party members, I only want the rest of the feature so that the players are in the party together.
Is all that is needed besides those sub routines, just the HandleData packets being set up?

I'm assuming Current_Name would just get changed to GetPlayerName, but what is ZeroMemory?

Do you think you could paste your SendPartyMsg code too? Thanks.

[Nean]

I want to use this in my MUD game. Now, I don't want to share exp with other party members, I only want the rest of the feature so that the players are in the party together.
Is all that is needed besides those sub routines, just the HandleData packets being set up?

I'm assuming Current_Name would just get changed to GetPlayerName, but what is ZeroMemory?

Do you think you could paste your SendPartyMsg code too? Thanks.

If you're using a MUD, I'd just rewrite this from scratch. Look at the code, and adapt it for your game. Copy and pasting won't work very well, I'd assume.

[Xlithan]

It should work fine since most of the code is still the same. For the party system this will work great as I only need the game to know who is in the party. I can then expand on the system so that the other players in the party automatically follow you from room to room.

[Jacob]

Basically remove all the old stuff and just call the appropriate PARTY_function.

[Xlithan]

What's ZeroMemory?

And can you post your SendPartyMsg sub code please mate? Cheers

[Jacob]

Code:

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

Code:

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

Code:

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

[Xlithan]

Thanks Jacob. I'll let you know how I get on with this.