I have a great Multiplayer example. Although I've been doing a lot of work on it so It's very messy and almost imposible to understand even for me, and it isn't commented. However try it out anyway, and if you want I might be able to clean it up, explain it, or comment.
I have several versions of this program so I'm not sure if this one has all the features but it does at least have basic multiplayer, you can even play accross the internet with or without LAN I've tested both. Or what's usually a lot faster, is just run the program twice, once as host, then again and connect to yourself.
My final version has chat in game, admin abilities, like kicking other players out of game if admin and making other players admin. There is also dedicated hosting, and Server side maps loading. Server side maps, means that other players joining the game don't have to have a copy of the map all they get the info from the host server.
Anyway here is a version of it, not sure if it's the best one:
print "Searching for connections..."
perform checklist for net connections
for i=1 to checklist quantity()
if checklist string$(i)="Internet TCP/IP Connection For DirectPlay" then netsel=i
next i
print " connection found"
print ""
input "Please enter address: ",ip$
print ""
print "Connecting..."
set net connection netsel,ip$
print " connected"
print ""
print "Searching for server..."
perform checklist for net sessions
print " server found" : cls
print "[ ",checklist quantity()," ] SERVERS FOUND"
for i=1 to checklist quantity()
print i,". ",checklist string$(i)
next i
print "" : input "(1)JOIN / (2)CREATE: ",netsel
if netsel=1
host=0 : flag=1
input "Join which server?: ",s
input "Player name: ",name$
join net game s,name$
cls : print "Joining..."
endif
if netsel=2
host=1
input "Server name: ",s$
input "Player name: ",name$
input "Max # of players: ",num
input "Dedicated? (0)NO / (1)YES ",flag : inc flag
create net game s$,name$,num,flag
cls : print "Creating..."
endif
print " done"
admin=0
if host=1 then admin=1
if host=1
` NORMAL MAP LOADING ROUTINE HAS BEEN REMOVE
` FOR THE SAKE OF THIS EXAMPLE AND HAS THE MAP
` ALREADY WRITTEN BELLOW.
` input "Name of map to load: ",map$
` open to read 1,map$
` make memblock from file 3,1
make memblock 3,
write memblock byte 3,0,0
write memblock byte 3,1,1
write memblock byte 3,2,100
write memblock float 3,3,100
write memblock float 3,7,100
write memblock float 3,11,0
write memblock float 3,15,0
write memblock float 3,19,0
write memblock float 3,23,90
write memblock float 3,27,0
write memblock float 3,31,0
close file 1
tc=get memblock size(3)
if flag=1 then gosub _build
endif
if host=0
mymessage$="sr"
send net message string 0,mymessage$
t=0
repeat
get net message
if net message exists()=1
if net message type()=3
message$=net message string$()
if left$(message$,2)="sm"
t$=right$(message$,len(message$)-2)
tc$=""
tt$=""
do
tc$=left$(t$,1)
t$=right$(t$,len(t$)-1)
if tc$="," then exit
tt$=tt$+tc$
loop
tt=val(tt$)
tc=val(t$)
make memblock 3,tc
th=0
repeat
get net message
if net message exists()=1
if net message type()=4
net message memblock 3
if memblock byte(3,0)=tt
gosub _build
th=1
endif
endif
endif
until th=1
t=1
endif
endif
endif
until t=1
endif
print "get id."
id=1
if flag=2 then id=17
if flag=1
dim players(16)
for x=1 to 16
players(x)=0
next x
mymessage$="ss"
send net message string 0,mymessage$
wait 5000
_id:
get net message
if net message exists()=1
if net message type()=3
message$=net message string$()
if left$(message$,2)="si"
t$=right$(message$,len(message$)-2)
t=val(t$)
players(t)=1
endif
endif
goto _id
endif
for x=1 to 16
if players(x)=1
make object cube x,10
endif
next x
for x=1 to 16
if players(x)=0
id=x
exit
endif
next x
players(id)=1
endif
sync on : sync rate 30 : autocam off : hide mouse
dim messages$(10)
m=1
mymessage$="[ "+name$+" ] HAS JOINED THE SERVER."
messages$(0)=mymessage$
mymessage$="m"+mymessage$
send net message string 0,mymessage$
make memblock 1,17
make memblock 2,17
typing=0
if flag=1
do
rotate camera 0,camera angle x(0)+mousemovey(),camera angle y(0)+mousemovex(),0
if keystate(17)=1 then move camera 0,1
if keystate(31)=1 then move camera 0,-1
if keystate(32)=1 then yrotate camera 0,camera angle y(0)+90 : move camera 0,1 : yrotate camera 0,camera angle y(0)-90
if keystate(30)=1 then yrotate camera 0,camera angle y(0)-90 : move camera 0,1 : yrotate camera 0,camera angle y(0)+90
if (keystate(20)=1 or typing=1)
if typing=0
repeat : until keystate(20)=0
clear entry buffer
dmessage$="say "
typing=1
endif
emessage$=entry$()
mymessage$=dmessage$+emessage$
if keystate(14)=1
repeat : until keystate(14)=0
dmessage$=dmessage$+(left$(emessage$,len(emessage$)-2))
if (left$(emessage$,len(emessage$)-2))=""
dmessage$=left$(dmessage$,len(dmessage$)-1)
endif
clear entry buffer
endif
text 10,300,mymessage$
if returnkey()=1
clear entry buffer
repeat : until returnkey()=0
if admin=1
if left$(mymessage$,10)=lower$("playerlist")
mymessage$="sh"
send net message string 0,mymessage$
endif
if left$(mymessage$,5)=lower$("kick ")
t$=mymessage$ : t$=right$(mymessage$,len(mymessage$)-5)
mymessage$="sk"+t$
send net message string 0,mymessage$
endif
if left$(mymessage$,6)=lower$("admin ")
t$=mymessage$ : t$=right$(mymessage$,len(mymessage$)-6)
mymessage$="sa"+t$
send net message string 0,mymessage$
endif
endif
if left$(mymessage$,4)=lower$("say ")
mymessage$=right$(mymessage$,len(mymessage$)-4)
mymessage$=name$+": "+mymessage$
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=mymessage$
else
messages$(m)=mymessage$ : inc m
endif
mymessage$="m"+mymessage$
send net message string 0,mymessage$
endif
typing=0
endif
endif
x#=camera position x(0)
z#=camera position z(0)
position camera 0,x#,5,z#
ax#=camera angle x(0)
ay#=camera angle y(0)
write memblock byte 1,0,id
write memblock float 1,1,x#
write memblock float 1,5,z#
write memblock float 1,9,ax#
write memblock float 1,13,ay#
send net message memblock 0,1,0
_new:
get net message
if net message exists()=1
messagetype=net message type()
if messagetype=4
net message memblock 2
player=memblock byte(2,0)
if player<17
if player>0
if object exist(player)=0
make object cube player,10
endif
if players(player)=0
show object player
players(player)=1
endif
endif
endif
x#=memblock float(2,1)
z#=memblock float(2,5)
ax#=memblock float(2,9)
ay#=memblock float(2,13)
if player<17
if player>0
position object player,x#,5,z#
rotate object player,ax#,ay#,0
endif
endif
endif
if messagetype=3
message$=net message string$()
if message$>""
if left$(message$,1)="s"
if left$(message$,2)="ss"
mymessage$="si"+str$(id)
send net message string 0,mymessage$
endif
if left$(message$,2)="sh"
mymessage$="sn"+str$(id)+","+name$
send net message string 0,mymessage$
endif
if left$(message$,2)="sl"
t$=right$(message$,1)
t=val(t$)
hide object t
players(t)=0
endif
if left$(message$,2)="sr"
if host=1
mymessage$="sm"+str$(id)+","+str$(get memblock size(3))
send net message string 0,mymessage$
write memblock byte 3,0,id
send net message memblock 0,3,0
endif
endif
if left$(message$,2)="sa"
message$=right$(message$,len(message$)-2)
if val(message$)=id
admin=1
mymessage$="m[ "+name$+" ]HAS BEEN MADE A SERVER ADMIN."
send net message string 0,mymessage$
mymessage$="YOU HAVE BEEN MADE A SERVER ADMINISTRATOR."
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=mymessage$
else
messages$(m)=mymessage$ : inc m
endif
endif
endif
if left$(message$,2)="sk"
message$=right$(message$,len(message$)-2)
if val(message$)=id
if admin=0
mymessage$="m[ "+name$+" ]WAS KICKED FROM SERVER BY ADMIN."
send net message string 0,mymessage$
cls : text 10,10,"YOU HAVE BEEN KICK OUT OF SERVER BY AN ADMIN."
text 10,25,"PRESS ANY KEY TO END APP."
wait key
end
endif
else
t=val(message$)
players(t)=0
hide object t
endif
endif
if left$(message$,2)="sn"
message$=right$(message$,len(message$)-2)
tc$=""
tt$=""
do
tc$=left$(message$,1)
message$=right$(message$,len(message$)-1)
if tc$="," then exit
tt$=tt$+tc$
loop
message$="name=[ "+message$+" ] : id=[ "+tt$+" ]"
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=message$
else
messages$(m)=message$ : inc m
endif
endif
endif
if left$(message$,1)="m"
message$=right$(message$,len(message$)-1)
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=message$
else
messages$(m)=message$ : inc m
endif
endif
endif
endif
goto _new
endif
for x=0 to 9
text 10,10+(x*20),messages$(x)
next x
sync : loop
endif
if flag=2
show mouse : show window : set window on : set window size 640,480
set window title "RUNNING: "+s$+" - DEDICATED"
cls
messages$(1)="Game started."
messages$(2)="type 'say<space>message to send a message to players."
m=3
clear entry buffer
do : cls
emessage$=entry$()
hostmessage$=dmessage$+emessage$
if keystate(14)=1
repeat : until keystate(14)=0
dmessage$=dmessage$+(left$(emessage$,len(emessage$)-2))
if (left$(emessage$,len(emessage$)-2))=""
dmessage$=left$(dmessage$,len(dmessage$)-1)
endif
clear entry buffer
endif
text 10,300,hostmessage$
if returnkey()=1
clear entry buffer
dmessage$=""
emessage$=""
repeat : until returnkey()=0
if left$(hostmessage$,4)=lower$("say ")
hostmessage$="<remoteHost: "+name$+"> "+hostmessage$
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=hostmessage$
else
messages$(m)=hostmessage$ : inc m
endif
hostmessage$="m"+hostmessage$
send net message string 0,hostmessage$
endif
if left$(hostmessage$,10)=lower$("playerlist")
hostmessage$="sh"
send net message string 0,hostmessage$
endif
if left$(hostmessage$,5)=lower$("kick ")
t$=hostmessage$ : t$=right$(hostmessage$,len(hostmessage$)-5)
hostmessage$="sk"+t$
send net message string 0,hostmessage$
endif
if left$(hostmessage$,6)=lower$("admin ")
t$=hostmessage$ : t$=right$(hostmessage$,len(hostmessage$)-6)
hostmessage$="sa"+t$
send net message string 0,hostmessage$
endif
endif
_hostmessages:
get net message
if net message exists()=1
if net message type()=3
message$=net message string$()
if left$(message$,1)="s"
if left$(message$,2)="sn"
message$=right$(message$,len(message$)-2)
tc$=""
tt$=""
do
tc$=left$(message$,1)
message$=right$(message$,len(message$)-1)
if tc$="," then exit
tt$=tt$+tc$
loop
message$="name=[ "+message$+" ] : id=[ "+tt$+" ]"
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=message$
else
messages$(m)=message$ : inc m
endif
endif
if left$(message$,2)="sr"
if host=1
hostmessage$="sm"+str$(id)+","+str$(get memblock size(3))
send net message string 0,hostmessage$
write memblock byte 3,0,id
send net message memblock 0,3,0
endif
endif
endif
if left$(message$,1)="m"
message$=right$(message$,len(message$)-1)
if m=10
for x=0 to 8
messages$(x)=messages$(x+1)
next x
messages$(9)=message$
else
messages$(m)=message$ : inc m
endif
endif
endif
endif
for x=0 to 9
text 10,10+(x*20),messages$(x)
next x
sync : loop
endif
_build:
done=0
x=1
repeat
obj=memblock byte(3,x) : inc x
select obj
case 1
n=memblock byte(3,x) : inc x
w#=memblock float(3,x) : x=x+4
h#=memblock float(3,x) : x=x+4
x#=memblock float(3,x) : x=x+4
y#=memblock float(3,x) : x=x+4
z#=memblock float(3,x) : x=x+4
ax#=memblock float(3,x) : x=x+4
ay#=memblock float(3,x) : x=x+4
az#=memblock float(3,x) : x=x+4
make object plain n,w#,h#
position object n,x#,y#,z#
rotate object n,ax#,ay#,az#
endcase
case 2
n=memblock byte(3,x) : inc x
s#=memblock float(3,x) : x=x+4
x#=memblock float(3,x) : x=x+4
y#=memblock float(3,x) : x=x+4
z#=memblock float(3,x) : x=x+4
ax#=memblock float(3,x) : x=x+4
ay#=memblock float(3,x) : x=x+4
az#=memblock float(3,x) : x=x+4
make object cube n,s#
position object n,x#,y#,z#
rotate object n,ax#,ay#,az#
endcase
case 3
n=memblock byte(3,x) : inc x
w#=memblock float(3,x) : x=x+4
h#=memblock float(3,x) : x=x+4
d#=memblock float(3,x) : x=x+4
x#=memblock float(3,x) : x=x+4
y#=memblock float(3,x) : x=x+4
z#=memblock float(3,x) : x=x+4
ax#=memblock float(3,x) : x=x+4
ay#=memblock float(3,x) : x=x+4
az#=memblock float(3,x) : x=x+4
make object box n,w#,h#,d#
position object n,x#,y#,z#
rotate object n,ax#,ay#,az#
endcase
case 4
n=memblock byte(3,x) : inc x
s#=memblock float(3,x) : x=x+4
x#=memblock float(3,x) : x=x+4
y#=memblock float(3,x) : x=x+4
z#=memblock float(3,x) : x=x+4
ax#=memblock float(3,x) : x=x+4
ay#=memblock float(3,x) : x=x+4
az#=memblock float(3,x) : x=x+4
make object sphere n,s#
position object n,x#,y#,z#
rotate object n,ax#,ay#,az#
endcase
case 5
n=memblock byte(3,x) : inc x
s#=memblock float(3,x) : x=x+4
x#=memblock float(3,x) : x=x+4
y#=memblock float(3,x) : x=x+4
z#=memblock float(3,x) : x=x+4
ax#=memblock float(3,x) : x=x+4
ay#=memblock float(3,x) : x=x+4
az#=memblock float(3,x) : x=x+4
make object cylinder n,s#
position object n,x#,y#,z#
rotate object n,ax#,ay#,az#
endcase
endselect
if x=tc then done=1
until done=1
return
by the way, I'm eventually planning on making all the commands into simple functions, so people can put it into their games much easier.
I would first like to put it into a DLL if that's possible. So if anyone knows how to put DBPro commands into a DLL please let me know, if it's even possible.
