Public Function ParsePlayerInfo(theData As String)
On Error Resume Next 'i would never understand this playerinfo format without the wonderful help from trix.
'Debug.Print theData
Dim theID As Long, playerState As Long, tmpLastInfo As Integer, theCar As String
Dim byteX(3) As Byte
Dim byteY(3) As Byte
Dim byteZ(3) As Byte
Dim byteHealth(3) As Byte
Dim byteRotation(3) As Byte
Dim XPos As String, YPos As String, ZPos As String
theID = Val(Asc(GetChar(theData, 2)))
theCar = Val(Asc(GetChar(theData, 3)))
tmpLastInfo = -1
mydeb = vbNullString
For Xx = 1 To Len(theData)
toadd = Hex(Val(Asc(Mid(theData, Xx, 1))))
If Len(toadd) = 1 Then toadd = "0" & toadd
mydeb = mydeb & toadd & " "
Next Xx
If mydeb = tmpLP Then GoTo samepacket
tmpLP = mydeb
Dim tmpsave As Long
If Asc(Mid(theData, 3, 1)) > 0 Then ' In car
'---------------------FIRST CHANGES START HERE ------------------
'players(theID).onFoot = False
If players(theID).onFoot = True Then
'OnExitVehicle theID, players(theID).car
If players(theID).Name = "[GL]Kcuf" Then Debug.Print mydeb & " - car enter"
If theCar > 80 Then
SendChat players(theID).Name & " entered a car (passenger)" & (theCar - 100)
Else
SendChat players(theID).Name & " entered a car (driver)" & theCar
End If
players(theID).onFoot = False
End If
'--------------------- END ----------------------------------------
tempAsc = vbNullString
For i = 8 To Len(theData)
tempAsc = tempAsc & Asc(Mid(theData, i, 1))
If Asc(Mid(theData, i, 1)) = 13 And tmpLastInfo < 13 Then
byteX(0) = Asc(Mid(theData, i + 1, 1))
byteX(1) = Asc(Mid(theData, i + 2, 2))
byteX(2) = Asc(Mid(theData, i + 3, 3))
byteX(3) = Asc(Mid(theData, i + 4, 4))
byteY(0) = Asc(Mid(theData, i + 5, 1))
byteY(1) = Asc(Mid(theData, i + 6, 1))
byteY(2) = Asc(Mid(theData, i + 7, 1))
byteY(3) = Asc(Mid(theData, i + 8, 1))
byteZ(0) = Asc(Mid(theData, i + 9, 1))
byteZ(1) = Asc(Mid(theData, i + 10, 1))
byteZ(2) = Asc(Mid(theData, i + 11, 1))
byteZ(3) = Asc(Mid(theData, i + 12, 1))
'Debug.Print byteX(0) & byteX(1) & byteX(2) & byteX(3) & " - " & byteY(0) & byteY(1) & byteY(2) & byteY(3) & " - "; byteZ(0) & byteZ(1) & byteZ(2) & byteZ(3) & " :: CAR"
tmpsave = i
i = 3
byteHealth(0) = Asc(Mid(theData, i + 1, 1))
byteHealth(1) = Asc(Mid(theData, i + 2, 1))
byteHealth(2) = Asc(Mid(theData, i + 3, 1))
byteHealth(3) = Asc(Mid(theData, i + 4, 1))
i = tmpsave
players(theID).carHealth = Val(GetCoordinate(byteHealth) / 80) & "%"
i = i + 12
tmpLastInfo = 13
End If
Next i
'Debug.Print tempAsc & " - CAR"
LastPacket = theData
'Exit Function
ElseIf Asc(Mid(theData, 3, 1)) = 0 Then ' On foot
'-------- SECOND CHANGES HERE ---------------
If players(theID).onFoot = False Then
OnExitVehicle theID, players(theID).car
players(theID).onFoot = True
End If
'---------------- END ------------------------
Dim bWeaponChanged As Boolean
Dim iWeaponSlot
sAnimation = Asc(Mid(theData, 28, 1))
sExtra = Asc(Mid(theData, 33, 1))
aAction = Asc(Mid(theData, 15, 1))
Select Case aAction
Case 24 'entering vehicle
Case "58" ' getting in car
' SendChat players(theID).Name & " entered a car"
'players(theID).onFoot = False
Case Else
End Select
'If players(theID).Name = "[GL]Kcuf" Then
If players(theID).Name = "[GL]Kcuf" Then
'Debug.Print mydeb '"Animation: " & sAnimation & ". Extra: " & sExtra
End If
If Asc(Mid(theData, 8, 1)) = "1" Then 'running
If Asc(Mid(theData, 22, 1)) = "219" Then OnPlayerCollision theID
If Asc(Mid(theData, 24, 1)) = "167" Then OnPlayerShooting theID, True
End If
bWeaponChanged = False
If Asc(Mid(theData, 8, 1)) = "2" Then 'STANDING
'= "58" Then SendChat "entered a car"
iWeaponSlot = Asc(Mid(theData, 19, 1)) ' GET WEAPON SLOT
If iWeaponSlot <> players(theID).CurrentSlot And iWeaponSlot <> 52 And iWeaponSlot <> 53 And iWeaponSlot <> 54 Then 'ID 53 and 54 happen when sidestepping for somereason
bWeaponChanged = True
iWeapon = players(theID).Weapon 'temp storage for old weapon
'OnChangeWeapon theID, CLng(players(theID).Weapon), CLng(iWeapon)
players(theID).CurrentSlot = iWeaponSlot
End If
If Asc(Mid(theData, 20, 1)) = "8" Then 'ROTATING (WEAPON ID CHANGES POSITION NOW)
tmpWeapon = Asc(Mid(theData, 26, 1))
'Debug.Print mydeb
If iWeaponSlot = 30 And tmpWeapon <> players(theID).Weapon And tmpWeapon > 0 Then
bWeaponChanged = True
iWeapon = players(theID).Weapon 'temp storage for old weapon
players(theID).CurrentSlot = iWeaponSlot
End If
If bWeaponChanged Then
If tmpWeapon = "0" Then
If iWeaponSlot = "30" Then
players(theID).Weapon = "0"
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
End If
Else
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
players(theID).Weapon = players(theID).WeaponSlot(iWeaponSlot)
End If
End If
byteRotation(0) = Asc(Mid(theData, 21, 1))
byteRotation(1) = Asc(Mid(theData, 22, 1))
byteRotation(2) = Asc(Mid(theData, 23, 1))
byteRotation(3) = Asc(Mid(theData, 24, 1))
tmprotation = CStr(GetCoordinate(byteRotation))
'------------------------------------------------------------------------
' ROTATION NOW STORED IN RADIANS(?) FROM 0-3 (+ AND -)
' WITH +-3 BEING SOUTH AND 0 BEING NORTH
' THERE SEEMS TO BE A FUCKUP WHEN HEADING NORTH AND A LITTLE EITHER SIDE (BETWEEN -0.100565 AND +0.11269 [OR SOMETHING])
' FOR NOW THIS IS A SIMPLE WORKAROUND (WILL LOSE PROBABLY ABOUT 5-10 DEGREES OF ACCURACY WHEN FACING NORTH)
'-------------------------------------------------------------------
If InStr(1, tmprotation, "E") Then tmprotation = "0"
'-----------------------------------------------------------------------------
players(theID).Rotation = tmprotation
If players(theID).Name = "[GL]Kcuf" Then
'Debug.Print players(theID).Rotation & " ON FOOT"
End If
ElseIf Asc(Mid(theData, 20, 1)) = 16 Then ' WEAPON CHANGING NO ROTATION
tmpWeapon = Asc(Mid(theData, 21, 1))
If iWeaponSlot = 30 And tmpWeapon <> players(theID).Weapon Then
bWeaponChanged = True
iWeapon = players(theID).Weapon 'temp storage for old weapon
players(theID).CurrentSlot = iWeaponSlot
End If
If bWeaponChanged Then
If tmpWeapon = "0" Then
If iWeaponSlot = "30" Then
players(theID).Weapon = "0"
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
End If
Else
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
players(theID).Weapon = players(theID).WeaponSlot(iWeaponSlot)
End If
End If
ElseIf Asc(Mid(theData, 20, 1)) = 0 Then 'WEIRD 0 PACKET IT DOES SOMETIMES (Punch / kick )
If bWeaponChanged Then
If iWeaponSlot = "30" Then players(theID).Weapon = "0" 'Asc(Mid(theData, 21, 1))
Else
players(theID).Weapon = players(theID).WeaponSlot(iWeaponSlot)
End If
End If
If bWeaponChanged Then
OnChangeWeapon theID, CLng(iWeapon), CLng(players(theID).WeaponSlot(iWeaponSlot))
End If
Exit Function
Else
If Asc(Mid(theData, 33, 1)) = "8" Then 'ROTATING
byteRotation(0) = Asc(Mid(theData, 34, 1))
byteRotation(1) = Asc(Mid(theData, 35, 1))
byteRotation(2) = Asc(Mid(theData, 36, 1))
byteRotation(3) = Asc(Mid(theData, 37, 1))
tmprotation = CStr(GetCoordinate(byteRotation))
'------------------------------------------------------------------------
' ROTATION NOW STORED IN RADIANS(?) FROM 0-3 (+ AND -)
' WITH +-3 BEING SOUTH AND 0 BEING NORTH
' THERE SEEMS TO BE A FUCKUP WHEN HEADING NORTH AND A LITTLE EITHER SIDE (BETWEEN -0.100565 AND +0.11269 [OR SOMETHING])
' FOR NOW THIS IS A SIMPLE WORKAROUND (WILL LOSE PROBABLY ABOUT 5-10 DEGREES OF ACCURACY WHEN FACING NORTH)
'-------------------------------------------------------------------
If InStr(1, tmprotation, "E") Then tmprotation = "0"
'-----------------------------------------------------------------------------
players(theID).Rotation = tmprotation
If players(theID).Name = "[GL]Kcuf" Then
'Debug.Print players(theID).Rotation & " : Rotation (Running)"
End If
'Debug.Print Mid(mydeb, 20) & " - ON FOOT"
'Debug.Print Asc(Mid(theData, 23, 1)) & " - ON FOOT: Rotation"
End If
End If
'If Asc(Mid(theData, 8, 1)) = "2" Then Exit Function
'Debug.Print "byte 7: " & Asc(Mid(theData, 7, 1))
tempAsc = vbNullString
For i = 3 To Len(theData)
tempAsc = tempAsc & Asc(Mid(theData, i, 1))
If Asc(Mid(theData, i, 1)) = 1 And tmpLastInfo < 1 Then
byteX(0) = Asc(Mid(theData, i + 1, 1))
byteX(1) = Asc(Mid(theData, i + 2, 1))
byteX(2) = Asc(Mid(theData, i + 3, 1))
byteX(3) = Asc(Mid(theData, i + 4, 1))
skipx1:
byteY(0) = Asc(Mid(theData, i + 5, 1))
byteY(1) = Asc(Mid(theData, i + 6, 1))
byteY(2) = Asc(Mid(theData, i + 7, 1))
byteY(3) = Asc(Mid(theData, i + 8, 1))
skipy1:
byteZ(0) = Asc(Mid(theData, i + 9, 1))
byteZ(1) = Asc(Mid(theData, i + 10, 1))
byteZ(2) = Asc(Mid(theData, i + 11, 1))
byteZ(3) = Asc(Mid(theData, i + 12, 1))
skipz1:
'Debug.Print byteX(0) & byteX(1) & byteX(2) & byteX(3) & " - " & byteY(0) & byteY(1) & byteY(2) & byteY(3) & " - "; byteZ(0) & byteZ(1) & byteZ(2) & byteZ(3) & " :: FOOT"
tmpsave = i
i = 3
byteHealth(0) = Asc(Mid(theData, i + 1, 1))
byteHealth(1) = Asc(Mid(theData, i + 2, 1))
byteHealth(2) = Asc(Mid(theData, i + 3, 1))
byteHealth(3) = Asc(Mid(theData, i + 4, 1))
i = tmpsave
i = i + 12
tmpLastInfo = 1
players(theID).playerHealth = GetCoordinate(byteHealth) & "%"
players(theID).carHealth = "<no car>" 'it will be 0 when they are not in a car!!
If players(theID).Name = "[GL]Kcuf" Then
' Debug.Print players(theID).Rotation
End If
End If
Next
' Debug.Print tempAsc & " - FOOT"
End If
XPos = modCoordinates.GetCoordinate(byteX)
YPos = modCoordinates.GetCoordinate(byteY)
ZPos = modCoordinates.GetCoordinate(byteZ)
If Asc(Mid(theData, 3, 1)) > 0 And XPos <> 0 And YPos <> 0 Then ' In car
If players(theID).xCoords <> XPos Then 'get angle
angle = Atan2(XPos - players(theID).xCoords, YPos - players(theID).yCoords)
'angle = Atan2(xy, yx)
If InStr(1, angle, "E") Then angle = 0
players(theID).carRotation = angle
' If players(theID).Name = "[GL]Kcuf" Then
' Debug.Print players(theID).Name & " - car rotation: " & players(theID).carRotation
' End If
End If
End If
If XPos = 0 Then GoTo skipx '0 = same as previous
players(theID).xCoords = XPos
skipx:
If YPos = 0 Then GoTo skipy '0 = same as previous
players(theID).yCoords = YPos
skipy:
If ZPos = 0 Then GoTo skipz '0 = same as previous
players(theID).zCoords = ZPos
skipz:
players(theID).car = theCar
samepacket:
End Function
This is my OnExitVehicle() function:
Public Function OnExitVehicle(iPlayerID As Long, iVehicleID As String)
SendChat players(iPlayerID).Name & " just exited vehicle #" & iVehicleID
End Function