A few changes to fix the problem.
1- The Dim Players and type declarations where moved to the start; these need not run more than once in this pattern of code.
2- The color is being sent after being joined, so a new operation was added: OP_SETCOLOR. Now the server sends the new client, and then receives the color options, and then relays the color options. Before, the server did nothing after receibing the color option after send the new player object without any color.
3- Players(otherClient) was changed to Players(Joined) on the server's new player procedure. Now only the player who joined is sent to the other players. Before it was sending the last possible player in the array, who happened to not be connected. The otherClient variable is an enumeration of the FOR otherClient to MaxClients section, so it happend to = MaxClients. You are sending the new player outside of that FOR loop using the global send command; mn Send All TCP .
4- GOTO command was replaced with Repeat : Wait : Until Scancode() because you should not use GOTO commands. There is only once or twice in 10 years you would ever need to use GOTO, and that's only when a nested For loop tree gets messy, and you need a quick fix to exit the loops before any refactoring (tidying) can take place, and it can be used for certain styles of error handling;
but DO NOT use it because there are better alternatives way more easier to work with.
You can improve your code by making it more tidy with indents (tabs/spacing), functions and good coding practices you can learn at School/University/Books.
Use
Dark Dynamix for car racing games, much better than Dark Physics. Have you tested the Dark Physics vehicle engine?
Remember to put this stuff at the start of your program; atleast until you get more experience.
MaxClients = 10
type DataTest
CarObject as integer
CarColor as integer
endtype
Dim Players(MaxClients) as DataTest
Client
`TestClient
`TestClient.dba
`======================
` Cube World Client
` This demonstrates how to set up a simple client
` that uses UDP and TCP to communicate with the server
` Operations, used to identify the purpose of each packet
` TCP
#constant OP_NEWPLAYER 0
#constant OP_LEFTPLAYER 1
#constant OP_SETCOLOR 2
SET TEXT FONT "verdana",8
SET TEXT SIZE 16
PokazRozmowa$ = ""
Rozmowa$ = ""
print "1- czerwony"
print "2- zielony"
print "3- niebieski"
print "4- ?ó?ty"
print "5- cyan"
print "6- fiolet"
repeat
wait 3
until scancode()
if KEYSTATE(2)=1 then Kolor=1
if KEYSTATE(3)=1 then Kolor=2
if KEYSTATE(4)=1 then Kolor=3
if KEYSTATE(5)=1 then Kolor=4
if KEYSTATE(6)=1 then Kolor=5
if KEYSTATE(7)=1 then Kolor=6
` ---wczytuje teren---
GOSUB _Teren
` ---wczytuje nasz objekt---
GOSUB _Nasz_Objekt
` ---Kolor naszego objektu---
if Kolor=1 then color object 2, rgb ( 250, 0, 0 )
if Kolor=2 then color object 2, rgb ( 0, 250, 0 )
if Kolor=3 then color object 2, rgb ( 0, 0, 250 )
if Kolor=4 then color object 2, rgb ( 250, 250, 0 )
if Kolor=5 then color object 2, rgb ( 0, 248, 196 )
if Kolor=6 then color object 2, rgb ( 248,0 , 239 )
` Variables
` Set velocity and turn speed for player movement
Velocity = 5
TurnSpeed = 5
` To be filled during connection
MaximumClients as integer
` Main code
` Set UDP and TCP port of the server, which is 6789
ConnectPort = 6789
` Set timeout value which is the length of time
` in seconds that the command will wait for the
` connection to complete until giving up
Timeout = 4000
` Set the number of threads that will be created
` to deal with incoming data. In most cases this
` should be set to the number of processors on your
` computer. MikeNet can determine this for you
` automatically if you set it to 0
NoThreads = 0
` Set the number of MikeNet instances to create
NoInstances = 1
` Setup packets
SendPacket = mn create packet()
RecvPacket = mn create packet()
mn set memory size SendPacket,1024
` Start MikeNet
mn Start NoInstances,NoThreads
` Get IP address to connect to via UDP and TCP
ConnectIP$ as string
// Input "Enter the IP that you would like to connect to: ", ConnectIP$
`print "1-LAN"
`print "2-WAN"
`wait key
`if KEYSTATE(2)=1 then ConnectIP$ = "192.168.1.10"
`if KEYSTATE(3)=1 then ConnectIP$ = "83.27.79.174"
ConnectIP$ = "192.168.13.102"
`ConnectIP$ = "83.7.231.163"
` Try to connect
profile = mn Create Instance Profile()
Connect = mn Connect(0,ConnectIP$,ConnectPort,ConnectIP$,ConnectPort,Timeout, 1, profile)
CLS
select Connect
` If the connection was successful
`---Je?li po??czenie powiod?o si?
case 1:
print "Connection was successful!"
` Find maximum number of clients
` necassary for UDP receiving
`---Znajd? maksymaln? liczb? klientów
`---Necassary dla UDP odbioru
MaximumClients= mn Get Max Clients(0)
` Display information
`---Informacje na wy?wietlaczu
Print " The local TCP IP is: ";
print mn Get Local IP TCP(0)
Print " The local TCP port is: ";
print mn Get Local Port TCP(0)
Print " The local UDP IP is: ";
print mn Get Local IP UDP(0)
Print " The local UDP port is: ";
print mn Get Local Port UDP(0)
Print " Your client ID is: ";
print mn Get Client ID(0)
clientID = mn Get Client ID(0)
` KolorNG
print
print "Press any key to continue"
` Wait Key
endcase
` If the connection timed out
`---Je?eli przekroczenie czasu po??czenia
case 0:
CLS
Print "Przekroczono limit czasu po??czenia.Serwer mo?e by? niedost?pny."
Print "Naci?nij dowolny klawisz aby zamkn??"
Wait Key
end
endcase
` If an unknown error occurred during connection
case -1:
CLS
Print "Wyst?pi? nieznany b??d podczas próby po??czenia."
Print "Naci?nij dowolny klawisz aby zamkn??"
Wait Key
end
endcase
` If we failed to connect because the server is full
case -2:
CLS
print "??danie po??czenia zosta? odrzucony, poniewa? serwer jest pe?ny."
print "Naci?nij dowolny klawisz aby zamkn??"
Wait Key
end
endcase
endselect
` Setup the world for us to run around in
`Sync On
`Sync Rate 40
`AutoCam Off
`Make Matrix 1,5000,5000,50,50
`Position Matrix 1,Camera Position X(),Camera Position Y()-20,Camera Position Z()
` Once connected, we loop until we become disconnected
while mn Client Connected(0,0) = 1
if Kolor > 0
` mn Add SizeT SendPacket,clientID
mn Add SizeT SendPacket,Kolor
mn Send TCP 0,SendPacket,0,0,1
text 400,10,"GLOBAL ID:" + str$(clientID)
text 400,30,"LOCAL CAR COLOR:" + str$(Kolor)
` Refresh screen
` Sync
endif
GOSUB _Sterowanie:
` Player movement
` if UpKey() = 1 then Move Camera Velocity
` if DownKey() = 1 then Move Camera -Velocity
` if LeftKey() = 1 then Turn Camera Left TurnSpeed
` if RightKey() = 1 then Turn Camera Right TurnSpeed
` Deal with new messages from the server
` Check for new TCP messages
TCPPackets = mn Recv TCP(0,RecvPacket,0)
` If there is a new TCP message
if TCPPackets > 0 `*
` Get operation of new message
` and player that it applies to
`---Get dzia?anie nowej wiadomo?ci
`---A gracz, który ma zastosowanie do
Operation = mn Get SizeT(RecvPacket)
Client = mn Get SizeT(RecvPacket)
carObjectID = mn Get SizeT(RecvPacket)
CARCOLOR = mn Get SizeT(RecvPacket)
` If the server is telling us that a new player has joined
` then create a cube for that player
`---Je?eli serwer mówi nam, ?e nowy gracz do??czy?
`---Nast?pnie utworzy? sze?cian dla tego gracza
if Operation = OP_NEWPLAYER `**
if Object Exist(100+Client) <> 0 = FALSE `***
` Make Object Cube 100+Player,50
w#=5 : h#=10
make object box carObjectID, w#, h#, w#
` phy make box character controller 100+Player, 0, 10, 0, w#/2, h#/2, w#/2, 1, 1.5, 45.0
if CARCOLOR=1 then color object carObjectID, rgb ( 250, 0, 0 )
if CARCOLOR=2 then color object carObjectID, rgb ( 0, 250, 0 )
if CARCOLOR=3 then color object carObjectID, rgb ( 0, 0, 250 )
if CARCOLOR=4 then color object carObjectID, rgb ( 250, 250, 0 )
if CARCOLOR=5 then color object carObjectID, rgb ( 0, 248, 196 )
if CARCOLOR=6 then color object carObjectID, rgb ( 248,0 , 239 )
endif `***
endif `**
If Operation = OP_SETCOLOR
if CARCOLOR=1 then color object carObjectID, rgb ( 250, 0, 0 )
if CARCOLOR=2 then color object carObjectID, rgb ( 0, 250, 0 )
if CARCOLOR=3 then color object carObjectID, rgb ( 0, 0, 250 )
if CARCOLOR=4 then color object carObjectID, rgb ( 250, 250, 0 )
if CARCOLOR=5 then color object carObjectID, rgb ( 0, 248, 196 )
if CARCOLOR=6 then color object carObjectID, rgb ( 248,0 , 239 )
Endif
` If the server is telling us that a player has left then
` delete the cube of that player
`---Je?eli serwer mówi nam, ?e gracz opu?ci? nast?pnie
`---Usun?? tego gracza kostk?
if Operation = OP_LEFTPLAYER
if Object Exist(100+Player) = 1
Delete Object 100+Player
endif
endif
endif `*
` Check for new UDP messages on a per client basis
` Check each client
`---Sprawd?, czy s? nowe wiadomo?ci na UDP na bazie klienta
`---Sprawdzanie ka?dego klienta
PlayerA as integer
for PlayerA = 1 to MaximumClients
` Check for new UDP messages
`---Sprawd?, czy s? nowe wiadomo?ci UDP
UDPPackets = mn Recv UDP(0,RecvPacket,PlayerA,0)
if Object Exist(100+PlayerA) = 1
` If there is a new UDP message
`---Je?li jest nowy komunikat UDP
if UDPPackets = 1
` Get the player's position and angle
` and apply them to his/her cube
`---Get pozycji zawodnika i k?ta
`---I zastosowa? je do jego / jej kostki
PosX# = mn Get Float(RecvPacket)
PosY# = mn Get Float(RecvPacket)
PosZ# = mn Get Float(RecvPacket)
RotX# = mn Get Float(RecvPacket)
RotY# = mn Get Float(RecvPacket)
RotZ# = mn Get Float(RecvPacket)
` PokazRozmowa$ = mn Get String(RecvPacket, 0, 1)
` if PokazRozmowa$="" then GOTO _Linia_Rozmowa
` PokazNaEkranRozmowa$=PokazRozmowa$
` _Linia_Rozmowa:
` PokazRozmowa$ = ""
Position Object 100+PlayerA,PosX#,PosY#,PosZ#
Rotate Object 100+PlayerA,RotX#,RotY#,RotZ#
endif
endif
next PlayerA
`text 10,100,">"+PokazNaEkranRozmowa$+"<"
if KEYSTATE(20)=1 : rem T
input Rozmowa$
PokazNaEkranRozmowa$=Rozmowa$
endif
` Send our position/angle to the server via UDP
` Formulate packet
`---Wy?lij nasz? pozycj? / k?t na serwer poprzez UDP
`---Sformu?owanie pakiet
mn Add Float SendPacket,object Position X(2)
mn Add Float SendPacket,object Position Y(2)
mn Add Float SendPacket,object Position Z(2)
mn Add Float SendPacket,object Angle X(2)
mn Add Float SendPacket,object Angle Y(2)
mn Add Float SendPacket,object Angle Z(2)
` mn Add String SendPacket, Rozmowa$, 0, 1
` Rozmowa$ = ""
` Send packet
mn Send UDP 0,SendPacket,0,0,1
endwhile
` If we have become disconnected from the server
while ScanCode() <> 0
Wait 1
endwhile
while ScanCode() = 0
Text 0,0,"Lost connection to server, press any key to exit"
Sync
endwhile
` Exit
end
` demonstrates how to use a character controller
` to move around a simple scene
` set up general properties
_Teren:
phy start
autocam off
sync on
sync rate 60
color backdrop 0
position camera 0, 20, -70
make light 1
set directional light 1, -5, -5, 5
rem stripe textures
`load image "stripe5.png",8
`make object sphere 8,400,48,48
`texture object 8,8
`scale object texture 8,6,6
`set object cull 8,0
`load image "stripe6.png",1
` make our ground object
make object box 1, 200, 1, 200
texture object 1,1
phy make rigid body static box 1
color object 1, rgb ( 50, 50, 50 )
` create a set of steps
x# = 10
y# = 1
for i = 10 to 20
make object box i, 3, 2, 10
position object i, x#, y#, 0
x# = x# + 3
y# = y# + 1
phy make rigid body static box i
next i
` create a stack of boxes
` ---tworzy? stos skrzynek
`y# = 1
for i = 21 to 31
make object cube i, 2
position object i, rnd(100)-50, rnd(60), rnd(100)-50
` y# = y# + 2
phy make rigid body dynamic box i
next i
RETURN
_Nasz_Objekt:
` create our character controller
w#=5 : h#=10
make object box 2, w#, h#, w#
phy make box character controller 2, 0, 10, 0, w#/2, h#/2, w#/2, 1, 1.5, 45.0
` give all of objects a splash of colour
for i = 1 to 31
if object exist ( i ) and i<>1 and i<>8
color object i, rgb ( rnd ( 255 ), rnd ( 255 ), rnd ( 255 ) )
set object specular i, rgb ( rnd ( 255 ), rnd ( 255 ), rnd ( 255 ) )
set object specular power i, 255
set object ambient i, 0
endif
next i
RETURN
` display the Dark Physics logo
`load image "logo.png", 100000
`sprite 1, 0, 600 - 60, 100000
`lastObjectA = 0
`lastObjectB = 0
` and now our main loop
_Sterowanie:
` display some instructions on screen
set cursor 0, 0
` print "Character Controller Example"
` print "Use the arrow keys to move the box around"
` print "object a = " + str$ ( lastObjectA )
` print "object b = " + str$ ( lastObjectB )
` turn the object left when the left key is pressed
if leftkey ( )
turn object left 2, 1.2
endif
` turn the object right when the right key is pressed
if rightkey ( )
turn object right 2, 1.2
endif
` apply a force to move the controller when the up key is pressed
if upkey ( )
phy move character controller 2, 20.0
else
phy move character controller 2, 0.0
endif
if downkey ( )
phy move character controller 2, -20.0
else
phy move character controller 2, 0.0
endif
while phy get collision data ( )
lastObjectA = phy get collision object a ( )
lastObjectB = phy get collision object b ( )
endwhile
` update the simulation and screen
phy update
sync
RETURN
Server
`TestServer
`TestServer.dba
`======================
` Cube World Server
` This demonstrates how to set up a simple server
` that uses UDP and TCP to relay data to clients
` Operations, used to identify the purpose of each packet
` TCP
#constant OP_NEWPLAYER 0
#constant OP_LEFTPLAYER 1
#constant OP_SETCOLOR 2
` Set the local port of the server, this is the port
` that the server will use for both TCP and UDP
LocalPort = 6789
` Set the local IP of the server, this is the local IP
` that the server will use for both TCP and UDP
LocalIP$ = ""
` Set the maximum number of clients that can be
` connected at any one time
MaxClients = 10
type DataTest
CarObject as integer
CarColor as integer
endtype
Dim Players(MaxClients) as DataTest
CARCOLOR = CARCOLOR_kopia
` Set the UDP mode which decides how UDP packets
` are dealt with
UDPMode = 1
` Set the number of threads that will be created
` to deal with incoming data. In most cases this
` should be set to the number of processors on your
` computer. MikeNet can determine this for you
` automatically if you set it to 0
NoThreads = 0
` Set the number of MikeNet instances to create
NoInstances = 1
` Setup packets
SendPacket = mn create packet()
RecvPacket = mn create packet()
mn set memory size SendPacket,1024
` Start MikeNet
mn Start NoInstances,NoThreads
` Set the local IP and port of the server
` Note: if we did not use this command then MikeNet
` would find a local IP and port to use automatically
profile = mn Create Instance Profile()
mn Set Profile Local profile,LocalIP$,LocalPort,localIP$,LocalPort
mn Set Profile Mode UDP profile,UDPMode
` Attempt to start the server
Result = mn Start Server(0, MaxClients,profile)
` If started successfully
if Result = 0
print "Server started"
print
print "Server local TCP port: "
print mn Get Local Port TCP(0)
print "Server local UDP port: "
print mn Get Local Port UDP(0)
` If failed to start
else
print "Server failed to start"
Wait Key
end
endif
` Main loop
do
` Check to see if a new client has joined
Joined = mn Client Joined(0)
Client as integer
CARCOLOR as integer
for Client = 1 to MaxClients
`text 400,0+Client*16,"Client: " + str$(Client)
TCPPackets = mn Recv TCP(0,RecvPacket,Client)
if TCPPackets > 0
CARCOLOR = mn Get SizeT(RecvPacket)
CARCOLOR_kopia = CARCOLOR
dim array$(MaxClients)
array$(Client)=str$(CARCOLOR)
` Tell clients the color of the new car
clientCar = Client + 100 // Send the ID to the client who joined:
mn Add SizeT SendPacket, OP_SETCOLOR
mn Add SizeT SendPacket, client
mn Add SizeT SendPacket, clientCar
mn Add SizeT SendPacket, CARCOLOR
mn Send All TCP 0,SendPacket,0,0,Client
for i=1 to MaxClients
text 10,10+i*16,"CLIENT ID ("+str$(i)+") = " + array$(i)
next
endif
next
` If a new client has joined
if Joined > 0
` Display client information
print "A new client has joined with a client ID of ";
print Joined
print " Client TCP IP is: ";
print mn Get Client IP TCP(0, Joined)
print " Client TCP port is: ";
print mn Get Client Port TCP(0, Joined)
print " Client UDP IP is: ";
print mn Get Client IP UDP(0, Joined)
print " Client UDP port is: ";
print mn Get Client Port UDP(0, Joined)
` Tell the new client what clients are currently connected
cls
carObjectIDForNewPlayer = Joined+100
text 400,0,"Car Color: " + str$(CARCOLOR)
show message CARCOLOR
for otherClient = 1 to MaxClients
carObjectID = otherClient+100 // Tell the client who joined; the object ID's of the OTHER players
Players(Joined).CarObject=carObjectIDForNewPlayer // Make new player on server
Players(Joined).CarColor=CARCOLOR
If otherClient<> Joined And mn Client Connected(0,otherClient)
mn Add SizeT SendPacket,OP_NEWPLAYER
mn Add SizeT SendPacket,otherClient
mn Add SizeT SendPacket,Players(otherClient).CarObject
mn Add SizeT SendPacket,Players(otherClient).CarColor
mn Send TCP 0,SendPacket,Joined,0,0
EndIf
Next otherClient
` Tell clients that a new client has joined
carObjectIDForNewPlayer = Joined+100 // Send the ID to the client who joined:
mn Add SizeT SendPacket, OP_NEWPLAYER
mn Add SizeT SendPacket, Joined
mn Add SizeT SendPacket,carObjectIDForNewPlayer
mn Add SizeT SendPacket, CARCOLOR
mn Send All TCP 0,SendPacket,0,0,Joined
endif
` Check to see if any clients have left recently
Left = mn Client Left(0)
` If a client has left recently
if Left > 0
` Print the client id of the client who left
print "Client ";
print str$(Left);
print " has disconnected"
` Tell clients that a client has left
mn Add SizeT SendPacket,OP_LEFTPLAYER
mn Add SizeT SendPacket,Left
mn Add SizeT SendPacket,carObjectID
mn Add SizeT SendPacket,CARCOLOR
mn Send All TCP 0,SendPacket,0,0,Left
endif
` Deal with new packets from all clients
for Client = 1 to MaxClients
` Check to see if any new TCP packets have been received
` TCPPackets = mn Recv TCP(0,RecvPacket,Client)
` If any have been received then do nothing
` since we don't want TCP packets from clients
` if TCPPackets > 0
` endif
` Check to see if any new UDP packets have been received
UDPPackets = mn Recv UDP(0,RecvPacket,Client,0)
` If any have been received
if UDPPackets > 0
` Get data from packet
PosX# = mn Get Float(RecvPacket)
PosY# = mn Get Float(RecvPacket)
PosZ# = mn Get Float(RecvPacket)
RotX# = mn Get Float(RecvPacket)
RotY# = mn Get Float(RecvPacket)
RotZ# = mn Get Float(RecvPacket)
` Relay data to clients
` Formulate packet
mn Add SizeT SendPacket,Client
mn Add Float SendPacket,PosX#
mn Add Float SendPacket,PosY#
mn Add Float SendPacket,PosZ#
mn Add Float SendPacket,RotX#
mn Add Float SendPacket,RotY#
mn Add Float SendPacket,RotZ#
` Send packet to all clients
mn Send All UDP 0,SendPacket,0,0,0
endif
next Client
loop
mn delete packet SendPacket
mn delete packet RecvPacket
mn delete instance profile profile
mn finish 0
