Here the server:
` Constants --------------------------------------
#constant MAXIMUM_PLAYERS 10
#constant MESSAGE_ID_NAME 0
#constant MESSAGE_ID_GENERAL 1 : ` Contains just player data
#constant MESSAGE_ID_GENERALFULL 2 : ` Contains player numbers and player data
#constant MESSAGE_ID_PLAYERJOINED 3
#constant MESSAGE_ID_PLAYERQUIT 4
#constant FLAG_UP 1
#constant FLAG_DOWN 2
#constant FLAG_LEFT 4
#constant FLAG_RIGHT 8
#constant MESSAGE_ID_PINGTEST 5
` ------------------------------------------------
` Types ------------------------------------------
type player_data
ping as integer
exist as boolean
active as boolean
name as string
x as float
z as float
realx as float
realz as float
angle as float
key_up as boolean
key_down as boolean
key_left as boolean
key_right as boolean
endtype
` ------------------------------------------------
` Variables --------------------------------------
global dim player(MAXIMUM_PLAYERS) as player_data
global MOUSE_LBM_PRESSED as boolean
global playerc=0
` ------------------------------------------------
sync off
autocam off
result = net host(MAXIMUM_PLAYERS)
if not result
print "Could not start server: "+chr$(34)+net get error()+chr$(34)+"."
print "Press any key to exit."
wait key
end
endif
make matrix 1, 1000, 1000, 10, 10
position camera 500, 1000, 500
point camera 500, 0, 500
sync on
sync rate 60
do
text 0, 0, str$(screen fps())
text 0, 13, "There are "+str$(net get player amount())+" players connected."
maxplayers=maximum(maxplayers,net get player amount())
text 0, 26, "There were max "+str$(maxplayers)+" players connected at the same time."
text 0, 39, str$(playerc)+" players connected."
text 0, 39+13, "Press space to see playerlist with ping."
if spacekey()
for x = 1 to MAXIMUM_PLAYERS
if player(x).exist
text 0,39+13+13*x,player(x).name+" "+str$(player(x).ping)
endif
next x
endif
HandleNetwork()
HandleMouseOvers()
HandleMovement()
sync
loop
function maximum(a,b)
ret=a
if b>a then ret=b
endfunction ret
function HandleMovement()
for x = 1 to MAXIMUM_PLAYERS
if player(x).exist
if player(x).key_up
player(x).realx = player(x).realx + sin(player(x).angle)
player(x).realz = player(x).realz + cos(player(x).angle)
endif
if player(x).key_down
player(x).realx = player(x).realx - sin(player(x).angle)
player(x).realz = player(x).realz - cos(player(x).angle)
endif
if player(x).key_left then player(x).angle = wrapvalue(player(x).angle-1)
if player(x).key_right then player(x).angle = wrapvalue(player(x).angle+1)
distx# = abs(player(x).realx-player(x).x)
speedx# = distx# / 10.0
distz# = abs(player(x).realz-player(x).z)
speedz# = distz# / 10.0
angle# = atanfull(player(x).realx-player(x).x, player(x).realz-player(x).z)
player(x).x = player(x).x + (sin(angle#)*speedx#)
player(x).z = player(x).z + (cos(angle#)*speedz#)
yrotate object x+10, player(x).angle
position object x+10, player(x).x, 0, player(x).z
endif
next x
endfunction
function HandleMouseOvers()
result = pick object(mousex(), mousey(), 10, 30)
if result = 0 then exitfunction
if result > 9 and result < 20
text mousex(), mousey()-13, player(result-10).name
endif
endfunction
function HandleNetwork()
` Player joining ------------
` ---------------------------
result = net player joined()
if result > 0
inc playerc
write string 1, "Net player joined: "+str$(result)
make object cube 10+result, 10
player(result).exist = 1
rem send states & positions of players
net put byte MESSAGE_ID_GENERALFULL
for x = 1 to MAXIMUM_PLAYERS
if net player connected(x)
if player(x).active
net put byte x
net put string player(x).name
net put float player(x).realx
net put float player(x).realz
net put byte player(x).angle / 1.411
net put byte GetFlags(x)
endif
endif
next x
net send result
endif
` Player leaving -------------
` ----------------------------
result = net player left()
if result > 0
write string 1, "Net player left: "+str$(result)
ResetPlayer(result)
net put byte MESSAGE_ID_PLAYERQUIT
net put byte result
net send all
endif
` Message processing ---------
` ----------------------------
while net get message()
write string 1, "New message from "+str$(net message from())
inc MSGSRECVD
playerNum = net message from()
select net get byte()
case MESSAGE_ID_NAME:
playerNum = net message from()
player(playerNum).name = net get string()
player(playerNum).active = 1
color object playerNum+10, rgb(0, 255, 0)
` Notify other players
net put byte MESSAGE_ID_PLAYERJOINED
net put byte playerNum
net put string player(playerNum).name
for x = 1 to MAXIMUM_PLAYERS
if net player connected(x)
if x <> playerNum
net send x, 1
endif
endif
next x
` Clear message data
net send 0
endcase
case MESSAGE_ID_GENERAL:
player(playerNum).realx = net get float()
player(playerNum).realz = net get float()
player(playerNum).angle = net get byte() * 1.411
ApplyFlags(playerNum, net get byte())
ApplyPosition(playerNum)
` Forward message on
net put byte MESSAGE_ID_GENERAL
net put byte playerNum
net put float player(playerNum).realx
net put float player(playerNum).realz
net put byte player(playerNum).angle / 1.411
net put byte GetFlags(playerNum)
SendAllExcept(playerNum)
endcase
case MESSAGE_ID_PINGTEST:
player(playerNum).ping = net get word()
` Reply to message
net put byte MESSAGE_ID_PINGTEST
net send playerNum
endcase
endselect
endwhile
endfunction
function ResetPlayer(playerNum as integer)
if object exist(playerNum+10) then delete object playerNum+10
player(playerNum).exist = 0
player(playerNum).active = 0
player(playerNum).name = ""
player(playerNum).x = 0
player(playerNum).z = 0
player(playerNum).realx = 0
player(playerNum).realz = 0
player(playerNum).angle = 0
player(playerNum).key_up = 0
player(playerNum).key_down = 0
player(playerNum).key_left = 0
player(playerNum).key_right = 0
endfunction
function SendAllExcept(except as integer)
for x = 1 to MAXIMUM_PLAYERS
if net player connected(x)
if x <> except
net send x, 1
endif
endif
next x
net send 0
endfunction
function GetFlags(playerNum as integer)
local states as byte
if player(playerNum).key_up then states = states || FLAG_UP
if player(playerNum).key_down then states = states|| FLAG_DOWN
if player(playerNum).key_left then states = states || FLAG_LEFT
if player(playerNum).key_right then states = states || FLAG_RIGHT
endfunction states
function ApplyFlags(playerNum as integer, flags as integer)
if flags && FLAG_UP
player(playerNum).key_up = 1
else
player(playerNum).key_up = 0
endif
if flags && FLAG_DOWN
player(playerNum).key_down = 1
else
player(playerNum).key_down = 0
endif
if flags && FLAG_LEFT
player(playerNum).key_left = 1
else
player(playerNum).key_left = 0
endif
if flags && FLAG_RIGHT
player(playerNum).key_right = 1
else
player(playerNum).key_right = 0
endif
endfunction
function ApplyPosition(playerNum as integer)
position object playerNum+10, player(playerNum).x, 0, player(playerNum).z
yrotate object playerNum+10, player(playerNum).angle
endfunction
and here the client:
` Constants -------------------------------------
#constant SENDGAP 0
#constant MAXIMUM_PLAYERS 10
#constant MESSAGE_ID_NAME 0
#constant MESSAGE_ID_GENERAL 1 : ` Contains just player data
#constant MESSAGE_ID_GENERALFULL 2 : ` Contains player numbers and player data
#constant MESSAGE_ID_PLAYERJOINED 3
#constant MESSAGE_ID_PLAYERQUIT 4
#constant FLAG_UP 1
#constant FLAG_DOWN 2
#constant FLAG_LEFT 4
#constant FLAG_RIGHT 8
#constant MESSAGE_ID_PINGTEST 5
` -----------------------------------------------
` Types ------------------------------------------
type player_data
exist as boolean
name as string
x as float
z as float
realx as float
realz as float
angle as float
key_up as boolean
key_down as boolean
key_left as boolean
key_right as boolean
endtype
` ------------------------------------------------
` Variables --------------------------------------
global LASTSENT as integer
global MSGSRECVD as integer
global NAME as string
global dim player(MAXIMUM_PLAYERS) as player_data
global lastFlags as byte
global toSend
global Ping as dword rem dword because timer() never gives negative results
global PingTimer as dword rem dword because timer() never gives negative results
global PingTimeSinceLastCheck as dword rem dword because timer() never gives negative results
` ------------------------------------------------
sync off
autocam off
input "IP: ", ip$
result = net connect(ip$)
if not result
print "Could not connect: "+chr$(34)+net get error()+chr$(34)+"."
print "Press any key to exit."
wait key
end
endif
input "Name: ", NAME
net put byte MESSAGE_ID_NAME
net put string NAME
net send
make matrix 1, 1000, 1000, 10, 10
make object cube 1, 10
make object cube 40, 10
ghost object on 40
hide object 40
sync on
sync rate 60
global dist#
` Ping --------------------------------------
PingTimeSinceLastCheck=timer()
` ------------------------------------------------
do
text 0, 0, str$(screen fps())
text 0, 13, "Messages received: "+str$(MSGSRECVD)
text 0, 26, str$(dist#)
text 0, 39, "Ping: "+str$(Ping)
HandleControls()
HandleCamera()
if net connected()
HandleNetwork()
HandlePing()
else
CenterBox(screen width()/2, screen height()/2, 200, 26, "WE'VE LOST THE SERVER!")
endif
HandleMovement()
sync
loop
` Ping --------------------------------------
function HandlePing()
rem checking the timer is slow
t=timer()
if t-PingTimeSinceLastCheck>1000 rem check every second
PingTimer=timer() rem "start" the timer
PingTimeSinceLastCheck=PingTimer
net put byte MESSAGE_ID_PINGTEST
net put word Ping rem send the ping to the server so he knows the ping too. word cuz ping will NEVER be larger than 65k
net send
endif
endfunction
` ------------------------------------------------
function HandleMovement()
for x = 1 to MAXIMUM_PLAYERS
if player(x).exist
rem real values are the actual current values
if player(x).key_up
player(x).realx = player(x).realx + sin(player(x).angle)
player(x).realz = player(x).realz + cos(player(x).angle)
endif
if player(x).key_down
player(x).realx = player(x).realx - sin(player(x).angle)
player(x).realz = player(x).realz - cos(player(x).angle)
endif
if player(x).key_left then player(x).angle = wrapvalue(player(x).angle-1)
if player(x).key_right then player(x).angle = wrapvalue(player(x).angle+1)
distx# = abs(player(x).realx-player(x).x)
speedx# = distx# / 10.0
distz# = abs(player(x).realz-player(x).z)
speedz# = distz# / 10.0
angle# = atanfull(player(x).realx-player(x).x, player(x).realz-player(x).z)
player(x).x = player(x).x + (sin(angle#)*speedx#)
player(x).z = player(x).z + (cos(angle#)*speedz#)
yrotate object x+10, player(x).angle
position object x+10, player(x).x, 0, player(x).z
center text object screen x(x+10), object screen y(x+10)-13, player(x).name
endif
next x
endfunction
function HandleNetwork()
while net get message()
inc MSGSRECVD
select net get byte()
case MESSAGE_ID_GENERAL:
playerNum = net get byte()
player(playerNum).realx = net get float()
player(playerNum).realz = net get float()
player(playerNum).angle = net get byte() * 1.411
ApplyFlags(playerNum, net get byte())
endcase
case MESSAGE_ID_GENERALFULL:
while net get message remainder() > 0
playerNum = net get byte()
player(playerNum).exist = 1
player(playerNum).name = net get string()
player(playerNum).realx = net get float()
player(playerNum).realz = net get float()
player(playerNum).angle = net get byte() * 1.411
ApplyFlags(playerNum, net get byte())
make object cube playerNum+10, 10
ApplyPosition(playerNum)
endwhile
endcase
case MESSAGE_ID_PLAYERJOINED:
playerNum = net get byte()
player(playerNum).exist = 1
player(playerNum).name = net get string()
make object cube playerNum+10, 10
endcase
case MESSAGE_ID_PLAYERQUIT:
ResetPlayer(net get byte())
endcase
case MESSAGE_ID_PINGTEST:
rem message got to the server and came back
Ping=timer()-PingTimer rem stop the timer
endcase
endselect
endwhile
if toSend and LASTSENT+SENDGAP<timer()
net put byte MESSAGE_ID_GENERAL
net put float object position x(1)
net put float object position z(1)
net put byte (object angle y(1) / 1.411)
if upkey() then flags = flags || FLAG_UP
if downkey() then flags = flags || FLAG_DOWN
if leftkey() then flags = flags || FLAG_LEFT
if rightkey() then flags = flags || FLAG_RIGHT
net put byte flags
net send
toSend = 0
endif
endfunction
function HandleControls()
flags = 0
if upkey() then move object 1, 1 : flags = flags || FLAG_UP
if downkey() then move object 1, -1 : flags = flags || FLAG_DOWN
if leftkey() then yrotate object 1, wrapvalue(object angle y(1)-1) : flags = flags || FLAG_LEFT
if rightkey() then yrotate object 1, wrapvalue(object angle y(1)+1) : flags = flags || FLAG_RIGHT
if flags <> lastFlags
toSend = 1
lastFlags = flags
LASTSENT = timer()
endif
endfunction
function HandleCamera()
xPos# = object position x(1) + cos(270-object angle y(1)) * 50
zPos# = object position z(1) + sin(270-object angle y(1)) * 50
position camera xPos#, 40, zPos#
point camera object position x(1), 20, object position z(1)
endfunction
function ResetPlayer(playerNum as integer)
if object exist(playerNum+10) then delete object playerNum+10
player(playerNum).exist = 0
player(playerNum).name = ""
player(playerNum).x = 0
player(playerNum).z = 0
player(playerNum).angle = 0
player(playerNum).key_up = 0
player(playerNum).key_down = 0
player(playerNum).key_left = 0
player(playerNum).key_right = 0
endfunction
function ApplyFlags(playerNum as integer, flags as integer)
if flags && FLAG_UP
player(playerNum).key_up = 1
else
player(playerNum).key_up = 0
endif
if flags && FLAG_DOWN
player(playerNum).key_down = 1
else
player(playerNum).key_down = 0
endif
if flags && FLAG_LEFT
player(playerNum).key_left = 1
else
player(playerNum).key_left = 0
endif
if flags && FLAG_RIGHT
player(playerNum).key_right = 1
else
player(playerNum).key_right = 0
endif
endfunction
function ApplyPosition(playerNum as integer)
position object playerNum+10, player(playerNum).x, 0, player(playerNum).z
yrotate object playerNum+10, player(playerNum).angle
endfunction
function CenterBox(x as integer, y as integer, xSize as integer, ySize as integer, textString as string)
xPos = x-(xSize/2)
yPos = y-(ySize/2)
ink rgb(200, 200, 200), 0
box xPos, yPos, xPos+xSize, yPos+ySize
ink rgb(255, 255, 255), 0
center text x, y-(text height("A")/2), textString
endfunction
I've started a server to test this @
hceentserv.no-ip.biz
(I'd actually have a dynamic ip, but this doesn't matter because of noip)