VR House Multiplayer Project with Movement (Updated)

load an .X model into the code and then walk around in a multiplayer online environment

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    randomize timer()

dim mpgot(10)
dim zchat$(20)

sync on : sync rate 32
backdrop on
color backdrop 0
autocam off
draw to front
set text font "arial"
set text size 12
set text transparent
hide mouse

color backdrop rgb(0,0,0)

cls rgb(0,0,0)

rem create stars image
for i = 1 to 50

     e = rnd(255)
     dot rnd(255),rnd(255),rgb(e,e,e)

next f

get image 1, 0, 0, 256, 256

for t=2 to 28
cls rgb(rnd(255),rnd(255),rnd(255))
get image t,0,0,256,256
next t

rem Load House Model

load object "objects/housemodel.x",1
set object 1,1,0,0,0,0,0,0
scale object 1,20000,20000,20000
rem scale object 1,20000,20000,20000
set object texture 1,1,1
position object 1,0,0,0

for t=1 to 10000
rem if limb exist(1,t) then texture limb 1,t,rnd(20)+1
next t

rem Objects

set light range 0, 100000

make object sphere 2,400
color object 2,rgb(255,255,0)
position object 2,0,0,5000
texture object 2,2

cls rgb(0,0,0)

rem Sky Box

ink rgb(255,255,0),rgb(255,255,0)
dim sx(100)
dim sy(100)
make object sphere 4, 40000, 20, 20
position object 4, camera position x(0), camera position y(0), camera position z(0)
texture object 4, 1
scale object texture 4, 8, 8
set object 4, 1, 0, 0, 0, 0, 0, 0

rem Detection Sphere

make object box 3,50,50,50

set camera range  1,20000

`give the camera a position
point camera 0,0,0
position camera 0,0,0
`this is just an important variable
o# = 0

Point camera 0,0,0

rem Position Characters

for i = 0 to 7
make object cone 10+i,5
color object 10+i,rgb(i*30,0,210-(i*30))
xrotate object 10+i,90
fix object pivot 10+i
rem make sure to hide player objects not in use
hide object 10+i
next i

make object cone 8,5
color object 8,rgb(0,0,255)
xrotate object 8,90
fix object pivot 8

position object 8,0,-50,500


goto start

rem **** FIND THE TCP/IP CONNECTION TYPE
rem sample code to setup a net connection

perform checklist for net connections
sync:sleep 50
netsel=0
nettotal=checklist quantity()
for a = 1 to nettotal
if checklist string$(a)="Internet TCP/IP Connection For DirectPlay" then netsel=a
next a
if netsel=0 then netsel=nettotal
if netsel=0 then end

chat$=""
add$="IP Address Here"
goto gotip

rem **** USE WHATEVER ENTRY ROUTINE TO LET THE PLAYER SELECT THE IP ADDRESS
rem now let the player enter the IP address they want to use
ask4ip:
ky$=entry$()
if ky$="" then goto msync0
clear entry buffer
if right$(ky$,1)=chr$(13) then add$=chat$:chat$="":goto gotip
if right$(ky$,1)=chr$(8) then chat$=left$(chat$,len(chat$)-1):ky$=""
if len(chat$)>30 then ky$="":goto msync0
chat$=chat$+ky$
ky$=""
msync0:
ink rgb(255,255,255),0
text 10,10,"Enter IP address to connect to: "+chat$+"_"
sync
goto ask4ip

gotip:
sleep 500
ky$=""
rem now let the player select the name they want to use
ask4name:
ky$=entry$()
if ky$="" then goto msync1
clear entry buffer
if right$(ky$,1)=chr$(13) then goto gotname
if right$(ky$,1)=chr$(8) then playername$=left$(playername$,len(playername$)-1):ky$=""
if len(playername$)>10 then ky$="":goto msync1
playername$=playername$+ky$
ky$=""
msync1:
ink rgb(255,255,255),0
rem text 10,10,"IP Address selected: "+add$
text 10,20,"Enter the name you want to use: "+playername$+"_"
sync
goto ask4name


gotname:
rem **** ESTABLISH MULTIPLAYER CONNECTION

for i = 0 to 5
text 10,50,"Establishing connection to: "+add$
sync
next i
set net connection netsel,add$
for i = 0 to 5
text 10,70,"Connection established..."
sync
next i

rem **** NOW SCAN THE CONNECTION FOR EXISTING GAMES

perform checklist for net sessions
if checklist quantity()<1 then game$="None":goto nogame
game$=checklist string$(1)
nogame:
host=0
if game$="None" then host=1:goto setashost

rem if a game doesn't already exit, let the player host (host = 1)

if game$="None" then goto setashost
for i = 0 to 30
text 10,85,"Active session detected on this IP..."
text 10,100,"Joining active session as client..."
sync
next i
join net game 1,playername$

rem now send a greeting message that a new player has joined

for i = 0 to 2
send net message string 0,"MESSAGE="+playername$+" has joined the game!"
sync
next i
cls

rem get general timer for exchange rate

tmm=timer()
oldtmm=tmm
goto multimain

setashost:

rem if game$="None" then this section starts a new game on this IP address
rem The 8 is the maximum number of players, 1 is for peer-to-peer
rem client/server is another connection option which routes all data
rem traffic through the host's computer instead of letting each player's
rem system talk directly to every other player's system

for i = 0 to 70
text 10,85,"No session detected on this IP..."
text 10,100,"Creating multiplayer session as host..."
sync
next i
create net game "Multiplayer Game #1",playername$,8,1
cls
tmm=timer()
oldtmm=tmm

start:

multimain:
ink rgb(255,255,255),0
text 300,0,"Use Arrow keys to move around..."
text 300,20,"Type text messages and press enter to send..."
rem get a continuous list of all players
text 10,10,"Current players:"
perform checklist for net players
totalplayers=checklist quantity()
for i = 1 to totalplayers
rem now save each player's unique ID number to the MPGOT array
rem to help keep track of each specific player more accurately
mpgot(i-1)=checklist value b(i)
rem grab the name of each player in the session
name$=checklist string$(i)
rem if name on the list matches this player, get the unique ID number as
rem we'll need it later for transmitting packets
if name$=playername$ then playernum=checklist value b(i)
rem display each name in the upper left of the screen
text 10,10+(i*10),name$
next i



rem display any messages in the chatbox queue
for i = 0 to 13
text 10,200+(i*10),zchat$(i)
next i

rem rpackets is how many packets we're receiving this cycle, if we receive
rem a packet, we want to skip sending a packet for this sync.  this helps
rem reduce packet overload and the resulting lag.
rpackets=0


rem check for disconnect, exit as needed
if net game lost()=1 then for i = 0 to 90:text 10,450,"Connection lost...":sync:next i:end


rem search/scan for new messages
keepchecking:
get net message
message$=net message string$()
rem if no net message received, then leave scan routine
if message$="" then goto scrappacket
rem if a message is detected, apply it to the chatbox array line by line
if left$(message$,8)<>"MESSAGE=" then goto notamessage
mess$=right$(message$,len(message$)-8)
rem if it is a duplicate message, just discard
if zchat$(13)=mess$ then goto scrappacket
rem if it's a new message, scroll the chatbox and add the message
for i = 0 to 12:zchat$(i)=zchat$(i+1):next i
zchat$(13)=mess$
rem add one to the received packets variable to indicate we got one
rpackets=rpackets+1
goto baddata


notamessage:
rem **** DATA PACKET RECEIVE ROUTINE
rem lets assign this data packet to a shorter variable, pc$
pc$=message$


rem DECODE MULTIPLAYER PACKET
rem we'll use decod for the character position when analyzing the packet
rem start at the first character
decod=1
rem we'll use plyr$ for the player ID number
rem mx$, my$, and mz$ will be used to store the player's position
rem max$, may$, and maz$ will be used to store the player's rotation angles
rem angle Z is included in this example, but isn't required
rem reset variables to null values every time a packet is received
plyr$="":mx$="":my$="":mz$="":max$="":may$="":maz$=""
rem this routine will scan each packet character until the seperator
rem character is encountered.  Once the seperator is encountered, the
rem variable has been stored and is ready for use.  We'll use "|" as
rem the seperator in our packet structure.  The first step is
rem to get the player ID number this packet is for:
getplayernum:
mpp$=mid$(pc$,decod)
if mpp$="|" then goto setmvplyr else goto nomvplyr
setmvplyr:
decod=decod+1
rem we'll use mvplyr to indentify which player slot this packet is for
mvplyr=-1
for i = 1 to totalplayers
rem now compare the plyr$ result with the numbers we stored in the
rem mpgot array.  Find the one is matches, then identify who the
rem packet is for using the mvplyr variable (will be in the 0-7 range)
rem make sure to stick to string values, if you try to convert the
rem plyr$ variable to a number using val(), you will encounter mismatches
rem because the result can get reduced by several digits.  You can convert
rem large numbers stored in non-string variables to strings, but you
rem can't go the other way without risking inaccurate results.
if plyr$=str$(mpgot(i-1)) then mvplyr=i-1
next i
rem since we received a data packet, add one to our rpackets counter
rpackets=rpackets+1
rem now that we have the player number, continue analyzing the rest of the
rem packet starting with the X position (saved to mx$) of the player
goto getmx
nomvplyr:
plyr$=plyr$+mpp$
decod=decod+1
goto getplayernum
getmx:
mpp$=mid$(pc$,decod)
if mpp$="|" then decod=decod+1:goto getmy
mx$=mx$+mpp$
decod=decod+1
goto getmx
getmy:
mpp$=mid$(pc$,decod)
if mpp$="|" then decod=decod+1:goto getmz
my$=my$+mpp$
decod=decod+1
goto getmy
getmz:
mpp$=mid$(pc$,decod)
if mpp$="|" then decod=decod+1:goto getmax
mz$=mz$+mpp$
decod=decod+1
goto getmz
getmax:
mpp$=mid$(pc$,decod)
if mpp$="|" then decod=decod+1:goto getmay
max$=max$+mpp$
decod=decod+1
goto getmax
getmay:
mpp$=mid$(pc$,decod)
if mpp$="|" then decod=decod+1:goto getmaz
may$=may$+mpp$
decod=decod+1
goto getmay
getmaz:
mpp$=mid$(pc$,decod)
if mpp$="|" then decod=decod+1:goto gotvariables
maz$=maz$+mpp$
decod=decod+1
goto getmaz


gotvariables:
rem Now position the identified player's object where it needs to be
if mvplyr=-1 then goto baddata
mppx#=val(mx$)
mppy#=val(my$)
mppz#=val(mz$)
mpmx#=val(max$)
mpmy#=val(may$)
mpmz#=val(maz$)
position object 10+mvplyr,mppx#,mppy#,mppz#
rotate object 10+mvplyr,mpmx#,mpmy#,mpmz#:scale object 10+mvplr,200,200,200
rem if we receive a packet for a player not currently visible, show object
rem if a player leaves, you can detect that event and hide the object
if object visible(10+mvplyr)=0 then show object 10+mvplyr


baddata:
rem then check for any remaining messages
if net message exists()=1 then goto keepchecking

scrappacket:

rem monitor any chat messages the player enters to broadcast to other players
text 10,400,">"+chat$+"_"
ky$=entry$()
if ky$="" then goto msync2
clear entry buffer
if right$(ky$,1)=chr$(13) then chatb$=chat$:chat$="":broadcast=3:goto msync2
if right$(ky$,1)=chr$(8) then chat$=left$(chat$,len(chat$)-1):ky$=""
if len(chat$)>55 then ky$="":goto msync2
chat$=chat$+ky$
ky$=""
msync2:


if broadcast=0 or rpackets>0 then goto skipbroad
tmm=timer()
if tmm<oldtmm+packetrate then goto nodatapacket
rem send message packet 3 times to make sure it gets delivered
send net message string 0,"MESSAGE="+chatb$
rem now on the last send, add this message to the chatbox as needed
if broadcast=1 then for i = 0 to 12:zchat$(i)=zchat$(i+1):next i:zchat$(13)=chatb$
broadcast=broadcast-1
oldtmm=timer()
goto nodatapacket
skipbroad:

rem **** SEND DATA PACKET ROUTINE
rem if no message is being sent, send data packet instead
rem you can also just send a data packet right after a message packet,
rem just wait until after the next sync before doing so.
rem this also runs a slightly higher risk of causing lag, but maintains
rem gamestate data a little better at low exchange rates
tmm=timer()
rem if the packetrate time hasn't been reached yet, delay sending data
rem to prevent overloading the connection and causing lag
if tmm<oldtmm+packetrate or rpackets>0 then goto nodatapacket
rem now generate a data packet with this player's position and
rem rotation using the | character as a seperator for the variables
pc$=str$(playernum)+"|"

pc$=pc$+str$(object position x(8))+"|"
pc$=pc$+str$(object position y(8))+"|"
pc$=pc$+str$(object position z(8))+"|"
pc$=pc$+str$(object angle x(8))+"|"
pc$=pc$+str$(object angle y(8))+"|"
pc$=pc$+str$(object angle z(8))+"|"

send net message string 0,pc$
oldtmm=timer()

nodatapacket:


`move the object


s#=1
a#=1
dist#=50 : ` distance camera sohuld be behind player
height#=20 : ` height above player that camera should be
smooth=10 : ` smoothing value

   if upkey() then move object 8,s#
   if downkey() then move object 8,-s#
   if leftkey() then yrotate object 8,wrapvalue(object angle y(8)-a#)
   if rightkey() then yrotate object 8,wrapvalue(object angle y(8)+a#)

   set camera to follow object position x(8),object position y(8),object position z(8),object angle y(8),dist#,height#,smooth,0
   set object 8,1,0,0,0,0,0,0

rem recenter sky sphere
position object 4,camera position x(),camera position y(),camera position z()

rem now we're ready to update the gamestate and refresh the screen
sync
goto multimain