Generic Multiplayer by Overdroid1st Mar 2004 22:02
|
|---|
|
Summary A generic multiplayer demo. You can move around and see each other. Description March 1st 2004 Code ` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
Rem Project: Generic Multiplayer
Rem Created: 3/1/04 5:41:54 PM
Rem Joseph Limbaugh - OVERDROID on the DBP forums
REM www.overdroid.com
REM VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES
REM VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES
REM VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES VARIABLES
A_VARIABLES:
#Constant FORWARD = 0
#Constant BACK = 1
#Constant TLEFT = 2
#Constant TRIGHT = 3
#Constant SLEFT = 4
#Constant SRIGHT = 5
type PLAYERTYPE
Active
Name$
Chatcolor
Playerform
Heartbeat
Oldbeat
Syncs
X#
Y#
Z#
YA#
XA#
OX#
OY#
OZ#
OYA#
OXA#
SX#
SY#
SZ#
SYA#
SXA#
Moving
Gravity#
endtype
make memblock 1,40
global tdifference#
null=make vector3(1)
version$="BETA TEST"
dim text$(15)
dim textfade(15,2)
dim mousebox(12,3)
dim key$(230)
dim scan(12)
dim players(10) as PLAYERTYPE
dim color(10)
color(0)=rgb(255,0,0)
color(1)=rgb(0,255,0)
color(2)=rgb(0,0,255)
color(3)=rgb(255,255,0)
color(4)=rgb(255,0,255)
color(5)=rgb(0,255,255)
color(6)=rgb(128,128,128)
color(7)=rgb(255,128,128)
color(8)=rgb(128,255,128)
color(9)=rgb(128,128,255)
color(10)=rgb(255,255,255)
REM LOADING SCREEN LOADING SCREEN LOADING SCREEN LOADING SCREEN LOADING SCREEN
REM LOADING SCREEN LOADING SCREEN LOADING SCREEN LOADING SCREEN LOADING SCREEN
REM LOADING SCREEN LOADING SCREEN LOADING SCREEN LOADING SCREEN LOADING SCREEN
A_LOADINGSCREEN:
set window on
set display mode 640,480,16
set window title "GENERIC MULTIPLAYER"
set window position 10,10
sync on : sync rate 60
autocam off
INK RGB(255,255,255),RGB(0,0,0)
cls
set text size 24
center text 320,260,"Version "+version$
set text size 32
set text to bold
center text 320, 20,"GENERIC MUTLIPLAYER"
INK RGB(255,0,0),0
center text 320,340,"SETTING UP - HANG ON!"
INK RGB(255,255,255),0
sync:sync
create bitmap 1,130,130 :ink RGB(255,255,255),RGB(0,0,0)
for z=1 to 90 step 5: x#=sin(z): circle 64,64,(64*x#)
next z : get image 1,1,1,129,129 :set current bitmap 0
Make matrix 1,10000,10000,20,20
Prepare matrix texture 1,1,1,1
Fill matrix 1,0,1
sync
minimize window
restore window
REM SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP
REM SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP
REM SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP SETUP
A_SETUP:
for x= 1 to 83
read key$(x)
next x
key$(156)="Keypad: Enter"
for x= 200 to 211
read key$(x)
next x
for x= 219 to 221
read key$(x)
next x
key$(225)="Left Mouse Button"
key$(226)="Right Mouse Button"
key$(227)="Mouse Wheel UP"
key$(228)="Mouse Wheel DOWN"
Key$(229)="Middle Mouse Button"
scan(FORWARD) = 200
scan(BACK) = 208
scan(TLEFT) = 211
scan(TRIGHT) = 209
scan(SLEFT) = 203
scan(SRIGHT) = 205
set ambient light 60
fog on
fog color 0
fog distance 1000
color backdrop 0
make object triangle 1,1,2,3,1,2,3,1,2,3
hide object 1
position object 1,100,20,0
online=0
playername$="ME"
ip$="000.000.000.000"
playerform=0
playercolor=rgb(250,20,20)
if file exist("data.txt")
open to read 1,"data.txt"
read string 1,playername$
read string 1,ip$
endif
gosub save_params
for x=0 to 10
make object cylinder 200+x,20
color object 200+x,color(x)
make object sphere 250+x,20,6,6
texture object 250+x,1
move object up 250+x,10
glue object to limb 250+x,200+x,0
hide object 200+x
hide object 250+x
next x
REM MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU
REM MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU
REM MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU MAIN MENU
A_MENULOOP:
position camera 28,60,50
point camera 28,40,0
chat$=""
set text to bold
set text size 32
do
if returnkey()=1
INK color(10),0
center text 320,100,"SEARCHING FOR NET GAME"
sync
gosub A_ONLINE_SETUP
if online=1
gosub A_GAMELOOP
endif
endif
INK color(0),0
center text 320,120,"NAME: "+playername$
center text 320,160,"HOST IP: "+ip$
INK RGB(255,20,20),RGB(0,0,0)
center text 320,300,"HIT ENTER TO"
center text 320,330,"SEARCH FOR GAME"
if escapekey()=1 then end
sync
loop
REM ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP
REM ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP
REM ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP ONLINE SETUP
A_ONLINE_SETUP:
perform checklist for net connections
sleep 50
nettotal=checklist quantity()
for a = 1 to nettotal
if checklist string$(a)="Internet TCP/IP Connection For DirectPlay" then netsel=a
next a
set net connection netsel,ip$
rem check for active games on the IP address the player just connected to
perform checklist for net sessions
sleep 50
if checklist quantity()=0
INK RGB(255,255,255),RGB(0,0,0)
center text 320,100,"NO GAME FOUND AT IP"
center text 320,140,"Hit ENTER to create game"
center text 320,180,"Hit SPACEBAR to return"
minimize window
restore window
sync:x=0
repeat
if escapekey() then end
if returnkey()
center text 320,50,"CREATING GAME"
create net game "MULTIPLAY",playername$,8,1
sync
sleep 50
online=1
x=1
endif
if spacekey()
x=1
endif
until x=1
else
game$=checklist string$(1)
online=1
center text 320,100,"JOINING GAME"
minimize window
restore window
sync
join net game 1,playername$
sleep 50
gosub SENDJOINMESSAGE
endif
return
REM GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP
REM GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP
REM GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP GAMELOOP
A_GAMELOOP:
fadetime=timer()
update=timer()
set text size 18
camlook#=0
syncs=1
position object 1,0,0,0
repeat
t1#=timer()
gosub CHECKNETMESSAGE
moving=0
if chat$="" then chatmode=0
if chatmode=1
chat$=chat$ + entry$()
clear entry buffer
if (scancode()=14) and chat$>""
chat$=left$(chat$,len(chat$)-1)
endif
if asc(right$(chat$,1))=13
send net message string 0,chat$
message$=chat$
chatcolor=mychatcolor
gosub scroll
chat$=""
endif
else
if keystate(scan(FORWARD))=1 then move object 1,toff(.6):moving=1
if keystate(scan(BACK))=1 then move object 1,toff(-.6):moving=1
if keystate(scan(SLEFT))=1 then move object left 1,toff(.6):moving=1
if keystate(scan(SRIGHT))=1 then move object right 1,toff(.6):moving=1
if spacekey()=1 then chatmode=1 : chat$=">"
endif
yrotate object 1,(object angle y(1)+toff((.1 * mousemovex())))
camlook#=camlook#+toff((.1 * mousemovey()))
if camlook#>50 then camlook#=50
if camlook#<-80 then camlook#=-80
gosub MOVEENEMYPLAYERS
camx# = object position x(1) : camy# = object position y(1) : camz# = object position z(1)
camrx# = object angle x(1): camry# = object angle y(1): camrz# = object angle z(1)
position camera camx#, camy#+20, camz#
rotate camera camrx#+camlook#, camry#, camrz#
gosub drawtext
sync
if fadetime<timer()
fadetime=timer()+150
for x= 0 to 15
textfade(x,0)=textfade(x,0)-1
if textfade(x,0)<1 then text$(x)=""
next x
endif
if update<timer()
update=timer()+100
gosub SENDSTATUSMESSAGE
endif
if playercheck<timer()
playercheck=timer()+2000
gosub UPDATEPLAYERLIST
endif
inc syncs
t2#=timer()
tdifference#=t2#-t1#
until chatmode>1
set text size 32
return
REM SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES
REM SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES
REM SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES SUBROUTINES
A_SUBROUTINES:
scroll:
for x=0 to 14
text$(x)=text$(x+1)
textfade(x,0)=textfade(x+1,0)
textfade(x,1)=textfade(x+1,1)
next x
text$(15)=message$
textfade(15,0)=50
if chatcolor=0 then chatcolor=rgb(20,20,255)
textfade(15,1)=chatcolor
return
drawtext:
for x=0 to 15
ink textfade(x,1),0
text 10,60+(x*20),text$(x)
next x
ink rgb(255,50,50),0
text 10,380,chat$
return
save_params:
if file exist("data.txt") then delete file "data.txt"
open to write 1,"data.txt"
write string 1,playername$
write string 1,ip$
close file 1
return
SENDJOINMESSAGE:
write memblock byte 1,1,1
write memblock word 1,2,mychatcolor
send net message memblock 0,1,1
return
SENDSTATUSMESSAGE:
if orientation>3 then camry#=camrz#
write memblock byte 1,1,2
write memblock float 1,2,camx#
write memblock float 1,6,camy#
write memblock float 1,10,camz#
write memblock float 1,14,camry#
write memblock float 1,18,camlook#
write memblock float 1,22,timer()
write memblock float 1,26,syncs
write memblock byte 1,30,moving
syncs=1
send net message memblock 0,1
return
CHECKNETMESSAGE:
get net message
while net message exists()=1
ID=net message player from()
if net message type()=3
message$=net message string$()
if message$>""
chatcolor=color(ID)
gosub scroll
endif
else
if net message type()=4
net message memblock 1
message_tag=memblock byte(1,1)
if message_tag=2
players(ID).Oldbeat=players(ID).Heartbeat
players(ID).Heartbeat=memblock float(1,22)
if players(ID).Oldbeat<players(ID).Heartbeat
players(ID).OX#=players(ID).X#
players(ID).OY#=players(ID).Y#
players(ID).OZ#=players(ID).Z#
players(ID).OYA#=players(ID).YA#
players(ID).OXA#=players(ID).XA#
players(ID).X#=memblock float(1,2)
players(ID).Y#=memblock float(1,6)
players(ID).Z#=memblock float(1,10)
players(ID).YA#=memblock float(1,14)
players(ID).XA#=memblock float(1,18)+90
players(ID).Syncs=memblock float(1,26)
players(ID).Moving=memblock byte(1,30)
position object 200+ID,players(ID).X#,players(ID).Y#,players(ID).Z#
yrotate object 200+ID,players(ID).YA#
xrotate object 250+ID,players(ID).XA#
show object 200+ID
show object 250+ID
players(ID).SXA#=mywrap((players(ID).XA#-players(ID).OXA#))/players(ID).syncs
players(ID).SYA#=mywrap((players(ID).YA#-players(ID).OYA#))/players(ID).syncs
players(ID).SY#=0
if players(ID).Moving=1
players(ID).SX#=(players(ID).X#-players(ID).OX#)/players(ID).syncs
players(ID).SZ#=(players(ID).Z#-players(ID).OZ#)/players(ID).syncs
else
players(ID).SX#=0
players(ID).SZ#=0
endif
players(ID).Active=1
endif
else
REM RECIEVED JOIN MESSAGE
players(ID).Chatcolor=memblock float(1,2)
show object 200+ID
show object 250+ID
gosub UPDATEPLAYERLIST
if message_tag=1
write memblock byte 1,1,3
write memblock word 1,2,mychatcolor
send net message memblock ID,1,1
message$=players(ID).Name$+" HAS JOINED THE ARENA!"
chatcolor=color(ID)
gosub scroll
endif
endif
endif
endif
get net message
endwhile
return
MOVEENEMYPLAYERS:
for x= 1 to 10
if players(x).Active=1
yrotate object 200+x,wrapvalue((object angle y(200+x)+players(x).SYA#))
players(x).SYA#=curvevalue(0,players(x).SYA#,players(x).syncs)
xrotate object 250+x,wrapvalue((object angle x(250+x)+players(x).SXA#))
players(x).SXA#=curvevalue(0,players(x).SXA#,players(x).syncs)
players(x).X#=players(x).X#+players(x).SX#
players(x).SX#=curvevalue(0,players(x).SX#,players(x).syncs)
players(x).Y#=players(x).Y#+players(x).SY#
players(x).Z#=players(x).Z#+players(x).SZ#
players(x).SZ#=curvevalue(0,players(x).SZ#,players(x).syncs)
position object 200+x, players(x).X#,players(x).Y#,players(x).Z#
endif
next x
return
UPDATEPLAYERLIST:
for i = 1 to 10
players(i).Active=0
next i
perform checklist for net players
for i = 1 to checklist quantity()
players(checklist value a(i)).Name$=checklist string$(i)
players(checklist value a(i)).Active=1-checklist value c(i)
next i
return
A_DATA:
data "Escape","1","2","3","4","5","6","7","8","9","0","-","+","Backspace","Tab","Q","W","E","R","T","Y","U","I","O","P"
data "[","]","Enter","Left Control","A","S","D","F","G","H","J","K","L",";","'","`"
data "Left Shift","","Z","X","C","V","B","N","M",",",".","/","Right Shift","Keypad: *"
data "Left Alt","SPACE","Caps Lock","F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"
data "Keypad: 7","Keypad: 8","Keypad: 9","Keypad: -","Keypad: 4","Keypad: 5","Keypad: 6"
data "Keypad: +","Keypad: 1","Keypad: 2","Keypad: 3","Keypad: 0","Keypad: ."
REM KEYPAD ENTER is 156 - not listed above
REM These are from 200 on
data "Arrow UP","Page UP","SC202","Arrow LEFT","SC204","Arrow RIGHT","SC206","End","Arrow DOWN"
data "Page Down","Insert","Delete"
REM These are from 219 on
data "Left Window","Right Window","Menu"
A_MYFUNCTIONS:
function toff(value#)
result# = value#*(tdifference#/10)
endfunction result#
function mywrap(value#)
if value#>180 then value#=value#-180
if value#<-180 then value#=value#+180
endfunction value#
A_NOTES:
|