DopeyBiach

I don't know how I've managed to cause this bug, any ideas on where to look..? 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

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 .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 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 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 MAX_MAP_ITEMS Or itemnum < 0 Or itemnum > MAX_ITEMS Or MapNum MAX_MAPS Then Exit Sub End If i = MapItemSlot If i 0 Then If itemnum >= 0 And itemnum 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 MAX_MAPS 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 MAX_MAPS 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 MAX_MAPS 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 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 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. ```