DopeyBiach
-
Posts
81 -
Joined
-
Last visited
Never
Content Type
Profiles
Forums
Calendar
Posts posted by DopeyBiach
-
-
No, sorry. That doesn't move the text depending on the sprite's size.. That does it depending on the name 
EDIT: I have an idea, will tell you if it works. Keep the ideas coming until then :]
EDIT: It worked. Here's what I did.
Added a new object to the NPC Editor.
scrlSize and lblSize.
The procedure for scrlSize_Change() is as follwoed:
```
Private Sub scrlSize_Change()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo Errorhandler
lblSize.Caption = "Size: " & scrlSize.Value
Npc(EditorIndex).Size = scrlSize.Value
' Error handler
Exit Sub
Errorhandler:
HandleError "scrlSize_Change", "frmEditor_NPC", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```
Add this to NpcRec in ModTypes in the Server and Client - Just under 'Level as Long'
```
Size As Long
```
Add this to NPCEditorInit in modGameEditors just under '.scrlAnimation.Value = Npc(EditorIndex).Animation'
```
If Npc(EditorIndex).Size <= 0 or Npc(EditorIndex).Size > .scrlSize.Max Then
.Npc(EditorIndex).Size = 0
.scrlSize.Value = 0
Else
.scrlSize.Value = Npc(EditorIndex).Size
End If
```
Add:
```
Dim CenterShift As Long
```
Just under 'Dim npcNum as Long'
Just under:
```
Select Case Npc(npcNum).Behaviour
Case NPC_BEHAVIOUR_ATTACKONSIGHT
color = QBColor(White)
Case NPC_BEHAVIOUR_ATTACKWHENATTACKED
color = QBColor(Grey)
Case NPC_BEHAVIOUR_GUARD
color = QBColor(White)
Case Else
color = QBColor(White)
End Select
```
and above 'Npc = Trim$(Npc(npcNum).Name) add:
```
If Val(Npc(MapNpc(Index).num).Size) > 0 Then
If Val(Npc(MapNpc(Index).num).Size) = 1 Then
CenterShift = 0
ElseIf Val(Npc(MapNpc(Index).num).Size) = 2 Then
CenterShift = 16
End If
End If
```
Finally replace:
```
TextX = ConvertMapX(MapNpc(Index).X * PIC_X) + MapNpc(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(Name)))
```
With:
```
TextX = ConvertMapX(MapNpc(Index).X * PIC_X) + MapNpc(Index).XOffset + (PIC_X \ 2) - ((Len(Trim$(Npc(MapNpc(Index).num).Name)) / 2) * 8) + CenterShift
```
Zero, I used that bit of code you gave me aswell to make it work :]..
What this does is if the actual sprite's image width (not the entire block, like the transparency around it) is 64px then it centers the name nicely. When the size is set to 2 in the npc editor.. If it's a normal sprite, set it to 1 ^___^
I'm sure there was an easier way but meh. -
In the DrawNpcName precedure.. How would I go about getting it to center the drawn text.. Here's the annoying bit.. Depending on the NPC's sprite size.. Because bigger sprites text is always drawn on the left..
Thank you ^_____^ -
When you declare FONT_SIZE as 15 or any higher, the font seems to be no longer centered above the sprite.. Anyone know anything about this or how to fix it?.. Thanks
Nevermind.. I used a SIMPLE font, size set to 15.. Looks centered still and looks surprisingly nice. thanks for the tute :] -
Thanks for that, will keep it in mind.. My loops usually crash the prog.. And VB >_>
-
Ahh, I always try and avoid looping, I never seem to get it right :L.. Thanks :]
-
I've seen this line so many times and ignored it LOL.. So how would I change that so the order was from high to low? Sorry, last question I swear :L.. At least I'll know this in future.. Thanks again 
-
In what sub exactly does the rendering for mapitems take place.. If it's BltItem or Render_Graphics I can't see it.. Urggh, I'm tired lol..
-
I've looked there lol, I'm most likely missing something and it's bound to be something irritatingly obvious.
-
Thanks, I've looked for ages, but can't seem to find any relative coding, will have a further scan 
-
When there is more than one item on the same spot on the map and you pick the item up.. It picks up the bottom item first? I can't seem to find the code to change this anywhere  .. So say if your standing on a log and a fish.. The log is UNDERNEATH the fish.. However you still pick up the log first.. How do I change this? Thanks.
-
@Fuu:
> I assumed you've seen me post, and had seen my grammar before. Apparently I was wrong.
> Also, if someone had given me advice and had grammar like that, I'd still consider and likely take it.
With that said, I apologize. I have a tendency to ignore the meaning (for lack of a better word) of posts that sound remotely troll-like. Thanks for the advice and I'll try not to pass judgement as quickly in future :P. -
@Fuu:
> Oh? He gets a thanks for saying the same thing I did?
> I honestly thought you put a black and white layer over your GUI to have no one steal it.
> When I saw the colored screen shot, I realized it was just a bunch of gray shades.
>
> Its really dark, and unattractive.
> Color brings things to life.
You got a thanks for saying the same thing he did aswell, also he spoke in a non-engrish-troll-like language which made me want to take his advice a bit more, also I answered your post if you scroll up and if you compare my first GUI with my second you'll see improvements (they really were JUST grey squares). Thanks for writing more than a four-syllable engrish comment this time, and maybe I'll listen more in future if you do. Once again, cheers. -
@LegendWeaver:
> Nice for your 2nd GUI…now add some colors. If you do it right it won't be distracting. :)
Will experiment with the colours abit.. Thanks :D -
@Jungle:
> …did you just reply to your own post?
>
> I like the GUI, I don't know what everyone else is saying. Very clean and simple.
LOL! Edited.. Fatigue makes you do weird things..
Thanks :] -
@Fuu:
> needmoarcolor
I thought that but noticed with an interface of this size it's way too distracting when your playing the game and it just sits in the corner of your eye, this way you notice it when you want to, in my personal opinions, thanks for the reply though :D -
@Her0â„¢:
> Looks great, I like it all. Looks sleek.
Thanks :D..
I started with a bunch of grey squares in PS lool x] -
@bestthaibb:
> i need that kind of character but i do not know how to call it?? can somebody help me??
Eh..? -
Sorry the speed is perfect the way it is, it was something that I did not you did. But what you told me got the movement abit faster and perfect anyway, I haven't been able to reply on here because my internet's credit was out, cheers again Lightning I LOVE this system :D
-
Old. Remove Plez?
-
_…re-writes and polishes source code._
Thank you so much!! :]
Wish I could repay you for the system, buh I fail at VB :P
Thanks again ^____^
EDIT: It's perfect on a large map now, but buzzes around the screen at 200mph on a small map, im slowly getting there after playing about with it, but id rather a pet road runner than a pet rock lul.
EDIT AGAIN: Maaaaybe.. If I made a new npc behaviour called 'Pet' I could speed it up that way.. Maybe :o
Thank you sooo much :D -
First of I would like to say THANK YOU Lightning.. Ive been waiting to use this amazing system for a LONG time, and it's everything I wanted it to be and more.. All I need to make it perfect is..
My pet to walk faster than a house :P
I've tried a few things like in the NPC Movement part
```
Select Case MapNpc(MapNpcNum).Dir
Case DIR_UP
If MapNpc(MapNpcNum).IsPet Then
MapNpc(MapNpcNum).YOffset = MapNpc(MapNpcNum).YOffset - ((ElapsedTime / 1000) * (RUN_SPEED * SIZE_X))
Else
If MapNpc(MapNpcNum).YOffset < 0 Then MapNpc(MapNpcNum).YOffset = 0
MapNpc(MapNpcNum).YOffset = MapNpc(MapNpcNum).YOffset - ((ElapsedTime / 1000) * (WALK_SPEED * SIZE_X))
```
But.. Obviously it didn't work.. But hopefully you'll see what I'm trying to achieve and help me out? Thanks again everyone :D -
Found the solution..
I put:
```
Public Type PetCache
Pet(1 To MAX_MAP_NPCS) As Long
UpperBound As Long
End Type
Public PetMapCache(1 To MAX_MAPS) As PetCache
```
Under:
```
Option Explicit
```
In the top of ModGameLogic..
Thanks everyone who helped :] -
And the last little bit ^^:
```
Select Case .Direction
' down
Case DIR_DOWN
.y = .y + 1
' check if they reached maxrange
If .y = (GetPlayerY(index) + .Range) + 1 Then ClearProjectile index, PlayerProjectile: Exit Sub
' up
Case DIR_UP
.y = .y - 1
' check if they reached maxrange
If .y = (GetPlayerY(index) - .Range) - 1 Then ClearProjectile index, PlayerProjectile: Exit Sub
' right
Case DIR_RIGHT
.x = .x + 1
' check if they reached max range
If .x = (GetPlayerX(index) + .Range) + 1 Then ClearProjectile index, PlayerProjectile: Exit Sub
' left
Case DIR_LEFT
.x = .x - 1
' check if they reached maxrange
If .x = (GetPlayerX(index) - .Range) - 1 Then ClearProjectile index, PlayerProjectile: Exit Sub
End Select
.TravelTime = GetTickCount + .Speed
End With
End If
x = TempPlayer(index).ProjecTile(PlayerProjectile).x
y = TempPlayer(index).ProjecTile(PlayerProjectile).y
' check if left map
If x > Map(GetPlayerMap(index)).MaxX Or y > Map(GetPlayerMap(index)).MaxY Or x < 0 Or y < 0 Then
ClearProjectile index, PlayerProjectile
Exit Sub
End If
' check if hit player
For i = 1 To Player_HighIndex
' make sure they're actually playing
If IsPlaying(i) Then
' check coordinates
If x = Player(i).x And y = GetPlayerY(i) Then
' make sure it's not the attacker
If Not x = Player(index).x Or Not y = GetPlayerY(index) Then
' check if player can attack
If CanPlayerAttackPlayer(index, i, False, True) = True Then
' attack the player and kill the project tile
PlayerAttackPlayer index, i, TempPlayer(index).ProjecTile(PlayerProjectile).Damage
ClearProjectile index, PlayerProjectile
Exit Sub
Else
ClearProjectile index, PlayerProjectile
Exit Sub
End If
End If
End If
End If
Next
' check for npc hit
For i = 1 To MAX_MAP_NPCS
If x = MapNpc(GetPlayerMap(index)).NPC(i).x And y = MapNpc(GetPlayerMap(index)).NPC(i).y Then
' they're hit, remove it and deal that damage ;)
If CanPlayerAttackNpc(index, i, True) Then
PlayerAttackNpc index, i, TempPlayer(index).ProjecTile(PlayerProjectile).Damage
ClearProjectile index, PlayerProjectile
Exit Sub
Else
ClearProjectile index, PlayerProjectile
Exit Sub
End If
End If
Next
' hit a block
If Map(GetPlayerMap(index)).Tile(x, y).Type = TILE_TYPE_BLOCKED Then
' hit a block, clear it.
ClearProjectile index, PlayerProjectile
Exit Sub
End If
End Sub
'makes the pet follow its owner
Sub PetFollowOwner(ByVal index As Long)
If TempPlayer(index).TempPetSlot < 1 Then Exit Sub
MapNpc(GetPlayerMap(index)).NPC(TempPlayer(index).TempPetSlot).targetType = 1
MapNpc(GetPlayerMap(index)).NPC(TempPlayer(index).TempPetSlot).target = index
End Sub
'makes the pet wander around the map
Sub PetWander(ByVal index As Long)
If TempPlayer(index).TempPetSlot < 1 Then Exit Sub
MapNpc(GetPlayerMap(index)).NPC(TempPlayer(index).TempPetSlot).targetType = TARGET_TYPE_NONE
MapNpc(GetPlayerMap(index)).NPC(TempPlayer(index).TempPetSlot).target = 0
End Sub
Public PetMapCache(1 To MAX_MAPS) As PetCache
Public Type PetCache
Pet(1 To MAX_MAP_NPCS) As Long
UpperBound As Long
End Type
Sub PetDisband(ByVal index As Long, ByVal MapNum As Long)
Dim i As Long, j As Long
If TempPlayer(index).TempPetSlot < 1 Then Exit Sub
'Cache the Pets for players logging on [Remove Number from array]
'THIS IS KINDA SLOW (EVEN WITHOUT TESTING, LOL), MAY HAVE TO CONVERT TO LINKED LIST FOR SPEED
For i = 1 To PetMapCache(MapNum).UpperBound
If PetMapCache(MapNum).Pet(i) = TempPlayer(index).TempPetSlot Then
If PetMapCache(MapNum).UpperBound > 1 Then
For j = PetMapCache(MapNum).UpperBound To i Step -1
PetMapCache(MapNum).Pet(j - 1) = PetMapCache(MapNum).Pet(j)
Next
Else
PetMapCache(MapNum).Pet(1) = 0
End If
PetMapCache(MapNum).UpperBound = PetMapCache(MapNum).UpperBound - 1
Exit For
End If
Next
Call ClearSingleMapNpc(TempPlayer(index).TempPetSlot, MapNum)
Map(GetPlayerMap(index)).NPC(TempPlayer(index).TempPetSlot) = 0
TempPlayer(index).TempPetSlot = 0
're-warp the players on the map
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
If GetPlayerMap(i) = GetPlayerMap(index) Then
Call PlayerWarp(i, GetPlayerMap(i), GetPlayerX(i), GetPlayerY(i))
SendPlayerData index
End If
End If
Next
End Sub
Sub SpawnPet(ByVal index As Long, ByVal MapNum As Long)
Dim PlayerMap As Long
Dim i As Integer
Dim PetSlot As Byte
'Prevent multiple pets for the same owner
If TempPlayer(index).TempPetSlot > 0 Then Exit Sub
PlayerMap = GetPlayerMap(index)
PetSlot = 0
For i = 1 To MAX_MAP_NPCS
'If Map(PlayerMap).Npc(i) = 0 Then
If MapNpc(PlayerMap).NPC(i).SpawnWait = 0 And MapNpc(PlayerMap).NPC(i).Num = 0 Then
PetSlot = i
Exit For
End If
Next
If PetSlot = 0 Then
Call PlayerMsg(index, "The map is too crowded for you to call on your pet!", Red)
Exit Sub
End If
'create the pet for the map
Map(PlayerMap).NPC(PetSlot) = 1
MapNpc(PlayerMap).NPC(PetSlot).Num = 1
'set its Pet Data
MapNpc(PlayerMap).NPC(PetSlot).IsPet = YES
MapNpc(PlayerMap).NPC(PetSlot).PetData.Name = GetPlayerName(index) & "'s " & NPC(1).Name
MapNpc(PlayerMap).NPC(PetSlot).PetData.Owner = index
'If Pet doesn't exist with player, link it to the player
If Player(index).Pet.SpriteNum <> 1 Then
Player(index).Pet.SpriteNum = 1
Player(index).Pet.Name = GetPlayerName(index) & "'s " & NPC(1).Name
End If
TempPlayer(index).TempPetSlot = PetSlot
'cache the map for sending
Call MapCache_Create(PlayerMap)
'Cache the Pets for players logging on [Add new Number to array]
PetMapCache(PlayerMap).UpperBound = PetMapCache(PlayerMap).UpperBound + 1
PetMapCache(PlayerMap).Pet(PetMapCache(PlayerMap).UpperBound) = PetSlot
If PetMapCache(Player(index).Map).UpperBound > 0 Then
For i = 1 To PetMapCache(Player(index).Map).UpperBound
Call NPCCache_Create(index, Player(index).Map, PetMapCache(Player(index).Map).Pet(i))
Next
End If
Select Case GetPlayerDir(index)
Case DIR_UP
Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) - 1)
Case DIR_DOWN
Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) + 1)
Case DIR_LEFT
Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index) + 1, GetPlayerY(index))
Case DIR_RIGHT
Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) - 1)
End Select
're-warp the players on the map
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
If GetPlayerMap(i) = GetPlayerMap(index) Then
Call PlayerWarp(i, PlayerMap, GetPlayerX(i), GetPlayerY(i))
End If
End If
Next
End Sub
``` -
Oh.. Oops O.O, once again cheers and here you go :]..
```
Option Explicit
Function FindOpenPlayerSlot() As Long
Dim i As Long
FindOpenPlayerSlot = 0
For i = 1 To MAX_PLAYERS
If Not IsConnected(i) Then
FindOpenPlayerSlot = i
Exit Function
End If
Next
End Function
Function FindOpenMapItemSlot(ByVal MapNum As Long) As Long
Dim i As Long
FindOpenMapItemSlot = 0
' Check for subscript out of range
If MapNum <= 0 Or MapNum > MAX_MAPS Then
Exit Function
End If
For i = 1 To MAX_MAP_ITEMS
If MapItem(MapNum, i).Num = 0 Then
FindOpenMapItemSlot = i
Exit Function
End If
Next
End Function
Function TotalOnlinePlayers() As Long
Dim i As Long
TotalOnlinePlayers = 0
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
TotalOnlinePlayers = TotalOnlinePlayers + 1
End If
Next
End Function
Function FindPlayer(ByVal Name As String) As Long
Dim i As Long
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
' Make sure we dont try to check a name thats to small
If Len(GetPlayerName(i)) >= Len(Trim$(Name)) Then
If UCase$(Mid$(GetPlayerName(i), 1, Len(Trim$(Name)))) = UCase$(Trim$(Name)) Then
FindPlayer = i
Exit Function
End If
End If
End If
Next
FindPlayer = 0
End Function
Sub SpawnItem(ByVal itemnum As Long, ByVal ItemVal As Long, ByVal MapNum As Long, ByVal x As Long, ByVal y As Long, Optional ByVal playerName As String = vbNullString)
Dim i As Long
' Check for subscript out of range
If itemnum < 1 Or itemnum > MAX_ITEMS Or MapNum <= 0 Or MapNum > MAX_MAPS Then
Exit Sub
End If
' Find open map item slot
i = FindOpenMapItemSlot(MapNum)
Call SpawnItemSlot(i, itemnum, ItemVal, MapNum, x, y, playerName)
End Sub
Sub SpawnItemSlot(ByVal MapItemSlot As Long, ByVal itemnum As Long, ByVal ItemVal As Long, ByVal MapNum As Long, ByVal x As Long, ByVal y As Long, Optional ByVal playerName As String = vbNullString, Optional ByVal canDespawn As Boolean = True)
Dim packet As String
Dim i As Long
Dim Buffer As clsBuffer
' Check for subscript out of range
If MapItemSlot <= 0 Or MapItemSlot > MAX_MAP_ITEMS Or itemnum < 0 Or itemnum > MAX_ITEMS Or MapNum <= 0 Or MapNum > MAX_MAPS Then
Exit Sub
End If
i = MapItemSlot
If i <> 0 Then
If itemnum >= 0 And itemnum <= MAX_ITEMS Then
MapItem(MapNum, i).playerName = playerName
MapItem(MapNum, i).playerTimer = GetTickCount + ITEM_SPAWN_TIME
MapItem(MapNum, i).canDespawn = canDespawn
MapItem(MapNum, i).despawnTimer = GetTickCount + ITEM_DESPAWN_TIME
MapItem(MapNum, i).Num = itemnum
MapItem(MapNum, i).Value = ItemVal
MapItem(MapNum, i).x = x
MapItem(MapNum, i).y = y
' send to map
SendSpawnItemToMap MapNum, i
End If
End If
End Sub
Sub SpawnAllMapsItems()
Dim i As Long
For i = 1 To MAX_MAPS
Call SpawnMapItems(i)
Next
End Sub
Sub SpawnMapItems(ByVal MapNum As Long)
Dim x As Long
Dim y As Long
' Check for subscript out of range
If MapNum <= 0 Or MapNum > MAX_MAPS Then
Exit Sub
End If
' Spawn what we have
For x = 0 To Map(MapNum).MaxX
For y = 0 To Map(MapNum).MaxY
' Check if the tile type is an item or a saved tile incase someone drops something
If (Map(MapNum).Tile(x, y).Type = TILE_TYPE_ITEM) Then
' Check to see if its a currency and if they set the value to 0 set it to 1 automatically
If Item(Map(MapNum).Tile(x, y).Data1).Type = ITEM_TYPE_CURRENCY And Map(MapNum).Tile(x, y).Data2 <= 0 Then
Call SpawnItem(Map(MapNum).Tile(x, y).Data1, 1, MapNum, x, y)
Else
Call SpawnItem(Map(MapNum).Tile(x, y).Data1, Map(MapNum).Tile(x, y).Data2, MapNum, x, y)
End If
End If
Next
Next
End Sub
Function Random(ByVal Low As Long, ByVal High As Long) As Long
Random = ((High - Low + 1) * Rnd) + Low
End Function
Public Sub SpawnNpc(ByVal mapNpcNum As Long, ByVal MapNum As Long, Optional ByVal SetX As Long, Optional ByVal SetY As Long)
Dim Buffer As clsBuffer
Dim NPCNum As Long
Dim i As Long
Dim x As Long
Dim y As Long
Dim Spawned As Boolean
' Check for subscript out of range
If mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or MapNum <= 0 Or MapNum > MAX_MAPS Then Exit Sub
NPCNum = Map(MapNum).NPC(mapNpcNum)
If NPCNum > 0 Then
MapNpc(MapNum).NPC(mapNpcNum).Num = NPCNum
MapNpc(MapNum).NPC(mapNpcNum).target = 0
MapNpc(MapNum).NPC(mapNpcNum).targetType = 0 ' clear
MapNpc(MapNum).NPC(mapNpcNum).Vital(Vitals.HP) = GetNpcMaxVital(NPCNum, Vitals.HP)
MapNpc(MapNum).NPC(mapNpcNum).Vital(Vitals.MP) = GetNpcMaxVital(NPCNum, Vitals.MP)
MapNpc(MapNum).NPC(mapNpcNum).Dir = Int(Rnd * 4)
'Check if theres a spawn tile for the specific npc
For x = 0 To Map(MapNum).MaxX
For y = 0 To Map(MapNum).MaxY
If Map(MapNum).Tile(x, y).Type = TILE_TYPE_NPCSPAWN Then
If Map(MapNum).Tile(x, y).Data1 = mapNpcNum Then
MapNpc(MapNum).NPC(mapNpcNum).x = x
MapNpc(MapNum).NPC(mapNpcNum).y = y
MapNpc(MapNum).NPC(mapNpcNum).Dir = Map(MapNum).Tile(x, y).Data2
Spawned = True
Exit For
End If
End If
Next y
Next x
If Not Spawned Then
' Well try 100 times to randomly place the sprite
For i = 1 To 100
If SetX = 0 And SetY = 0 Then
x = Random(0, Map(MapNum).MaxX)
y = Random(0, Map(MapNum).MaxY)
Else
x = SetX
y = SetY
End If
If x > Map(MapNum).MaxX Then x = Map(MapNum).MaxX
If y > Map(MapNum).MaxY Then y = Map(MapNum).MaxY
' Check if the tile is walkable
If NpcTileIsOpen(MapNum, x, y) Then
MapNpc(MapNum).NPC(mapNpcNum).x = x
MapNpc(MapNum).NPC(mapNpcNum).y = y
Spawned = True
Exit For
End If
Next
End If
' Didn't spawn, so now we'll just try to find a free tile
If Not Spawned Then
For x = 0 To Map(MapNum).MaxX
For y = 0 To Map(MapNum).MaxY
If NpcTileIsOpen(MapNum, x, y) Then
MapNpc(MapNum).NPC(mapNpcNum).x = x
MapNpc(MapNum).NPC(mapNpcNum).y = y
Spawned = True
End If
Next
Next
End If
' If we suceeded in spawning then send it to everyone
If Spawned Then
Set Buffer = New clsBuffer
Buffer.WriteLong SSpawnNpc
Buffer.WriteLong mapNpcNum
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).Num
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).x
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).y
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).Dir
Buffer.WriteByte MapNpc(MapNum).NPC(mapNpcNum).IsPet
Buffer.WriteString MapNpc(MapNum).NPC(mapNpcNum).PetData.Name
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).PetData.Owner
SendDataToMap MapNum, Buffer.ToArray()
Set Buffer = Nothing
End If
SendMapNpcVitals MapNum, mapNpcNum
End If
End Sub
Public Function NpcTileIsOpen(ByVal MapNum As Long, ByVal x As Long, ByVal y As Long) As Boolean
Dim LoopI As Long
NpcTileIsOpen = True
If PlayersOnMap(MapNum) Then
For LoopI = 1 To Player_HighIndex
If GetPlayerMap(LoopI) = MapNum Then
If GetPlayerX(LoopI) = x Then
If GetPlayerY(LoopI) = y Then
NpcTileIsOpen = False
Exit Function
End If
End If
End If
Next
End If
For LoopI = 1 To MAX_MAP_NPCS
If MapNpc(MapNum).NPC(LoopI).Num > 0 Then
If MapNpc(MapNum).NPC(LoopI).x = x Then
If MapNpc(MapNum).NPC(LoopI).y = y Then
NpcTileIsOpen = False
Exit Function
End If
End If
End If
Next
If Map(MapNum).Tile(x, y).Type <> TILE_TYPE_WALKABLE Then
If Map(MapNum).Tile(x, y).Type <> TILE_TYPE_NPCSPAWN Then
If Map(MapNum).Tile(x, y).Type <> TILE_TYPE_ITEM Then
NpcTileIsOpen = False
End If
End If
End If
End Function
Sub SpawnMapNpcs(ByVal MapNum As Long)
Dim i As Long
For i = 1 To MAX_MAP_NPCS
Call SpawnNpc(i, MapNum)
Next
End Sub
Sub SpawnAllMapNpcs()
Dim i As Long
For i = 1 To MAX_MAPS
Call SpawnMapNpcs(i)
Next
End Sub
Function CanNpcMove(ByVal MapNum As Long, ByVal mapNpcNum As Long, ByVal Dir As Byte) As Boolean
Dim i As Long
Dim n As Long
Dim x As Long
Dim y As Long
' Check for subscript out of range
If MapNum <= 0 Or MapNum > MAX_MAPS Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or Dir < DIR_UP Or Dir > DIR_RIGHT Then
Exit Function
End If
x = MapNpc(MapNum).NPC(mapNpcNum).x
y = MapNpc(MapNum).NPC(mapNpcNum).y
CanNpcMove = True
Select Case Dir
Case DIR_UP
' Check to make sure not outside of boundries
If y > 0 Then
n = Map(MapNum).Tile(x, y - 1).Type
' Check to make sure that the tile is walkable
If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
CanNpcMove = False
Exit Function
End If
' Check to make sure that there is not a player in the way
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
If (GetPlayerMap(i) = MapNum) And (GetPlayerX(i) = MapNpc(MapNum).NPC(mapNpcNum).x) And (GetPlayerY(i) = MapNpc(MapNum).NPC(mapNpcNum).y - 1) Then
CanNpcMove = False
Exit Function
End If
End If
Next
' Check to make sure that there is not another npc in the way
For i = 1 To MAX_MAP_NPCS
If (i <> mapNpcNum) And (MapNpc(MapNum).NPC(i).Num > 0) And (MapNpc(MapNum).NPC(i).x = MapNpc(MapNum).NPC(mapNpcNum).x) And (MapNpc(MapNum).NPC(i).y = MapNpc(MapNum).NPC(mapNpcNum).y - 1) Then
CanNpcMove = False
Exit Function
End If
Next
' Directional blocking
If isDirBlocked(Map(MapNum).Tile(MapNpc(MapNum).NPC(mapNpcNum).x, MapNpc(MapNum).NPC(mapNpcNum).y).DirBlock, DIR_UP + 1) Then
CanNpcMove = False
Exit Function
End If
Else
CanNpcMove = False
End If
Case DIR_DOWN
' Check to make sure not outside of boundries
If y < Map(MapNum).MaxY Then
n = Map(MapNum).Tile(x, y + 1).Type
' Check to make sure that the tile is walkable
If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
CanNpcMove = False
Exit Function
End If
' Check to make sure that there is not a player in the way
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
If (GetPlayerMap(i) = MapNum) And (GetPlayerX(i) = MapNpc(MapNum).NPC(mapNpcNum).x) And (GetPlayerY(i) = MapNpc(MapNum).NPC(mapNpcNum).y + 1) Then
CanNpcMove = False
Exit Function
End If
End If
Next
' Check to make sure that there is not another npc in the way
For i = 1 To MAX_MAP_NPCS
If (i <> mapNpcNum) And (MapNpc(MapNum).NPC(i).Num > 0) And (MapNpc(MapNum).NPC(i).x = MapNpc(MapNum).NPC(mapNpcNum).x) And (MapNpc(MapNum).NPC(i).y = MapNpc(MapNum).NPC(mapNpcNum).y + 1) Then
CanNpcMove = False
Exit Function
End If
Next
' Directional blocking
If isDirBlocked(Map(MapNum).Tile(MapNpc(MapNum).NPC(mapNpcNum).x, MapNpc(MapNum).NPC(mapNpcNum).y).DirBlock, DIR_DOWN + 1) Then
CanNpcMove = False
Exit Function
End If
Else
CanNpcMove = False
End If
Case DIR_LEFT
' Check to make sure not outside of boundries
If x > 0 Then
n = Map(MapNum).Tile(x - 1, y).Type
' Check to make sure that the tile is walkable
If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
CanNpcMove = False
Exit Function
End If
' Check to make sure that there is not a player in the way
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
If (GetPlayerMap(i) = MapNum) And (GetPlayerX(i) = MapNpc(MapNum).NPC(mapNpcNum).x - 1) And (GetPlayerY(i) = MapNpc(MapNum).NPC(mapNpcNum).y) Then
CanNpcMove = False
Exit Function
End If
End If
Next
' Check to make sure that there is not another npc in the way
For i = 1 To MAX_MAP_NPCS
If (i <> mapNpcNum) And (MapNpc(MapNum).NPC(i).Num > 0) And (MapNpc(MapNum).NPC(i).x = MapNpc(MapNum).NPC(mapNpcNum).x - 1) And (MapNpc(MapNum).NPC(i).y = MapNpc(MapNum).NPC(mapNpcNum).y) Then
CanNpcMove = False
Exit Function
End If
Next
' Directional blocking
If isDirBlocked(Map(MapNum).Tile(MapNpc(MapNum).NPC(mapNpcNum).x, MapNpc(MapNum).NPC(mapNpcNum).y).DirBlock, DIR_LEFT + 1) Then
CanNpcMove = False
Exit Function
End If
Else
CanNpcMove = False
End If
Case DIR_RIGHT
' Check to make sure not outside of boundries
If x < Map(MapNum).MaxX Then
n = Map(MapNum).Tile(x + 1, y).Type
' Check to make sure that the tile is walkable
If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
CanNpcMove = False
Exit Function
End If
' Check to make sure that there is not a player in the way
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
If (GetPlayerMap(i) = MapNum) And (GetPlayerX(i) = MapNpc(MapNum).NPC(mapNpcNum).x + 1) And (GetPlayerY(i) = MapNpc(MapNum).NPC(mapNpcNum).y) Then
CanNpcMove = False
Exit Function
End If
End If
Next
' Check to make sure that there is not another npc in the way
For i = 1 To MAX_MAP_NPCS
If (i <> mapNpcNum) And (MapNpc(MapNum).NPC(i).Num > 0) And (MapNpc(MapNum).NPC(i).x = MapNpc(MapNum).NPC(mapNpcNum).x + 1) And (MapNpc(MapNum).NPC(i).y = MapNpc(MapNum).NPC(mapNpcNum).y) Then
CanNpcMove = False
Exit Function
End If
Next
' Directional blocking
If isDirBlocked(Map(MapNum).Tile(MapNpc(MapNum).NPC(mapNpcNum).x, MapNpc(MapNum).NPC(mapNpcNum).y).DirBlock, DIR_RIGHT + 1) Then
CanNpcMove = False
Exit Function
End If
Else
CanNpcMove = False
End If
End Select
End Function
Sub NpcMove(ByVal MapNum As Long, ByVal mapNpcNum As Long, ByVal Dir As Long, ByVal movement As Long)
Dim packet As String
Dim Buffer As clsBuffer
' Check for subscript out of range
If MapNum <= 0 Or MapNum > MAX_MAPS Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or Dir < DIR_UP Or Dir > DIR_RIGHT Or movement < 1 Or movement > 2 Then
Exit Sub
End If
MapNpc(MapNum).NPC(mapNpcNum).Dir = Dir
Select Case Dir
Case DIR_UP
MapNpc(MapNum).NPC(mapNpcNum).y = MapNpc(MapNum).NPC(mapNpcNum).y - 1
Set Buffer = New clsBuffer
Buffer.WriteLong SNpcMove
Buffer.WriteLong mapNpcNum
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).x
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).y
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).Dir
Buffer.WriteLong movement
SendDataToMap MapNum, Buffer.ToArray()
Set Buffer = Nothing
Case DIR_DOWN
MapNpc(MapNum).NPC(mapNpcNum).y = MapNpc(MapNum).NPC(mapNpcNum).y + 1
Set Buffer = New clsBuffer
Buffer.WriteLong SNpcMove
Buffer.WriteLong mapNpcNum
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).x
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).y
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).Dir
Buffer.WriteLong movement
SendDataToMap MapNum, Buffer.ToArray()
Set Buffer = Nothing
Case DIR_LEFT
MapNpc(MapNum).NPC(mapNpcNum).x = MapNpc(MapNum).NPC(mapNpcNum).x - 1
Set Buffer = New clsBuffer
Buffer.WriteLong SNpcMove
Buffer.WriteLong mapNpcNum
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).x
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).y
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).Dir
Buffer.WriteLong movement
SendDataToMap MapNum, Buffer.ToArray()
Set Buffer = Nothing
Case DIR_RIGHT
MapNpc(MapNum).NPC(mapNpcNum).x = MapNpc(MapNum).NPC(mapNpcNum).x + 1
Set Buffer = New clsBuffer
Buffer.WriteLong SNpcMove
Buffer.WriteLong mapNpcNum
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).x
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).y
Buffer.WriteLong MapNpc(MapNum).NPC(mapNpcNum).Dir
Buffer.WriteLong movement
SendDataToMap MapNum, Buffer.ToArray()
Set Buffer = Nothing
End Select
End Sub
Sub NpcDir(ByVal MapNum As Long, ByVal mapNpcNum As Long, ByVal Dir As Long)
Dim packet As String
Dim Buffer As clsBuffer
' Check for subscript out of range
If MapNum <= 0 Or MapNum > MAX_MAPS Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or Dir < DIR_UP Or Dir > DIR_RIGHT Then
Exit Sub
End If
MapNpc(MapNum).NPC(mapNpcNum).Dir = Dir
Set Buffer = New clsBuffer
Buffer.WriteLong SNpcDir
Buffer.WriteLong mapNpcNum
Buffer.WriteLong Dir
SendDataToMap MapNum, Buffer.ToArray()
Set Buffer = Nothing
End Sub
Function GetTotalMapPlayers(ByVal MapNum As Long) As Long
Dim i As Long
Dim n As Long
n = 0
For i = 1 To Player_HighIndex
If IsPlaying(i) And GetPlayerMap(i) = MapNum Then
n = n + 1
End If
Next
GetTotalMapPlayers = n
End Function
Sub ClearTempTiles()
Dim i As Long
For i = 1 To MAX_MAPS
ClearTempTile i
Next
End Sub
Sub ClearTempTile(ByVal MapNum As Long)
Dim y As Long
Dim x As Long
TempTile(MapNum).DoorTimer = 0
ReDim TempTile(MapNum).DoorOpen(0 To Map(MapNum).MaxX, 0 To Map(MapNum).MaxY)
For x = 0 To Map(MapNum).MaxX
For y = 0 To Map(MapNum).MaxY
TempTile(MapNum).DoorOpen(x, y) = NO
Next
Next
End Sub
Public Sub CacheResources(ByVal MapNum As Long)
Dim x As Long, y As Long, Resource_Count As Long
Resource_Count = 0
For x = 0 To Map(MapNum).MaxX
For y = 0 To Map(MapNum).MaxY
If Map(MapNum).Tile(x, y).Type = TILE_TYPE_RESOURCE Then
Resource_Count = Resource_Count + 1
ReDim Preserve ResourceCache(MapNum).ResourceData(0 To Resource_Count)
ResourceCache(MapNum).ResourceData(Resource_Count).x = x
ResourceCache(MapNum).ResourceData(Resource_Count).y = y
ResourceCache(MapNum).ResourceData(Resource_Count).cur_health = Resource(Map(MapNum).Tile(x, y).Data1).health
End If
Next
Next
ResourceCache(MapNum).Resource_Count = Resource_Count
End Sub
Sub PlayerSwitchBankSlots(ByVal index As Long, ByVal oldSlot As Long, ByVal newSlot As Long)
Dim OldNum As Long
Dim OldValue As Long
Dim NewNum As Long
Dim NewValue As Long
If oldSlot = 0 Or newSlot = 0 Then
Exit Sub
End If
OldNum = GetPlayerBankItemNum(index, oldSlot)
OldValue = GetPlayerBankItemValue(index, oldSlot)
NewNum = GetPlayerBankItemNum(index, newSlot)
NewValue = GetPlayerBankItemValue(index, newSlot)
SetPlayerBankItemNum index, newSlot, OldNum
SetPlayerBankItemValue index, newSlot, OldValue
SetPlayerBankItemNum index, oldSlot, NewNum
SetPlayerBankItemValue index, oldSlot, NewValue
SendBank index
End Sub
Sub PlayerSwitchInvSlots(ByVal index As Long, ByVal oldSlot As Long, ByVal newSlot As Long)
Dim OldNum As Long
Dim OldValue As Long
Dim NewNum As Long
Dim NewValue As Long
If oldSlot = 0 Or newSlot = 0 Then
Exit Sub
End If
OldNum = GetPlayerInvItemNum(index, oldSlot)
OldValue = GetPlayerInvItemValue(index, oldSlot)
NewNum = GetPlayerInvItemNum(index, newSlot)
NewValue = GetPlayerInvItemValue(index, newSlot)
SetPlayerInvItemNum index, newSlot, OldNum
SetPlayerInvItemValue index, newSlot, OldValue
SetPlayerInvItemNum index, oldSlot, NewNum
SetPlayerInvItemValue index, oldSlot, NewValue
SendInventory index
End Sub
Sub PlayerSwitchSpellSlots(ByVal index As Long, ByVal oldSlot As Long, ByVal newSlot As Long)
Dim OldNum As Long
Dim NewNum As Long
If oldSlot = 0 Or newSlot = 0 Then
Exit Sub
End If
OldNum = GetPlayerSpell(index, oldSlot)
NewNum = GetPlayerSpell(index, newSlot)
SetPlayerSpell index, oldSlot, NewNum
SetPlayerSpell index, newSlot, OldNum
SendPlayerSpells index
End Sub
Sub PlayerUnequipItem(ByVal index As Long, ByVal EqSlot As Long)
If EqSlot <= 0 Or EqSlot > Equipment.Equipment_Count - 1 Then Exit Sub ' exit out early if error'd
If FindOpenInvSlot(index, GetPlayerEquipment(index, EqSlot)) > 0 Then
GiveInvItem index, GetPlayerEquipment(index, EqSlot), 0
PlayerMsg index, "You unequip " & CheckGrammar(Item(GetPlayerEquipment(index, EqSlot)).Name), Yellow
' send the sound
SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, GetPlayerEquipment(index, EqSlot)
' remove equipment
SetPlayerEquipment index, 0, EqSlot
SendWornEquipment index
SendMapEquipment index
SendStats index
' send vitals
Call SendVital(index, Vitals.HP)
Call SendVital(index, Vitals.MP)
' send vitals to party if in one
If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
Else
PlayerMsg index, "Your inventory is full.", BrightRed
End If
End Sub
Public Function CheckGrammar(ByVal Word As String, Optional ByVal Caps As Byte = 0) As String
Dim FirstLetter As String * 1
FirstLetter = LCase$(Left$(Word, 1))
If FirstLetter = "$" Then
CheckGrammar = (Mid$(Word, 2, Len(Word) - 1))
Exit Function
End If
If FirstLetter Like "*[aeiou]*" Then
If Caps Then CheckGrammar = "An " & Word Else CheckGrammar = "an " & Word
Else
If Caps Then CheckGrammar = "A " & Word Else CheckGrammar = "a " & Word
End If
End Function
Function isInRange(ByVal Range As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Boolean
Dim nVal As Long
isInRange = False
nVal = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
If nVal <= Range Then isInRange = True
End Function
Public Function isDirBlocked(ByRef blockvar As Byte, ByRef Dir As Byte) As Boolean
If Not blockvar And (2 ^ Dir) Then
isDirBlocked = False
Else
isDirBlocked = True
End If
End Function
Public Function RAND(ByVal Low As Long, ByVal High As Long) As Long
Randomize
RAND = Int((High - Low + 1) * Rnd) + Low
End Function
' #####################
' ## Party functions ##
' #####################
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
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
Public Sub Party_Invite(ByVal index As Long, ByVal targetPlayer As Long)
Dim partyNum As Long, i As Long
' check if the person is a valid target
If Not IsConnected(targetPlayer) Or Not IsPlaying(targetPlayer) Then Exit Sub
' make sure they're not busy
If TempPlayer(targetPlayer).partyInvite > 0 Or TempPlayer(targetPlayer).TradeRequest > 0 Then
' they've already got a request for trade/party
PlayerMsg index, "This player is busy.", BrightRed
' exit out early
Exit Sub
End If
' make syure they're not in a party
If TempPlayer(targetPlayer).inParty > 0 Then
' they're already in a party
PlayerMsg index, "This player is already in a party.", BrightRed
'exit out early
Exit Sub
End If
' check if we're in a party
If TempPlayer(index).inParty > 0 Then
partyNum = TempPlayer(index).inParty
' make sure we're the leader
If Party(partyNum).Leader = index Then
' got a blank slot?
For i = 1 To MAX_PARTY_MEMBERS
If Party(partyNum).Member(i) = 0 Then
' send the invitation
SendPartyInvite targetPlayer, index
' set the invite target
TempPlayer(targetPlayer).partyInvite = index
' let them know
PlayerMsg index, "Invitation sent.", Pink
Exit Sub
End If
Next
' no room
PlayerMsg index, "Party is full.", BrightRed
Exit Sub
Else
' not the leader
PlayerMsg index, "You are not the party leader.", BrightRed
Exit Sub
End If
Else
' not in a party - doesn't matter!
SendPartyInvite targetPlayer, index
' set the invite target
TempPlayer(targetPlayer).partyInvite = index
' let them know
PlayerMsg index, "Invitation sent.", Pink
Exit Sub
End If
End Sub
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
' 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
Public Sub Party_InviteDecline(ByVal index As Long, ByVal targetPlayer As Long)
PlayerMsg index, GetPlayerName(targetPlayer) & " has declined to join the party.", BrightRed
PlayerMsg targetPlayer, "You declined to join the party.", BrightRed
' clear the invitation
TempPlayer(targetPlayer).partyInvite = 0
End Sub
Public Sub Party_CountMembers(ByVal partyNum As Long)
Dim i As Long, highIndex As Long, x As Long
' find the high index
For i = MAX_PARTY_MEMBERS To 1 Step -1
If Party(partyNum).Member(i) > 0 Then
highIndex = i
Exit For
End If
Next
' count the members
For i = 1 To MAX_PARTY_MEMBERS
' we've got a blank member
If Party(partyNum).Member(i) = 0 Then
' is it lower than the high index?
If i < highIndex Then
' move everyone down a slot
For x = i To MAX_PARTY_MEMBERS - 1
Party(partyNum).Member(x) = Party(partyNum).Member(x + 1)
Party(partyNum).Member(x + 1) = 0
Next
Else
' not lower - highindex is count
Party(partyNum).MemberCount = highIndex
Exit Sub
End If
End If
' check if we've reached the max
If i = MAX_PARTY_MEMBERS Then
If highIndex = i Then
Party(partyNum).MemberCount = MAX_PARTY_MEMBERS
Exit Sub
End If
End If
Next
' if we're here it means that we need to re-count again
Party_CountMembers partyNum
End Sub
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
' 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
Public Sub HandleProjecTile(ByVal index As Long, ByVal PlayerProjectile As Long)
Dim x As Long, y As Long, i As Long
' check for subscript out of range
If index < 1 Or index > MAX_PLAYERS Or PlayerProjectile < 1 Or PlayerProjectile > MAX_PLAYER_PROJECTILES Then Exit Sub
' check to see if it's time to move the Projectile
If GetTickCount > TempPlayer(index).ProjecTile(PlayerProjectile).TravelTime Then
With TempPlayer(index).ProjecTile(PlayerProjectile)
' set next travel time and the current position and then set the actual direction based on RMXP arrow tiles.
```
Annoying bug..
in Source
Posted
When an npc has been killed.. And the player leaves the map via death or teleporting the npc doesn't show to the player until the second time they return to the map.. The npc is there, as the player can attack it, and walk through it.. But can't see it.. This is only if they player elaves the map before the monster respawns. Any ideas LOL