[EO] Party Levels and Exp Boosts V1.0 (SERVER ONLY)

[RyokuHasu]

Ok I just randomly though shouldnt you gett somthin "Extra" from parties and from staying in them for long anounts of time.

Please Comment or rate =D

I HIGHLY recommend using the following if you are going to use this mod:

Party Bug Fix:
http://www.touchofdeathforums.com/smf2/index.php/topic,81073.0.html

Concept

This tut will give each individual pary a level that starts at 0 and goes up from there. the higher your level, the harder you will have to work (as a team) to rais the party level. For evey Party Level you will gain a % of extra EXP for the whole party. The max level of a party is 50\.

How it works

When a party is started the level is set to 0\. The exp needed from fights is the leader's level * the numer of people in the party * 100\. (the more people in the party, and the higher the leader's level the more exp needed to LV up, just to make it fair) For every Level the party gains the party as a whole gains 1% extra exp per kill. This makes it Worth being in parties and staying in them while you all kill stuff the average EXP will be greater as long as everyone is helping. Also for every Level the Party Gains a party message will pop up giving your new level.

Surprisingly this is a really simple mod.

**SERVER ONLY** (no client side at all)

In modTypes

Find Public Type PartyRec

Under "MemberCount As Long" add
```

PTCheckLevel As Long
    PTlevel As Long
    PTEXP As Long

```
**EDITED: Extra non-needed data removed**

In  modGameLogic Find Public Sub Party_PlayerLeave and replace with.

```

Public Sub Party_PlayerLeave(ByVal index As Long)
Dim partyNum As Long, i As Long

    partyNum = TempPlayer(index).inParty
    If partyNum > 0 Then
        ' find out how many members we have
        Party_CountMembers partyNum
        ' make sure there's more than 2 people
        If Party(partyNum).MemberCount > 2 Then
            ' check if leader
            If Party(partyNum).Leader = index Then
                ' set next person down as leader
                For i = 1 To MAX_PARTY_MEMBERS
                    If Party(partyNum).Member(i) > 0 And Party(partyNum).Member(i) <> index Then
                        Party(partyNum).Leader = Party(partyNum).Member(i)
                        PartyMsg partyNum, GetPlayerName(i) & " is now the party leader.", BrightBlue
                        Exit For
                    End If
                Next
                ' leave party
                PartyMsg partyNum, GetPlayerName(index) & " has left the party.", BrightRed
                ' remove from array
                For i = 1 To MAX_PARTY_MEMBERS
                    If Party(partyNum).Member(i) = index Then
                        Party(partyNum).Member(i) = 0
                        Exit For
                    End If
                Next
                ' recount party
                Party_CountMembers partyNum
                ' set update to all
                SendPartyUpdate partyNum
                ' send clear to player
                SendPartyUpdateTo index
            Else
                ' not the leader, just leave
                PartyMsg partyNum, GetPlayerName(index) & " has left the party.", BrightRed
                ' remove from array
                For i = 1 To MAX_PARTY_MEMBERS
                    If Party(partyNum).Member(i) = index Then
                        Party(partyNum).Member(i) = 0
                        Exit For
                    End If
                Next
                ' recount party
                Party_CountMembers partyNum
                ' set update to all
                SendPartyUpdate partyNum
                ' send clear to player
                SendPartyUpdateTo index
            End If
        Else
            ' find out how many members we have
            Party_CountMembers partyNum
            ' only 2 people, disband
            PartyMsg partyNum, "Party disbanded.", BrightRed
            ' clear out everyone's party
            Party(partyNum).PTEXP = 0
            Party(partyNum).PTlevel = 0
            For i = 1 To MAX_PARTY_MEMBERS
                index = Party(partyNum).Member(i)
                ' player exist?
                If index > 0 Then
                    ' remove them
                    TempPlayer(index).inParty = 0
                    ' send clear to players
                    SendPartyUpdateTo index
                End If
            Next
            ' clear out the party itself
            ClearParty partyNum
        End If
    End If
End Sub

```
Also in modGameLogic Find Public Sub Party_InviteAccept and replace it with

```
Public Sub Party_InviteAccept(ByVal index As Long, ByVal targetPlayer As Long)
Dim partyNum As Long, i As Long

    ' check if already in a party
    If TempPlayer(index).inParty > 0 Then
        ' get the partynumber
        partyNum = TempPlayer(index).inParty
        ' got a blank slot?
        For i = 1 To MAX_PARTY_MEMBERS
            If Party(partyNum).Member(i) = 0 Then
                'add to the party
                Party(partyNum).Member(i) = targetPlayer
                ' recount party
                Party_CountMembers partyNum
                ' send update to all - including new player
                SendPartyUpdate partyNum
                SendPartyVitals partyNum, targetPlayer
                ' let everyone know they've joined
                PartyMsg partyNum, GetPlayerName(targetPlayer) & " has joined the party.", Pink
                ' add them in
                TempPlayer(targetPlayer).inParty = partyNum
                Exit Sub
            End If
        Next
        ' no empty slots - let them know
        PlayerMsg index, "Party is full.", BrightRed
        PlayerMsg targetPlayer, "Party is full.", BrightRed
        Exit Sub
    Else
        ' not in a party. Create one with the new person.
        For i = 1 To MAX_PARTYS
            ' find blank party
            If Not Party(i).Leader > 0 Then
                partyNum = i
                Exit For
            End If
        Next
        ' create the party
        Party(partyNum).MemberCount = 2
        Party(partyNum).Leader = index
        Party(partyNum).Member(1) = index
        Party(partyNum).Member(2) = targetPlayer
        SendPartyUpdate partyNum
        SendPartyVitals partyNum, index
        SendPartyVitals partyNum, targetPlayer
        Party(partyNum).PTEXP = 0
        Party(partyNum).PTlevel = 0
        ' let them know it's created
        PartyMsg partyNum, "Party created.", BrightGreen
        PartyMsg partyNum, GetPlayerName(index) & " has joined the party.", Pink
        PartyMsg partyNum, GetPlayerName(targetPlayer) & " has joined the party.", Pink
        ' clear the invitation
        TempPlayer(targetPlayer).partyInvite = 0
        ' add them to the party
        TempPlayer(index).inParty = partyNum
        TempPlayer(targetPlayer).inParty = partyNum
        Exit Sub
    End If
End Sub

```
in the same mod find Public Sub Party_ShareExp and replace with
```

Public Sub Party_ShareExp(ByVal partyNum As Long, ByVal exp As Long, ByVal index As Long)
Dim expShare As Long, leftOver As Long, i As Long, tmpIndex As Long

    ' check if it's worth sharing
    If Not exp >= Party(partyNum).MemberCount Then
        ' no party - keep exp for self
        GivePlayerEXP index, exp
        Exit Sub
    End If
    'Calculate the EXP for the party its self
    If Party(partyNum).MemberCount > 1 Then
        Party(partyNum).PTEXP = Party(partyNum).PTEXP + exp
        Party(partyNum).PTCheckLevel = Party(partyNum).PTEXP / Round(100 * Party(partyNum).MemberCount * GetPlayerLevel(Party(partyNum).Leader))
    End If

    'check if part level has increased
    If (Party(partyNum).PTCheckLevel > Party(partyNum).PTlevel) Then
        Party(partyNum).PTlevel = Party(partyNum).PTCheckLevel
        If (Party(partyNum).PTlevel > 50) Then
            Party(partyNum).PTlevel = 50
            PartyMsg partyNum, "Party Level is LV " & Party(partyNum).PTlevel & " and the party will gain a " & Party(partyNum).PTlevel & "% exp boost.", BrightGreen
            PartyMsg partyNum, "Your party has reached the Max Level and will not level up any higher", BrightGreen
        Else
            PartyMsg partyNum, "Party Level Increased to LV " & Party(partyNum).PTlevel & " and the party will gain a " & Party(partyNum).PTlevel & "% exp boost.", BrightGreen
        End If
    End If

    exp = exp + Round(((exp / 100) * Party(partyNum).PTlevel))

    ' find out the equal share
    expShare = exp \ Party(partyNum).MemberCount
    leftOver = exp Mod Party(partyNum).MemberCount

    ' loop through and give everyone exp
    For i = 1 To MAX_PARTY_MEMBERS
        tmpIndex = Party(partyNum).Member(i)
        ' existing member?Kn
        If tmpIndex > 0 Then
            ' playing?
            If IsConnected(tmpIndex) And IsPlaying(tmpIndex) Then
                ' give them their share
                GivePlayerEXP tmpIndex, expShare
            End If
        End If
    Next

    ' give the remainder to a random member
    tmpIndex = Party(partyNum).Member(RAND(1, Party(partyNum).MemberCount))
    ' give the exp
    GivePlayerEXP tmpIndex, leftOver
End Sub

```
**EDITED: MORE non-needed data removed**

**AND DONE!**

Credits please.

Tested… found no bugs, let me know if you find any.

[RyokuHasu]

Please Comment

ADDED: Screen shot

EDITED:

Better reconizatin of max level of party better.

```

Public Sub Party_ShareExp(ByVal partyNum As Long, ByVal exp As Long, ByVal index As Long)
Dim expShare As Long, leftOver As Long, i As Long, tmpIndex As Long

    ' check if it's worth sharing
    If Not exp >= Party(partyNum).MemberCount Then
        ' no party - keep exp for self
        GivePlayerEXP index, exp
        Exit Sub
    End If
    'Calculate the EXP for the party its self
    If Party(partyNum).MemberCount > 1 Then
        Party(partyNum).PTEXP = Party(partyNum).PTEXP + exp
        Party(partyNum).PTCheckLevel = Party(partyNum).PTEXP / Round(100 * Party(partyNum).MemberCount * GetPlayerLevel(Party(partyNum).Leader))
    End If

    'check if part level has increased
    If (Party(partyNum).PTCheckLevel > Party(partyNum).PTlevel) Then
        Party(partyNum).PTlevel = Party(partyNum).PTCheckLevel
        If (Party(partyNum).PTlevel > 50) Then
            Party(partyNum).PTlevel = 50
            PartyMsg partyNum, "Party Level is LV " & Party(partyNum).PTlevel & " and the party will gain a " & Party(partyNum).PTlevel & "% exp boost.", BrightGreen
            PartyMsg partyNum, "your Party Has reached the Max Level and will not level up any higher", BrightGreen
        Else
            PartyMsg partyNum, "Party Level Increased to LV " & Party(partyNum).PTlevel & " and the party will gain a " & Party(partyNum).PTlevel & "% exp boost.", BrightGreen
        End If
    End If

    exp = exp + Round(((exp / 100) * Party(partyNum).PTlevel))

    ' find out the equal share
    expShare = exp \ Party(partyNum).MemberCount
    leftOver = exp Mod Party(partyNum).MemberCount

    ' loop through and give everyone exp
    For i = 1 To MAX_PARTY_MEMBERS
        tmpIndex = Party(partyNum).Member(i)
        ' existing member?Kn
        If tmpIndex > 0 Then
            ' playing?
            If IsConnected(tmpIndex) And IsPlaying(tmpIndex) Then
                ' give them their share
                GivePlayerEXP tmpIndex, expShare
            End If
        End If
    Next

    ' give the remainder to a random member
    tmpIndex = Party(partyNum).Member(RAND(1, Party(partyNum).MemberCount))
    ' give the exp
    GivePlayerEXP tmpIndex, leftOver
End Sub

Public Sub GivePlayerEXP(ByVal index As Long, ByVal exp As Long)
    ' give the exp
    Call SetPlayerExp(index, GetPlayerExp(index) + exp)
    SendEXP index
    SendActionMsg GetPlayerMap(index), "+" & exp & " EXP", White, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
    ' check if we've leveled
    CheckPlayerLevelUp index
End Sub

```

[Grimnnak]

This is pretty sweet, thanks for the contribution.

[RyokuHasu]

thanks i try my best.

[bela1040]

thanks for tutorial, good script

[Prince]

Sorry i got this,

I a VB noob. I did all of your instruction.

[](http://www.freemmorpgmaker.com/files/imagehost/#a6d07097f9b7f6c3f32e2acf7a29c605.png)

Please help,
Prince

[erkro1]

@Prince:

> Sorry i got this,
>
> I a VB noob. I did all of your instruction.
>
> [](http://www.freemmorpgmaker.com/files/imagehost/#a6d07097f9b7f6c3f32e2acf7a29c605.png)
>
> Please help,
> Prince

Delete the other GetPlayerEXP

[MrKris]

Sweet stuff man, worked perfect for me.

[Antisora]

~~Great work, this is an epic feature to have~~
Never mind it failed me.

[RyokuHasu]

@Antisora:

> ~~Great work, this is an epic feature to have~~
> Never mind it failed me.

Dont know why it would have failed, it's a simple edit.

[Antisora]

@RyokuHasu:

> Dont know why it would have failed, it's a simple edit.

I got some error, and it destroyed my server :/

[RyokuHasu]

then either you didnt follow the directions exactly, or its another edit you used.

if you are a smart coder you would have backed up a copy of your server and stuff befor editing it, just recover it and try again, if you didnt, redownload Eclipse and copy over the areas I had you change.

[RyokuHasu]

Maby, maby not. But i dont have the time to blend them together and do extensive testing on it. =P sorry.

[RyokuHasu]

@Johnl17:

> Well maybe i can work mine out to work with yours, gonna go do that right now :)

Thanks, it would be a bit help if we dont have conflicting EXP systems, it would be way better if they work together. good luck with fixing yours.

and and it looks like you did have a few bugs in yours you might want to even out.

[SpiceyWolf]

DUDE i started reading title and it sounded stupid at first till i saw what u meant… AND THAT IDEA IS FREAKIN GENIUS!!! I dont know any game that has stuff like that!

[Bloodmorphed]

@SpiceyWolf:

> DUDE i started reading title and it sounded stupid at first till i saw what u meant… AND THAT IDEA IS FREAKIN GENIUS!!! I dont know any game that has stuff like that!

I can give you 1 example who does this (kinda)

World of warcraft. It doesn't have party levels exaCTLY… but you get an exp boost per member in the party. ^.^

Anyways, nice contribution

[erkro1]

It isn't orginal but its still a nice addition, so good job ;)

[Medleyy]

Awesome edit, works perfectly and makes an otherwise quite pointless feature into a really good one :)

[RyokuHasu]

XD I'm glad I looked at this.

That error about having 2 giveplayerEXP  was my fault. And I removed the accidental add-in.

there should be no problems with this now. =P

[Lee Evermore]

i looooove this! is there a way that you could stop idle players from gaining exp or maybe expel them from group after X amount of idle time?

also, could the players share quests (altar)?  like when i kill one monster on the quest, my party member gets the quest kill as well.

i hope i have not asked too much, but either way… thank you for this brilliant idea!

i havent played WoW but this is an awesome idea!  thank you!

[RyokuHasu]

Adding this to the top:

I HIGHLY recommend using this tut is you are going to use this system.

http://www.touchofdeathforums.com/smf2/index.php/topic,81073.0.html

[Whackeddie99]

JUST now downloaded brand new EOv2…all I see is this:

```
Sub HandleAcceptParty(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Party_InviteAccept TempPlayer(index).partyInvite, index
End Sub
```

[BlazingShadow]

@Purgatory:

> I can give you 1 example who does this (kinda)
>
> World of warcraft. It doesn't have party levels exaCTLY… but you get an exp boost per member in the party. ^.^
>
> Anyways, nice contribution

Just like to say, although a bonus is added to the total exp gain, something like 10%, the total exp (exp + 10%) is then shared between players, so overall you receive less experience each

On topic: nice idea

[zarz02]

Getting that error


[Dawntide]

I get this error too!

UPDATE:

I fixed the error by adding "**ByVal mapnum As Long**" back to Public Sub Party_ShareEXP. The writer of the tutorial removed it in the tutorial.

```
Public Sub Party_ShareExp(ByVal partyNum As Long, ByVal exp As Long, ByVal index As Long, ByVal mapnum As Long)
Dim expShare As Long, leftOver As Long, i As Long, tmpIndex As Long
```
Is this a legit fix or will it cause bugs in the party system?