[EE 2.7+] New Party System

[Kimimaru]

Hey, everyone! I re-wrote the party system for my game, and I decided to release it because the current party system, as you know, is incomplete and terribly done. So I thought, why shouldn't everyone be able to have a fully-functional and bug-free party system? The major difference between my party system and the current one is that my system is centralized, while the current system is decentralized. For example, right now, each player has a party leader and party members, and these can vary for each member in the party because of the way the system is done. In my system, parties are stored externally from players' data and are placed into their own UDT. Well, let's get started!

**The first thing you need to do is get rid of anything relating to parties in the source code. You must do this for simplicity purposes, and so that no codes clash! This also means getting rid of all instances of the MAX_PARTY_MEMBERS variable.**

Most of the edits take place in the Server, but there are a few edits we need to do for the Client.

**Client**

**modGameLogic -> Sub HandleKeypresses**

Find these commands:

```
' Party request
        If LCase$(Mid$(MyText, 1, 6)) = "/party" Then
            ' Make sure the player is actually sending something
            If Len(MyText) > 7 Then
                ChatText = Mid$(MyText, 8, Len(MyText) - 7)
                Call SendPartyRequest(ChatText)
            Else
                Call AddText("Usage: /party (username)", AlertColor)
            End If

            MyText = vbNullString
            Exit Sub
        End If

        ' Join party
        If LCase$(Mid$(MyText, 1, 5)) = "/join" Then
            Call SendJoinParty

            MyText = vbNullString
            Exit Sub
        End If

        ' Leave party
        If LCase$(Mid$(MyText, 1, 6)) = "/leave" Then
            Call SendLeaveParty

            MyText = vbNullString
            Exit Sub
        End If
```
Replace that entire code with this:

```
' Party request
        If LCase$(Mid$(MyText, 1, 6)) = "/party" And LCase$(Mid$(MyText, 1, 13)) <> "/partydecline" Then
            ' Make sure the player is actually sending something
            If Len(MyText) > 7 Then
                ChatText = Mid$(MyText, 8, Len(MyText) - 7)
                Call SendPartyRequest(ChatText)
            Else
                Call AddText("Usage: /party (username)", AlertColor)
            End If

            MyText = vbNullString
            Exit Sub
        End If

        ' Join party
        If LCase$(Mid$(MyText, 1, 5)) = "/join" Then
            Call SendJoinParty

            MyText = vbNullString
            Exit Sub
        End If

        ' Decline party request
        If LCase$(Mid$(MyText, 1, 13)) = "/partydecline" Then
            Call SendDeclineParty

            MyText = vbNullString
            Exit Sub
        End If

        ' Leave party
        If LCase$(Mid$(MyText, 1, 6)) = "/leave" Then
            Call SendLeaveParty

            MyText = vbNullString
            Exit Sub
        End If
```
That takes care of the commands for starting a party, accepting a party request, denying a party request, or leaving a party.

Now we need to make sure that all of these commands exist and do what we want them to do.

**modClientTCP**

Add this to the end of the module:

```
Sub SendDeclineParty()
    Call SendData("partydecline" & END_CHAR)
End Sub
```
That's it for the Client! Now let's continue with the Server!

**Server**

First we have to set up parties so that they're centralized, so head over to **modTypes**.

Add this anywhere in the module:

```
Type PartyRec
    Leader As Long
    Member(1 To MAX_PARTY_MEMBERS) As Long
    ShareExp(1 To MAX_PARTY_MEMBERS) As Boolean
End Type
```
Now head on over to the **PlayerRec**, and add these two variables to the end of it:

```
PartyNum As Long
    PartyInvitedBy As Long
```
We'll have to make the MAX_PARTY_MEMBERS variable a constant, so head on over to **modConstants**.

Add this anywhere in the module:

```
Public Const MAX_PARTY_MEMBERS = #
```
Replace the **#** sign with the max number of party members you'd like to be allowed into the party.

We're almost done setting things up. Let's finish that up quickly.

**modGlobals**

Add this anywhere in the module:

```
Public Party() As PartyRec
```
**modGeneral -> Sub InitServer**

Find this:

```
ReDim Guild(1 To MAX_GUILDS) As GuildRec
```
Add this right under it:

```
ReDim Party(1 To MAX_PLAYERS) As PartyRec
```
Now we've successfully finished setting up the party system basics. We now have to add in some Subs and Functions that make handling various aspects of the party easier. So, go to **modDatabase**.

Paste all of this code at the bottom of the module:

```
Function GetPartyMember(ByVal PartyNum As Long, ByVal Member As Long) As Long
    GetPartyMember = Party(PartyNum).Member(Member)
End Function

Sub SetPartyMember(ByVal PartyNum As Long, ByVal Member As Long)
    Dim I As Byte

    For I = 1 To MAX_PARTY_MEMBERS
        If Party(PartyNum).Member(I) = 0 Then
            Party(PartyNum).Member(I) = Member
            Call SetPlayerPartyNum(Member, PartyNum)
            Exit For
        End If
    Next I
End Sub

Sub RemovePartyMember(ByVal PartyNum As Long, ByVal Member As Long)
    Dim I As Byte

    For I = 1 To MAX_PARTY_MEMBERS
        If Party(PartyNum).Member(I) = Member Then
            Party(PartyNum).Member(I) = 0
            Call SetPlayerPartyNum(Member, 0)
            Exit For
        End If
    Next I
End Sub

Function GetPartyLeader(ByVal PartyNum As Long) As Long
    GetPartyLeader = Party(PartyNum).Leader
End Function

Sub SetPartyLeader(ByVal PartyNum As Long, ByVal Leader As Long)
    Party(PartyNum).Leader = Leader
End Sub

Function GetPartyMembers(ByVal PartyNum As Long) As Long
    Dim I As Long

    GetPartyMembers = 0

    For I = 1 To MAX_PARTY_MEMBERS
        If Party(PartyNum).Member(I) > 0 Then
            GetPartyMembers = GetPartyMembers + 1
        End If
    Next I
End Function

Function GetPlayerPartyNum(ByVal Index As Long) As Long
    GetPlayerPartyNum = Player(Index).Char(Player(Index).CharNum).PartyNum
End Function

Sub SetPlayerPartyNum(ByVal Index As Long, ByVal PartyNum As Long)
    Player(Index).Char(Player(Index).CharNum).PartyNum = PartyNum
End Sub

Function GetPartyShareCount(ByVal Index As Long) As Byte
    Dim I As Byte
    Dim PartyNum As Long

    PartyNum = GetPlayerPartyNum(Index)

    GetPartyShareCount = 0

    ' Exit sub if the player is not in a party
    If PartyNum = 0 Then
        Exit Function
    End If

    For I = 1 To MAX_PARTY_MEMBERS
        If Party(PartyNum).ShareExp(I) = True Then
            GetPartyShareCount = GetPartyShareCount + 1
        End If
    Next I
End Function

Function GetPlayerPartyShare(ByVal Index As Long) As Boolean
    Dim I As Byte
    Dim PartyNum As Long

    PartyNum = GetPlayerPartyNum(Index)

    For I = 1 To MAX_PARTY_MEMBERS
        If Party(PartyNum).Member(I) = Index Then
            GetPlayerPartyShare = Party(PartyNum).ShareExp(I)
        End If
    Next I
End Function

Sub SetPlayerPartyShare(ByVal Index As Long, ByVal Share As Boolean)
    Dim I As Byte
    Dim PartyNum As Long

    PartyNum = GetPlayerPartyNum(Index)

    For I = 1 To MAX_PARTY_MEMBERS
        If Party(PartyNum).Member(I) = Index Then
            Party(PartyNum).ShareExp(I) = Share
            Exit For
        End If
    Next I
End Sub
```
That's much better; we now have a set of useful commands for assigning party members, removing party members, and more.

All we really have to do now is handle the packets for joining a party, leaving a party, declining a party invitation, and accepting a party invitation.

**modHandleData -> Sub HandleData**

Add these at the end of the Sub, but before the **End Select** statement:

```
Case "party"
    Call Packet_PartyRequest(Index, trim$(Parse(1)))
    Exit Sub

Case "joinparty"
    Call Packet_JoinParty(Index)
    Exit Sub

Case "partydecline"
    Call Packet_PartyDecline(Index)
    Exit Sub

Case "leaveparty"
    Call Packet_LeaveParty(Index)
    Exit Sub
```
Now go to the very bottom of **modHandleData**, and add these subs:

```
Public Sub Packet_PartyRequest(ByVal Index As Long, ByVal Name As String)
    Dim I As Long, PlayerIndex As Long

    PlayerIndex = FindPlayer(Name)

    If PlayerIndex = 0 Then
        Call PlayerMsg(Index, Name & " is currently offline.", BRIGHTRED)
        Exit Sub
    End If

    If PlayerIndex = Index Then
        Call PlayerMsg(Index, "You cannot party with yourself!", BRIGHTRED)
        Exit Sub
    End If

    If GetPlayerPartyNum(PlayerIndex) > 0 Then
        Call PlayerMsg(Index, Name & " is already in a party!", BRIGHTRED)
        Exit Sub
    End If

    If GetPlayerPartyNum(Index) = 0 Then
        ' Find empty party
        For I = 1 To MAX_PLAYERS
            If Party(I).Leader = 0 Then
                ' Set player to leader of the empty group
                Call SetPartyLeader(I, Index)
                ' Don't forget to set them as a normal member of the group
                Call SetPartyMember(I, Index)
                ' Make party leader share exp
                Call SetPlayerPartyShare(Index, True)
                Exit For
            End If
        Next I
    End If

    If GetPartyMembers(GetPlayerPartyNum(Index)) = MAX_PARTY_MEMBERS Then
        Call PlayerMsg(Index, "Your party is full!", BRIGHTRED)
        Exit Sub
    End If

    Player(PlayerIndex).Char(Player(PlayerIndex).CharNum).PartyInvitedBy = Index

    Call PlayerMsg(Index, "You have invited " & GetPlayerName(PlayerIndex) & " to join your party.", WHITE)
    Call PlayerMsg(PlayerIndex, GetPlayerName(Index) & " has invited you to join a party. Type '/join' to join the party or '/partydecline' to decline the offer.", WHITE)
End Sub

Public Sub Packet_JoinParty(ByVal Index As Long)
    Dim I As Long, PlayerIndex As Long, PartyNum As Long, PartyMember As Long

    PlayerIndex = Player(Index).Char(Player(Index).CharNum).PartyInvitedBy

    If PlayerIndex > 0 Then
        PartyNum = GetPlayerPartyNum(PlayerIndex)

        ' Notify everyone in the party that the new member joined
        For I = 1 To MAX_PARTY_MEMBERS
            PartyMember = Party(PartyNum).Member(I)
            If PartyMember > 0 Then
                Call PlayerMsg(PartyMember, GetPlayerName(Index) & " has joined your party!", WHITE)
            End If
        Next I

        Call SetPartyMember(PartyNum, Index)
        Call PlayerMsg(Index, "You've joined " & GetPlayerName(PlayerIndex) & "'s party!", WHITE)

        ' Find out if the player will share experience points or not (need to be within 5 levels of the leader's level to share exp)
        If (GetPlayerLevel(Index) + 5 < GetPlayerLevel(GetPartyLeader(PartyNum))) Or (GetPlayerLevel(Index) - 5 > GetPlayerLevel(GetPartyLeader(PartyNum))) Then
            Call SetPlayerPartyShare(Index, False)
            Call PlayerMsg(Index, "You will not share experience points with everyone in the party because your level is not within five levels of the party leader's level.", WHITE)
        Else
            Call SetPlayerPartyShare(Index, True)
            Call PlayerMsg(Index, "You will share experience points with everyone in the party because your level is within five levels of the party leader's level.", WHITE)
        End If

        ' Reset who the player was invited by
        Player(Index).Char(Player(Index).CharNum).PartyInvitedBy = 0
    Else
        Call PlayerMsg(Index, "You have not been invited into a party!", BRIGHTRED)
    End If
End Sub

Public Sub Packet_PartyDecline(ByVal Index As Long)
    Dim PlayerIndex As Long

    PlayerIndex = Player(Index).Char(Player(Index).CharNum).PartyInvitedBy

    If PlayerIndex > 0 Then
        Call PlayerMsg(Index, "You have declined " & GetPlayerName(PlayerIndex) & "'s offer to join a party.", WHITE)
        Call PlayerMsg(PlayerIndex, GetPlayerName(Index) & " has declined your offer to join a party.", WHITE)

        ' Reset who the player was invited by
        Player(Index).Char(Player(Index).CharNum).PartyInvitedBy = 0
    Else
        Call PlayerMsg(Index, "You have not been invited into a party!", BRIGHTRED)
    End If
End Sub

Public Sub Packet_LeaveParty(ByVal Index As Long)
    Call LeaveParty(Index)
End Sub
```
These are the Subs that will handle what happens when we use any of the slash (/) commands. There are only a couple of things left to do: Add in the LeaveParty Sub and make you leave the party once you log out. So let's finish this up!

**modGameLogic**

Add this Sub at the very bottom of the module:

```
Sub LeaveParty(ByVal Index As Long)
    Dim I As Long, PlayerIndex As Long, PartyNum As Long, PartyMember As Long

    PartyNum = GetPlayerPartyNum(Index)

    If PartyNum = 0 Then
        Call PlayerMsg(Index, "You're not in a party!", BRIGHTRED)
        Exit Sub
    End If

    ' If the player is the leader, then replace him/her as leader and notify everyone in the party
    If Index = Party(PartyNum).Leader Then
        Call SetPlayerPartyShare(Index, False)
        Call RemovePartyMember(PartyNum, Index)
        Call SetPartyLeader(PartyNum, 0)
        Call PlayerMsg(Index, "You have left the party.", WHITE)

        ' Set new leader if the player was a leader
        For I = 1 To MAX_PARTY_MEMBERS
            PartyMember = Party(PartyNum).Member(I)
            If PartyMember > 0 Then
                Call SetPartyLeader(PartyNum, PartyMember)
                Call SetPlayerPartyShare(PartyMember, True)
                Exit For
            End If
        Next I

        ' If there still is no leader, then that means there are no other group members
        If GetPartyLeader(PartyNum) = 0 Then
            Call PlayerMsg(Index, "The party has been disbanded.", WHITE)
            Exit Sub
        End If

        ' Notify everyone in the party that the leader left and was replaced
        For I = 1 To MAX_PARTY_MEMBERS
            PartyMember = Party(PartyNum).Member(I)
            If PartyMember > 0 Then
                Call PlayerMsg(PartyMember, GetPlayerName(Index) & " has left the party. The new leader is: " & GetPlayerName(Party(PartyNum).Leader), WHITE)
            End If
        Next I
    ' Simply remove the player from the party if he/she is not the leader
    Else
        Call SetPlayerPartyShare(Index, False)
        Call RemovePartyMember(PartyNum, Index)
        Call PlayerMsg(Index, "You have left the party.", WHITE)

        ' Notify everyone in the party that the player left
        For I = 1 To MAX_PARTY_MEMBERS
            PartyMember = Party(PartyNum).Member(I)
            If PartyMember > 0 Then
                Call PlayerMsg(PartyMember, GetPlayerName(Index) & " has left the party.", WHITE)
            End If
        Next I
    End If
End Sub
```
This Sub not only removes players from the party, but it also changes the party leader and disbands the group if needed.

Now we just need to make players automatically leave the group when they've logged out.

**modGameLogic -> Sub LeftGame**

Find this:

```
If Player(Index).InGame Then
        Player(Index).InGame = False

        ' Stop processing NPCs if no one is on it.
        If GetTotalMapPlayers(MapNum) = 0 Then
            PlayersOnMap(MapNum) = NO
        End If
```
Add this directly after it:

```
' If the player is in a party, remove him/her from it
        If GetPlayerPartyNum(Index) > 0 Then
            Call LeaveParty(Index)
        End If
```
Well, that's it! I've fully tested this, and I haven't found any bugs or errors. If you happen to find any, please let me know. Also, I know I haven't included code for distributing the experience points earned among party members. I feel that it's best if I leave you to choose how you want to do that for yourselves.

Enjoy!

[vakarieser]

i'm used… but, find error : Public Const MAX_PARTY_MEMBERS = 4

how i do ?

[erkro1]

Wait, is this for EE or for EO?

[peekay]

EE its an old post from august 2010

[RyokuHasu]

>.> there REALLY should be a sub Board for Mods NOT for EO… They get my hopes up somtimes just to get compile errors because the tut was mis-marked XD