That code runs fine here.
[edit] Here is my entire .dba file contents when running. I had to remove your absoute paths from the code and the exe name though.
sync on:sync rate 0
hide mouse
`init mouseout function
mouseout(0)
`set main menu
phase = 0
`set dir "D:\Documents and Settings\Yiannis Voyias\Desktop\DBP\delete\"
`image plan
`1 pointer
`2 sp main menu
`3 quite main menu
`use memblock command for sparky dll
temp = MEMBLOCK EXIST(1)
`this array is a timer array to be used for all the browsing of hmenus...
`since the wait command is messy/ugly,because the user sees any moving stuff stop
`also (to be)used in the scrolling of the games list
dim hbrowse(1)
`initialize memory/arrays for usage of 4 textfields
txtfinit(3,200)
`initialize memory/arrays for usage of 6 horizontal menus with max items 5
hminit(8,4,150)
`add items to menus
`menu0 :: Max players
addhm(0,0,"2")
addhm(0,1,"3")
addhm(0,2,"4")
addhm(0,3,"5")
addhm(0,4,"6")
`menu1 :: Character(eg.Kenny)
addhm(1,0,"robot")
addhm(1,1,"pirat")
`menu2 :: Level(eg.Monkey castle)
addhm(2,0,"???")
`menu3 :: Proceed/Create Game
addhm(3,0,"YES")
addhm(3,1,"NO")
capvalue(-3)
`type for cannons
type canno
limb as byte
xangle as float
yangle as float
power as byte
status as byte
endtype
`type for other player's 'profile' in multiplayer
type oplayer
name as string
race as string
dmg as integer
power as integer
status as integer
obj as integer
x as float
y as float
z as float
endtype
`let camera see close up
set camera range 0.0001,1000
cleanup = 0
do
`pointer
if image exist(1) = 0 then load image "pointer.png",1,1
sprite 1,mousex(),mousey(),1:set sprite priority 1,1
`----------------------------------main
if phase = 0
`mouseout function
mout = mouseout(1)
`sp
if image exist(2) = 0 then load image "sp.png",2,1
if sprite exist(2) = 0 then sprite 2,100,100,2
`quit
if image exist(3) = 0 then load image "quit.png",3,1
if sprite exist(3) = 0 then sprite 3,100,350,3
`mp
if image exist(4) = 0 then load image "mp.png",4,1
if sprite exist(4) = 0 then sprite 4,100,200,4
`sp
if sprite collision(1,2) = 1
if mout > 0
phase = 1
cleanup = 1
endif
endif
`quit
if sprite collision(1,3) = 1
if mout > 0
for t = 2 to 4
if sprite exist(t) = 1 then delete sprite t
if image exist(t) = 1 then delete image t
next t
mouseout(2)
end
endif
endif
`mp
if sprite collision(1,4) = 1
if mout > 0
phase = 5
cleanup = 1
endif
endif
`cleanup
if cleanup = 1
for t = 2 to 4
if sprite exist(t) = 1 then delete sprite t
if image exist(t) = 1 then delete image t
next t
cleanup = 0
endif
endif
sp_prep:
`---------------------------------------------------------spPrep
if phase = 1
exit prompt "as","Asd" `camera
autocam off
set camera range 0.0001,1000
`level scum bay
load object "models/sbay.x",1
position object 1,0,0,0
`pirat ship
load object "models/pir.x",2
`set start pos at limb on level
position object 2,limb position x(1,3),.5,limb position z(1,3)
`4 cannons
for t= 3 to 6
load object "models/cannon.x",t
next t
`wheel is 7
load object "models/wheel.x",7
`4 enemies
for t = 10 to 13
load object "models/pir.x",t
next t
`sea plain
make object plain 14,300,300
load image "models/sea.jpeg",2000,1
texture object 14,2000
xrotate object 14,270
`--- SPECIAL!!!
`we clear up which limbs are what parts
`for the 4 cannons
dim cannon(3) as canno
for t = 0 to 3
`set init values
cannon(t).xangle = 0
cannon(t).yangle = 0
cannon(t).status = 0
cannon(t).power = 1
next t
cannon(2).power = 3
perform checklist for object limbs 2
for t = 1 to checklist quantity()
if checklist string$(t) = "wheel" then l_wheel = checklist value a(t)
if checklist string$(t) = "cannon1" then cannon(0).limb = checklist value a(t)
if checklist string$(t) = "cannon2" then cannon(1).limb = checklist value a(t)
if checklist string$(t) = "cannon3" then cannon(2).limb = checklist value a(t)
if checklist string$(t) = "cannon4" then cannon(3).limb = checklist value a(t)
next t
empty checklist
`----- vars
movespeed# = 10
`for wheel cam swinging
mousecamx# = object angle x(2)
mousecamy# = object angle y(2)
grav# = 0.0003
hbrowse(1) = timer()
`shows many things like sails and cannon selected
statu$ = "00"
`wheel speed
whspeed# = 0
`go!
phase = 2
f=0
endif
sp_game:
`-----------------------------------------singleplayer
if phase = 2
capvalue(-1)
`if we're at the wheel
if right$(statu$,1) = "0"
`control the ship with WASD
`W puts the sails up
if keystate(17)=1 then statu$ = "1"+right$(statu$,1)
`S brings them down
if keystate(31)=1 then statu$ = "0"+right$(statu$,1)
`turn ship with AD and turn wheel too
if keystate(32)=1 then rotate object 2,0,wrapvalue(object angle y(2)+capvalue(movespeed#)),0:whspeed# = 2
if keystate(30)=1 then rotate object 2,0,wrapvalue(object angle y(2)-capvalue(movespeed#)),0:whspeed# = -2
if timer()-hbrowse(1) > 150
if keystate(41) = 1 then statu$ = left$(statu$,1)+"1":hbrowse(1) = timer()
endif
else
`if we're cannons
if timer()-hbrowse(1) > 150
if val(right$(statu$,1)) < 4
if keystate(41) = 1 then statu$ = left$(statu$,1)+str$(val(right$(statu$,1))+1)
else
if keystate(41) = 1 then statu$ = left$(statu$,1)+"0"
endif
hbrowse(1) = timer()
endif
`allow gunpowder to be added/removed
`store current cannon's no
cno = val(right$(statu$,1))
if cno > 0 and cno <> 5
text 100,250,"frame: "+str$(object frame(cno))
`if cannon's closed allow to open
if object frame(cno) < 50
cannon(cno-1).status = 0
endif
if object frame(cno) = 0
if keystate(17) = 1 then play object cno,0,50
endif
if object frame(cno) => 50
if keystate(31) = 1 then play object cno,50,100
if object frame(cno) = 50
if keystate(30) = 1 then cannon(cno-1).power = cannon(cno-1).power - 1
if keystate(32) = 1 then cannon(cno-1).power = cannon(cno-1).power + 1
if cannon(cno-1).power > 4 then cannon(cno-1).power = 4
if cannon(cno-1).power < 0 then cannon(cno-1).power = 0
endif
endif
`display current sack if any
if cannon(cno-1).power > 0
text 100,350,"gunpowder: "+str$(cannon(cno-1).power)+" sack(s)"
for t = 1 to cannon(cno-1).power
if image exist(t+10) = 0 then load image "img/power.png",t+10,1
if image exist(t+10) = 1 then paste image t+10,10+(50*t),400,1
next t
endif
endif
endif
`wheel inertia effect
if whspeed# > 0
whspeed# = whspeed#-.02
else
if whspeed# < 0
whspeed# = whspeed#+.02
endif
endif
rotate limb 7,0,0,0,limb angle z(7,0)+whspeed#
`ship wind inertia effect
`wind pushes ship unless you put sails down
`if sails up
if left$(statu$,1) = "1"
if movespeed# < 10
movespeed# = movespeed# + .01
endif
else
`if sails down
if movespeed# > 0
movespeed# = movespeed# - .01
endif
endif
`ship feels wind
position object 2,newxvalue(object position x(2),object angle y(2),capvalue(movespeed#)),object position y(2),newzvalue(object position z(2),object angle y(2),capvalue(movespeed#))
`position wheel
position object 7,newxvalue(limb position x(2,l_wheel),object angle y(2),-.1),limb position y(2,l_wheel)+.2,newzvalue(limb position z(2,l_wheel),object angle y(2),-.1)
yrotate object 7,object angle y(2)
`position cannons
for t = 3 to 6
position object t,limb position x(2,cannon(t-3).limb),limb position y(2,cannon(t-3).limb)+.1,limb position z(2,cannon(t-3).limb)
`make sure left side cannons are rotated correctly
if t = 5 or t = 6
rotate object t,cannon(t-3).xangle,object angle y(2)+cannon(t-3).yangle+180,0
else
rotate object t,cannon(t-3).xangle,object angle y(2)+cannon(t-3).yangle,0
endif
next t
`position small sea around ship
position object 14,object position x(2),1,object position z(2)
`camera
`wheel
if right$(statu$,1) = "0"
lno = 7
position camera newxvalue(object position x(lno),object angle y(lno),-1*1.4),object position y(lno)+.5,newzvalue(object position z(lno),object angle y(lno),-1*1.4)
`allow to ogle around with mouse
oldmousecamx# = wrapvalue(mousecamx#)
mousecamx# = wrapvalue(mousecamx# + mousemovey())
`no upside down business though
if mousecamx# >= 90 then mousecamx# = oldmousecamx#
if mousecamx# <= 0 then mousecamx# = oldmousecamx#
mousecamy# = wrapvalue(mousecamy# + mousemovex())
rotate camera mousecamx#,mousecamy#,0
else
`cannons
lno = 2+val(right$(statu$,1))
position camera newxvalue(object position x(lno),object angle y(lno)+90,-1*1.0),object position y(lno)+.2,newzvalue(object position z(lno),object angle y(lno)+90,-1*1.0)
rotate camera object angle x(lno),object angle y(lno)+90,object angle z(lno)
endif
`debug text
text 10,200,"status:"+statu$
endif
`for phase = 2
`----------------------------multiprep
if phase = 5
`make a list of available connections(LAN,ip,etc)
perform checklist for net connections
for netcon=1 to checklist quantity()
`THIS MUST BE CHANGED LATER FOR NON ENGLISH SYSTEMS
if checklist string$(netcon)="Internet TCP/IP Connection For DirectPlay"
set net connection netcon,"127.0.0.1"
netfound=1
else
netfound=0
endif
next netcon
`if no internet connection found then tell the user at least!
`if the cable is out however,no alert is sent to user!
if netfound<>1
messagebox("WARNING","Internet TCP/IP connection not found!",0)
messagebox("","",-1)
endif
`empty the list
empty checklist
`Check if no game exists
perform checklist for net sessions
`set hbrowse timer
hbrowse(1)=timer()
`set var which later controls y pos of each list item
gltext=0
`goto connSEL phase
phase = 6
cls
endif
bingforgames:
`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>----------Browsingforgames
if phase = 6
`return/back
if image exist(1012)=0 then load image "back.png",1012,1
if sprite exist(1012)=0 then sprite 1012,200,screen height()-40,1012
`create button
if image exist(1014)=0 then load image "create.png",1014,1
if sprite exist(1014)=0 then sprite 1014,50,screen height()/6,1014
`refresh button
if image exist(1015)=0 then load image "refresh.png",1015,1
if sprite exist(1015)=0 then sprite 1015,250,screen height()/6,1015
text 100,150,str$(checklist quantity())+" games found(arrows to browse enter to join):"
`list of available games
if checklist quantity()>0
`allow use of arrow keys to select/join a game in the checklist
if gltext>0 and gltext<=checklist quantity()
`enter/return pressed then you join game
if keystate(28)=1
phase = 7
`remove main browseforgames the refresh sprite
if sprite exist(1015)=1 then delete sprite 1015
if image exist(1015)=1 then delete image 1015
`remove main browseforgames the create sprite
if sprite exist(1014)=1 then delete sprite 1014
if image exist(1014)=1 then delete image 1014
empty checklist
`selection var
jsetsel=0
`set hbrowse timer
hbrowse(1)=timer()
`wait for sometime so that you don't end up clicking same thing again
wait 100
endif
`control the scrolling up/down using hbrowse timer array
if timer()-hbrowse(1)>100
`up or right arrow moves selection up
if keystate(200)=1 or keystate(205)=1
gltext=gltext-1
hbrowse(1)=timer()
endif
`down/left takes selection down
if keystate(208)=1 or keystate(203)=1
gltext=gltext+1
hbrowse(1)=timer()
endif
endif
else
if gltext>checklist quantity() then gltext=1
if gltext<=0 then gltext=checklist quantity()
endif
for gameslist = 1 to checklist quantity()
`get level from the flag in the game name
if left$(checklist string$(gameslist),1)="1" then Level$="???"
`get maximum number of players
Maxp$=left$(right$(checklist string$(gameslist),2),1)
if gameslist=gltext
text 80,170+(gameslist)*20,"=> "+right$(checklist string$(gameslist),len(checklist string$(gameslist))-1)
else
text 80,170+(gameslist)*20,right$(checklist string$(gameslist),len(checklist string$(gameslist)))
endif
next gameslist
else
gltext=0
endif
`refresh button
if sprite collision(1,1015)=1 and mouseclick()=1 then perform checklist for net sessions
`-----------------------CREATE GAME
`if sprite collision(1,1014)=1 and mouseclick()=1 then phase=11:csetsel=0
if sprite collision(1,1014)=1 and mouseclick()=1
phase = 8
`get rid of the refresh sprite
delete image 1015
delete sprite 1015
empty checklist
`selection var
csetsel=0
`wait for sometime so that you don't end up clicking same thing again
wait 300
`set level indicator
lvlind$="0"
`set hbrowse timer
hbrowse(1)=timer()
endif
`------------------RETURN TO MAIN MENU
if sprite collision(1,1012)=1 and mouseclick()=1
phase = 0
delete sprite 1012
delete image 1012
delete image 1014
delete sprite 1014
delete image 1015
delete sprite 1015
empty checklist
`wait for sometime so that you don't end up clicking the exit to windows(at same pos)
wait 300
endif
endif
`for browsing for games phase 6
joinformat:
`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>------------------joinformat
if phase = 7
`remove main browseforgames sprites
if sprite exist(1015)=1 then delete sprite 1015
if image exist(1015)=1 then delete image 1015
`remove main browseforgames the create sprite
if sprite exist(1014)=1 then delete sprite 1014
if image exist(1014)=1 then delete image 1014
`load selection sprite
if image exist(1016)=0 then load image "sel.png",1016,1
if sprite exist(1016)=0 then sprite 1016,40,170,1016
`--------------------SETTINGsel
`load rest of models which may need to be displayed
`--------robot
if object exist(1011)=0 then load object "models/pir.x",1011:scale object 1011,40,40,40:position object 1011,object position x(1011),object position y(1011)-1.5,object position z(1011)
`--------pirat
if object exist(1014)=0 then load object "models/pir.x",1014:scale object 1014,40,40,40:position object 1014,object position x(1014),object position y(1014)-1.5,object position z(1014)
`Use WOLF's routine to stop super movement/turning
capvalue(-1)
`allow arrows for browsing and use hbrowse timer
if timer()-hbrowse(1)>100
`up arrow takes selection upwards
if keystate(200)=1
jsetsel=jsetsel-1
hbrowse(1)=timer()
endif
`down arrow takes selection downwards
if keystate(208)=1
jsetsel=jsetsel+1
hbrowse(1)=timer()
endif
endif
`stop stupid/for now useless numbers eg. -2 going into the jsetsel var
if jsetsel<0 then jsetsel=2
if jsetsel>2 then jsetsel=0
`------------Playername
if jsetsel=0
`textfield 1 with max of 50 characters
textfield(1,50)
Pname$=string2$(1,1)
offset sprite 1016,0,-30
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
else
Pname$=string2$(1,2)
endif
`------------Character
if jsetsel=1
offset sprite 1016,0,-60
Pchar$=hm(1,1,-1)
`show char
if Pchar$="robot"
point camera object position x(1011),object position y(1011),object position z(1011)
turn object left 1011,capvalue(20)
if object visible(1011)=0 then show object 1011
if object visible(1014)=1 then hide object 1014
endif
if Pchar$="pirat"
point camera object position x(1014),object position y(1014),object position z(1014)
turn object left 1014,capvalue(20)
if object visible(1011)=1 then hide object 1011
if object visible(1014)=0 then show object 1014
endif
endif
`------------Proceed/Join game
if jsetsel=2
Proceed$=hm(3,1,-1)
offset sprite 1016,0,-90
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
`If Proceed/yes is selected
if Proceed$="YES"
`and u press return
if keystate(28)=1
if len(Pname$)=0 then Pname$="Unnamed N00b"
if len(Pchar$)=0 then Pchar$="Kenny"
wait 200
phase = 9
`delete all sprites
if sprite exist(1012)=1 then delete sprite 1012
if image exist(1012)=1 then delete image 1012
if sprite exist(1013)=1 then delete sprite 1013
if image exist(1013)=1 then delete image 1013
if sprite exist(1016)=1 then delete sprite 1016
if image exist(1016)=1 then delete image 1016
if sprite exist(1014)=1 then delete sprite 1014
if image exist(1014)=1 then delete image 1014
`delete all the objects
if object exist(1011)=1 then delete object 1011
if object exist(1014)=1 then delete object 1014
if object exist(1017)=1 then delete object 1017
endif
endif
endif
`the settings text
text 100,200,"Playername:"+Pname$
text 100,230,"Player Char:"+Pchar$
text 100,260,"Proceed/Join Game:"+Proceed$
`back button now takes you back to browseforgames
if sprite collision(1,1012)=1 and mouseclick()=1
phase = 9
if sprite exist(1016)=1 then delete sprite 1016
if image exist(1016)=1 then delete image 1016
`delete all the objects
if object exist(1011)=1 then delete object 1011
if object exist(1012)=1 then delete object 1012
if object exist(1013)=1 then delete object 1013
if object exist(1014)=1 then delete object 1014
if object exist(1015)=1 then delete object 1015
if object exist(1016)=1 then delete object 1016
if object exist(1017)=1 then delete object 1017
endif
endif
`for joinformat phase 7
createformat:
`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>------------------createformat
if phase = 8
`remove main browseforgames sprites including create sprite
if sprite exist(1015)=1 then delete sprite 1015
if image exist(1015)=1 then delete image 1015
if sprite exist(1014)=1 then delete sprite 1014
if image exist(1014)=1 then delete image 1014
`load selection sprite
if image exist(1016)=0 then load image "sel.png",1016,1
if sprite exist(1016)=0 then sprite 1016,40,170,1016
`--------------------SETTINGsel
`laptop animation,have a little laptop turning as 3D background
`load rest of models which may need to be displayed
`--------robot
if object exist(1011)=0 then load object "models/pir.x",1011:scale object 1011,40,40,40:position object 1011,object position x(1011),object position y(1011)-1.5,object position z(1011)
`--------pirat
if object exist(1014)=0 then load object "models/pir.x",1014:scale object 1014,40,40,40:position object 1014,object position x(1014),object position y(1014)-1.5,object position z(1014)
`--------Scumm Bay
if object exist(1017)=0 then load object "models/sbay.x",1017:scale object 1017,10,10,10::position object 1017,object position x(1017),object position y(1017)-1.5,object position z(1017)
`Use WOLF's routine to stop super movement/turning
capvalue(-1)
`allow arrows for browsing,controlled by hbrowse timer
if timer()-hbrowse(1)>100
`up arrow takes selection upwards
if keystate(200)=1
csetsel=csetsel-1
hbrowse(1)=timer()
endif
`down arrow takes selection downwards
if keystate(208)=1
csetsel=csetsel+1
hbrowse(1)=timer()
endif
endif
`stop stupid/for now useless numbers eg. -2 going into the csetsel var
if csetsel<0 then csetsel=5
if csetsel>5 then csetsel=0
`------------Gamename
if csetsel=0
`textfield 0 with max of 20 characters
textfield(0,20)
Gname$=string2$(0,1)
offset sprite 1016,0,0
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
if object visible(1017)=1 then hide object 1017
else
Gname$=string2$(0,2)
endif
`------------Playername
if csetsel=1
`textfield 1 with max of 50 characters
textfield(1,50)
Pname$=string2$(1,1)
offset sprite 1016,0,-30
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
if object visible(1017)=1 then hide object 1017
else
Pname$=string2$(1,2)
endif
`------------Max.Players
if csetsel=2
Maxp$=hm(0,0,-1)
offset sprite 1016,0,-60
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
if object visible(1017)=1 then hide object 1017
endif
`------------Character
if csetsel=3
`hide other stuff
if object visible(1017)=1 then hide object 1017
offset sprite 1016,0,-90
Pchar$=hm(1,1,-1)
`show char
if Pchar$="robot"
point camera object position x(1011),object position y(1011),object position z(1011)
turn object left 1011,capvalue(20)
if object visible(1011)=0 then show object 1011
if object visible(1014)=1 then hide object 1014
endif
if Pchar$="pirat"
point camera object position x(1014),object position y(1014),object position z(1014)
turn object left 1014,capvalue(20)
if object visible(1011)=1 then hide object 1011
if object visible(1014)=0 then show object 1014
endif
endif
`------------Level
if csetsel=4
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
offset sprite 1016,0,-120
Level$=hm(2,0,-1)
if Level$ = "???"
lvlind$ = "1"
point camera object position x(1017),object position y(1017),object position z(1017)
fix object pivot 1017
turn object left 1017,capvalue(20)
if object visible(1017)=0 then show object 1017
endif
endif
`Add a level flag to the game name
`------------Proceed/Create game
if csetsel=5
Proceed$=hm(3,1,-1)
offset sprite 1016,0,-150
`hide other stuff
if object visible(1011)=1 then hide object 1011
if object visible(1014)=1 then hide object 1014
if object visible(1017)=1 then hide object 1017
`If Proceed/yes is selected
if Proceed$="YES"
`and you press Enter/Return
if keystate(28)=1
if len(Pname$)=0 then Pname$="Unnamed N00b"
if len(Gname$)<=1 then Gname$="Unnamed Game"
if lvlind$="0" then Gname$=lvlind$+Gname$
if len(Level$)=0 then Level$="???"
if len(Pchar$)=0 then Pchar$="robot"
sleep 600
phase = 9
gltext=0
`delete all sprites
if sprite exist(1012)=1 then delete sprite 1012
if image exist(1012)=1 then delete image 1012
if sprite exist(1013)=1 then delete sprite 1013
if image exist(1013)=1 then delete image 1013
if sprite exist(1016)=1 then delete sprite 1016
if image exist(1016)=1 then delete image 1016
if sprite exist(1014)=1 then delete sprite 1014
if image exist(1014)=1 then delete image 1014
`delete all the objects
if object exist(1010)=1 then delete object 1010
if object exist(1011)=1 then delete object 1011
if object exist(1012)=1 then delete object 1012
if object exist(1013)=1 then delete object 1013
if object exist(1014)=1 then delete object 1014
if object exist(1015)=1 then delete object 1015
if object exist(1016)=1 then delete object 1016
if object exist(1017)=1 then delete object 1017
endif
endif
endif
`the settings text
Gname$=lvlind$+Gname$
text 100,170,"Gamename:"+right$(Gname$,len(Gname$)-1)
text 100,200,"Playername:"+Pname$
text 100,230,"Max.Players:"+Maxp$
text 100,260,"Player Char:"+Pchar$
text 100,290,"Level:"+Level$
text 100,320,"Proceed/Create Game:"+Proceed$
`back button now takes you back to browseforgames
if sprite collision(1,1012)=1 and mouseclick()=1
sleep 600
phase = 6
if sprite exist(1016)=1 then delete sprite 1016
if image exist(1016)=1 then delete image 1016
`delete all the objects
if object exist(1011)=1 then delete object 1011
if object exist(1012)=1 then delete object 1012
if object exist(1013)=1 then delete object 1013
if object exist(1014)=1 then delete object 1014
if object exist(1015)=1 then delete object 1015
if object exist(1016)=1 then delete object 1016
if object exist(1017)=1 then delete object 1017
endif
endif
`for createformat phase 8
`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>***MULTIGAMEPREP<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>***MULTIGAMEPREP<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
mult_prep:
if phase = 9
`-----------------------MULTIPLAYERprep
`memblock 1 for sending
`memblock 2 for receiving(is created by net message memblock command)
`if some idiot left the game/player name fields blank,we
`fill them in for him.isn't that nice? ;)
if len(Pname$)=0 then Pname$="Unnamed N00b"
if len(Gname$)=0 then Gname$="Unnamed Game"
`make a multiplayer timer array,for regulating how often stuff is sent
dim multitime(1)
multitime(1) = timer()
`DETERMINE WHETHER YOU'RE JOINING OR CREATING
if gltext=0
`CREATE THE GAME
create net game Gname$,Pname$,val(Maxp$),2
else
`JOIN GAME
join net game gltext,Pname$
endif
`change phase to multiplayerprep game phase
phase = 10
init#=0
endif
`for multigameprep phase 9
mult_ginit:
`>>>>>>>>>>>>______*****MULTIPLAYER GAME INIT PHASE*****---<<<<<<<
`>>>>>>>>>>>>______*****MULTIPLAYER GAME INIT PHASE*****---<<<<<<<
`>>>>>>>>>>>>______*****MULTIPLAYER GAME INIT PHASE*****---<<<<<<<
if phase = 10
`if there are at least 2 players
perform checklist for net players
if checklist quantity()=>2
`if it's a 2 player game
if Maxp$="2"
`CHECK CONTINUOUSLY FOR RECEIVED PACKETS
if memblock exist(2)=1
delete memblock 2
endif
get net message
if net message exists() = 1
`we know that it's definitely going to be a memblock
`since you can't chat in this pre-game stage
net message memblock 2
OtherNumber = net message player from()
get net message
endif
`1 > initstuff declaring
if init# < 1
`SEND OUR CHAR
if init# = 0
text 100,100,"SENDING CHARACTER INFO"
if memblock exist(1) = 0
make memblock 1,1
endif
`the byte we send is (first digit) 1 to say now we are moving to init 1
`which is when you have sent your char and are waiting for the other's
`char to be received -----second digit of the byte is the no of your char
if Pchar$="robot"
write memblock byte 1,0,11
endif
if Pchar$="pirat"
write memblock byte 1,0,12
endif
init#=0.1
endif
`WAIT FOR THEIRS
if init#=0.1
text 100,100,"CHARACTER INFO SENT,WAITING FOR REPLY"
`if other's char is received,go to the next stage
if memblock exist(2)=1
if left$(str$(memblock byte(2,0)),1)="1"
if memblock byte(2,0)=11
rem declare vars and arrays:
oplayer as oplayer
oplayer.name=checklist string$(OtherNumber)
oplayer.race="robot"
endif
if memblock byte(2,0)=12
rem declare vars and arrays:
oplayer as oplayer
oplayer.name=checklist string$(OtherNumber)
oplayer.race="pirat"
endif
`time load level terrain
if Level$="???"
load object "models/sbay.x",1
position object 1,object size x(1),0,object size z(1)
`don't forget the sea matrix!
load image "models/sea.jpeg",2000,1
make matrix 1,25,25,25,25
position matrix 1,object size x(1),0,object size z(1)
prepare matrix texture 1,2000,1,1
mpower# = .05
mspeed# = 1
ghost matrix on 1
endif
`Enemy/other player objs, determined by settings specified
if oplayer.race="robot"
`position robot at robot starting place
load object "models/pir.x",60
position object 60,limb position x(1,3),1,limb position z(1,3)
endif
if oplayer.race="pirat"
`position pirat at pirat starting place
load object "models/pir.x",60
position object 60,limb position x(1,4),1,limb position z(1,4)
endif
if Pchar$="robot"
`position robot at robot starting place
load object "models/pir.x",50
position object 50,limb position x(1,3),1,limb position z(1,3)
endif
if Pchar$="pirat"
`position pirat at pirat starting place
load object "models/pir.x",50
position object 50,limb position x(1,4),1,limb position z(1,4)
endif
`go to launch
init#=0.2
endif
endif
endif
`REGULARLY SEND THE MEMBLOCK TO ENSURE THE LAGGERS GET IT
`every 100 ms or 1/10th of a second, memblock is sent
if timer()-multitime(1)>100
if memblock exist(1)=1
`use guarantee packet to minimise chance of packet loss
send net message memblock 0,1,1
endif
multitime(1)=timer()
endif
if init#=0.2
`FINAL STAGE DELETE THE MEMBLOCKS TO PREPARE FOR PHASE 14(IN-GAME)
text 100,70,"Other player's race: "+oplayer.race
text 100,100,"LAUNCHING GAME...."
if memblock exist(1)=1 then delete memblock 1
if memblock exist(2)=1 then delete memblock 2
phase = 11
endif
endif
`for init#<1
endif
`when escape is pressed allow user to disconnect to main menu
if escapekey()=1
phase=-1
`FOR LVL 1
if Level$="???"
`delete sea matrix
if matrix exist(1)=1 then delete matrix 1
`delete all objects
for obj=1 to 1900
if object exist(obj)=1 then delete object obj
next obj
`delete memblocks
if memblock exist(1)=1
delete memblock 1
endif
if memblock exist(2)=1
delete memblock 2
endif
`If we're the game host,destroy/free game before quiting
if net game now hosting()=1
free net game
endif
`go to browsing for games phase
phase = 6
endif
endif
`for when esc is pressed
`if you're alone/there are less than 2 players in the game,wait for players
else
text 10,100,"WAITING FOR PLAYERS,AT LEAST 2 ARE NEEDED::ESC=ABORT+RETURN TO MENU"
text 10,140,"THERE ARE CURRENTLY "+STR$(checklist quantity())+" PLAYER(S) IN THIS GAME"
`when escape is pressed allow user to disconnect to main menu
if escapekey()=1
phase=-1
`FOR LVL 1
if Level$="???"
`delete sea matrix
if matrix exist(1)=1 then delete matrix 1
`delete all objects
for obj=1 to 1900
if object exist(obj)=1 then delete object obj
next obj
`delete memblocks
if memblock exist(1)=1
delete memblock 1
endif
if memblock exist(2)=1
delete memblock 2
endif
`If we're the game host,destroy/free game before quiting
if net game now hosting()=1
free net game
endif
`go to browsing for games phase
phase = 6
endif
endif
`for when esc is pressed
endif
`for if it's a 2player game
empty checklist
endif
`for multiplayer init game phase 10
mult_gaction:
`>>>>>>>>>>>>______*****MULTIPLAYER GAME PHASE*****---<<<<<<<
`>>>>>>>>>>>>______*****MULTIPLAYER GAME PHASE*****---<<<<<<<
`>>>>>>>>>>>>______*****MULTIPLAYER GAME PHASE*****---<<<<<<<
if phase = 11
`CHECK CONTINUOUSLY FOR RECEIVED PACKETS
if memblock exist(2)=1
delete memblock 2
endif
get net message
if net message exists()=1
`if received message is a memblock
if net message type()=4
`store the message in memblock 2
net message memblock 2
OtherNumber=net message player from()
endif
get net message
endif
`if message has indeed been received
if memblock exist(2)=1
`text 10,300,str$(memblock word(2,2))
endif
`-----------------------------GAMESTUFF (waves, positioning,collision etc)
gosub act_wmatrix
`camera
`gluecamtoObj(50,-1,.3,-1)
exit prompt "X",str$(object position x(50))
`------------------------------------SENDING ye INFO
`REGULARLY SEND THE MEMBLOCK
`every 100 ms or 1/10th of a second, memblock is sent
if timer()-multitime(1)>100
if memblock exist(1) = 1 then delete memblock 1
if memblock exist(1) = 0
make memblock 1,8
`x position written as word,32000 taken as zero to allow neg values to be written
xword# = object position x(50)*1000
write memblock word 1,0,xword#
`y position written as word,32000 taken as zero to allow neg values to be written
yword# = object position y(50)
write memblock word 1,2,yword#
`z position written as word,32000 taken as zero to allow neg values to be written
zword#=(object position z(50)*1000)
write memblock word 1,4,zword#
endif
if memblock exist(1)=1
`use guarantee packet to minimise chance of packet loss
send net message memblock 0,1,1
endif
multitime(1)=timer()
endif
endif
`for multiplayer game phase 11
`fps
text 10,10,str$(screen fps())
sync
loop
`---------------------------- SUB ROUTINES
`waves
act_wmatrix:
`WE CONTROL THIS MATRIX BY CAPVALUE SO THAT IT's NOT OFTEN UPDATED
`if water matrix exists as specified by options file/array
if matrix exist(1) = 1
`MATRIX SIN WAVE EFFECT
for x = 1 to 250 step 10
for z = 1 to 250 step 10
set matrix height 1,x/10,z/10,sin(3*(start-x))*mpower#+sin(3*(start-z))*mpower#
next z
next x
inc start,mspeed#
update matrix 1
endif
return
` ------------------- FUNCTIONS
`Sparky's glue function,for camera
function gluecamtoObj(toObj,offsetx#,offsety#,offsetz#)
position camera object position x(toObj),object position y(toObj),object position z(toObj)
rotate camera 0,0,0
turn camera right object angle y(toObj)
pitch camera down object angle x(toObj)
move camera offsetz#
turn camera right 90
move camera offsetx#
turn camera left 90
pitch camera up 90
move camera offsety#
pitch camera down 90
endfunction
function infront(objno,xcoord#,zcoord#)
oppadj#=abs(object position x(objno)-xcoord#)/abs(object position z(objno)-zcoord#)
oangle#=atan(oppadj#)
if (180-oangle#)=>90 then front=0
if (180-oangle#)=<90
front=1
else
front=0
endif
endfunction front
function mouseout(ins)
if ins=0
dim mouse_click(0)
endif
if ins=1
if mouse_click(0)>0
if mouseclick()=0
mresult=mouse_click(0)
else
mresult=0
endif
endif
mouse_click(0)=mouseclick()
endif
if ins=2
undim mouse_click(0)
endif
endfunction mresult
`Message and title are pretty self explanatory
`About mtype: this parameter determines the buttons that will appear on the messagebox
`the list below gives the buttons that appear with each different value of mtype
`the returnvar is basically a value returned which typically indicates what the user clicked
`mtype -1 unloads the dll btw!
`mtype 0:: OK
`mtype 1:: OK Cancel
`mtype 2:: Abort Retry Ignore
`mtype 3:: Yes No Cancel
`mtype 4:: Yes No
`mtype 5:: Retry Cancel
`mtype 6:: Cancel TryAgain Continue
`each button returns a different value when clicked:
`OK=1 Cancel=2 Abort=3 Retry=4 Ignore=5 Yes=6 No=7 TryAgain=10 Continue=11
function messagebox(Title$,Message$,mtype)
if dll exist(11)=0
load dll "user32",11
endif
if mtype=>0
returnvar=Call dll (11,"MessageBoxA",call dll(11,"GetActiveWindow"),Message$,Title$,mtype)
endif
if mtype=-1
if dll exist(11)=1 then delete dll 11:exitfunction
endif
endfunction returnvar
`capvalue
function capvalue(no#)
if no# = -3
`-3 init make array for timing and storing current fps and the frames elapsed
dim time#(2)
time#(0) = timer()
time#(1) = screen fps()
endif
`-2 unload delete array / free any memory used
if no# = -2
undim time#(0)
endif
`-1 update
if no# = -1
`each second re-read the fps
` if timer()-time#(0)>1000
` time#(0) = timer()
time#(1) = screen fps()
` endif
endif
`get capped value
if no# => 0
result# = no#/time#(1)
exitfunction result#
endif
endfunction result#
`************************************************************************************
Time_Setup:
`************************************************************************************
IntLoops AS INTEGER = 0
Integrator AS INTEGER = 4
DIM ElTime#(Integrator)
GOSUB FlushElTime
RETURN
`************************************************************************************
Time_Update:
`************************************************************************************
`Subroutine to track framerate
IF IntLoops <= Integrator THEN IntLoops = IntLoops + 1
OldNTime# = NTime#
IF OldNtime# = 0 THEN OldNtime# = 15
FOR a = (Integrator - 1) TO 0 STEP -1
ElTime#(a+1) = ElTime#(a)
NEXT a
ElTime#(0) = TIMER() - Time#
`MAX AND MIN TIME CAPS
`MinTime# = 12 :`1000 divided by this number is the FPS Value
`MaxTime# = 22 :`1000 divided by this number is the FPS Value
`IF ElTime#(0) < MinTime#
` WaitTime# = MinTime# - ElTime#(0)
` WAIT WaitTime#
` ElTime#(0) = MinTime#
`ENDIF
`IF ElTime#(0) > MaxTime# THEN ElTime#(0) = MaxTime#
Time# = TIMER()
NTime# = 0
FOR a = 0 TO Integrator
NTime# = NTime# + ElTime#(a)
NEXT a
NTime# = NTime# / IntLoops
`RATE OF CHANGE CAPS - This will limit any large change to +/- 10%
`IF NTime# > OldNTime# * 1.1 THEN NTime# = OldNTime# * 1.1
`IF NTime# < OldNTime# * 0.9 THEN NTime# = OldNTime# * 0.9
IF NTime# = 0 then NTime# = 15: `Make sure some value is used for NTime#
adjfps# = 1000/NTime#
`AnimAdj# = TuneFPS# / adjFPS#
RETURN
`************************************************************************************
FlushElTime:
`************************************************************************************
`Subroutine to reset timing system
IntLoops = 0
Time# = TIMER() - 100
FOR a = 0 TO Integrator
ElTime#(a) = 0
NEXT a
RETURN
`call this function to prepare memory for the number of textfields you intend to use
`maxno is the maximum number of textfields you will use at any one time
`keysec is the time in milliseconds that you wish the keystrokes to be checked
`making keysec small will mean the slightest keystroke (backspace or whatever) is captured
function txtfinit(maxno,keysec)
`basically we set a number of string and timer arrays
dim rstring$(maxno)
dim lstring$(maxno)
dim string2$(maxno,2)
`set the initial values of those arrays
for tf=0 to maxno
rstring$(tf)=""
lstring$(tf)=""
string2$(tf,1)=lstring$(tf)+"|"+rstring$(tf)
string2$(tf,2)=lstring$(tf)+rstring$(tf)
next tf
`timer arrays for capturing keystrokes
`NB: this is NOT where the keysec var is used
dim txtime(maxno)
txtime(maxno)=timer()
dim txtbime(maxno)
txtbime(maxno)=timer()
dim txtfime(maxno)
txtfime(maxno)=timer()
dim txtdime(maxno)
txtdime(maxno)=timer()
`here the keysec array is set
`ksec is the name of the var which will
`be used by the program to control how often
`keystrokes are captured
dim ksec(1)
ksec(1)=keysec
endfunction
`use this to display/enable the specified(tfn) textfield and the maximum number
`of characters allowed to be inputted into the specified text field
function textfield(tfn,maxchars)
`-------------------------------------------ADDING STUFF TO THE STRING
`what we do to move the cursor backwards
`is we split the string$ into two, the one that goes to the left
`of the cursor is lstring$ and the one to the right is rstring$
`if the string has not been split yet,split it
`if a key other than backspace is pressed and the existing string is not too long
if inkey$()<>"" and scancode()<>14 and len(lstring$(tfn))+len(rstring$(tfn))<maxchars
`every 150 millisecs
if timer()-txtime(tfn)>ksec(1)
`record it
lstring$(tfn)=lstring$(tfn)+inkey$()
`reset the timer
txtime(tfn)=timer()
string2$(tfn,1)=lstring$(tfn)+"|"+rstring$(tfn)
endif
endif
`-------------------------------------------CURSOR MOVING
`--------------------------------------backwards
`if you press left
`200,"up",208,"down",203,"left",205,"right"
if keystate(203)=1
`key is scanned every 150 millisecs
if timer()-txtbime(tfn)>ksec(1)
`if cursor has not moved to the very back
if left$(string2$(tfn,1),1)<>"|"
`if it has been split
`right string becomes the last char of the left string + itself
rstring$(tfn)=right$(lstring$(tfn),1)+rstring$(tfn)
`left string become what it was,minus it's last char
lstring$(tfn)=left$(lstring$(tfn),len(lstring$(tfn))-1)
string2$(tfn,1)=lstring$(tfn)+"|"+rstring$(tfn)
txtbime(tfn)=timer()
endif
endif
endif
`----------------------------forwards
`if you press right
`200,"up",208,"down",203,"left",205,"right"
if keystate(205)=1
`key is scanned every 150 millisecs
if timer()-txtfime(tfn)>ksec(1)
`if cursor has not moved to the very front
if right$(string2$(tfn,1),1)<>"|"
`if it has been split
`left string become what it was,plus the leftmost char in the right string
lstring$(tfn)=lstring$(tfn)+left$(rstring$(tfn),1)
`right string becomes what it was minus it's left most char
rstring$(tfn)=right$(rstring$(tfn),len(rstring$(tfn))-1)
string2$(tfn,1)=lstring$(tfn)+"|"+rstring$(tfn)
txtfime(tfn)=timer()
endif
endif
endif
`-----------------------------------BACKSPACING STUFF FROM THE STRING
`if backspace is pressed and cursor is not at the back
if keystate(14)=1 and len(lstring$(tfn))>0
`every 150 millisecs
if timer()-txtdime(tfn)>ksec(1)
`record it
lstring$(tfn)=left$(lstring$(tfn),len(lstring$(tfn))-1)
`reset the timer
txtdime(tfn)=timer()
string2$(tfn,1)=lstring$(tfn)+"|"+rstring$(tfn)
endif
endif
`---------------------------OUTPUTTING FINAL STRING
`output the final string without the "|" thingy to second array item/dimension
string2$(tfn,2)=lstring$(tfn)+rstring$(tfn)
`NOTHING IS RETURNED AS THERE ARE 2 THING TO RETURN,SO THEY CAN BE ACCESSED IN THE
`ARRAY
endfunction
`--------------------------------HMENUS-----------------------------------
`initialize horizontal menu,must be called before using any horizontal menu functions
`basically creates an array with the number of maximum hmenus that will be used
`and the highest number of hmenu items that you want your hmenus to be *capable* of having
function hminit(mid,miid,hmtim)
dim hmenu$(mid,miid)
`array that shows state of each menu
dim hmstate(mid)
`timer array which tells every how many millisecs to check for keypresses
dim hmtim(1)
hmtim(1)=hmtim
`timer arrays for each menu
dim hmtime(mid,2)
for mta=0 to mid
hmtime(mta,1)=timer()
hmtime(mta,2)=timer()
hmstate(mta)=0
next mta
endfunction
`adds an item to the specified menu array
`this item contains the name of the item, eg "Option 1"
function addhm(hmno,itemno,hminame$)
hmenu$(hmno,itemno)=hminame$
endfunction
`when called this returns the state,based on the way you use the arrow
`left/right keys,of the hmenu.You must specify the number of the menu
`items you want to be available
function hm(mno,hmaxino,preset)
`change selected hmenu item according to left/right arrow keys
`allow the preset flag (-1 means it won't be used) to determine hmenu init pointer
`basically it's the menu item number that you want the hmenu to initially be at
if preset>-1 and preset<=hmaxino then hmstate(mno)=preset
`if left arrow is pressed
if keystate(203)=1
`prevent constant key detection and hence constant menu item switching
`detect/notice keypresses every 100 millisecs
if timer()-hmtime(mno,1)>hmtim(1)
if hmstate(mno)=>0
hmstate(mno)=hmstate(mno)-1
endif
if hmstate(mno)<0 then hmstate(mno)=hmaxino
hmtime(mno,1)=timer()
endif
endif
`if right arrow is pressed
if keystate(205)=1
`prevent constant key detection and hence constant menu item switching
`detect/notice keypresses every 100 millisecs
if timer()-hmtime(mno,2)>hmtim(1)
if hmstate(mno)=<hmaxino
hmstate(mno)=hmstate(mno)+1
endif
if hmstate(mno)>hmaxino then hmstate(mno)=0
hmtime(mno,2)=timer()
endif
endif
fhm$=hmenu$(mno,hmstate(mno))
endfunction fhm$
`deletes all hmenu arrays,to be called before quitting the program
function unload_hmenu()
undim hmenu$(0,0)
undim hmstate(0)
undim hmtim(1)
undim hmtime(0,2)
endfunction
