`Sparky's sliding collision demo, adapted for planet collision.
`no use of small matrices, at request of C0wbox who wanted this code.
`This is a round world version of the "Sliding Demo" that comes
`with the Sparky Collsion DLL.
sync on
sync rate 60
autocam off
set camera aspect 1.77777
randomize timer()
global radius# as double float : radius# = 7.0
makeLevel()
makePlayer()
global vtimer as integer
global view as integer : view = 1
rem make some contact markers
make object sphere 20,0.5
make object sphere 21,0.5
make object sphere 22,0.5
color object 20,rgb(255,0,0)
color object 21,rgb(0,255,0)
color object 22,rgb(0,0,255)
`initial player pos
position object 2,0,0,250
point object 2,0,0,0
`an object to help with extracting rotation matrix
#constant testobject 30
make object cube testobject,1
hide object testobject
rem player movement vector
global vx# as double float
global vy# as double float
global vz# as double float
global gravity# as double float : gravity# = -0.1
global slope# as double float : slope# = 0.65 `higher value = slippier
global ground as integer : ground = 1
global jumptimer as integer : jumptimer = 0
global movespeed# as float: movespeed#=2.0
global camdistlolimit# as float : camdistlolimit# =10.0
global camdisthilimit# as float : camdisthilimit# =200.0
global camdist# as float : camdist#=100.0
do
rem hide the contact point markers
hide object 20 : hide object 21 : hide object 22
MovePlayer()
rem change view
if inkey$()="v" and vtimer<timer() then vtimer = timer()+300 : view = 1-view
positionCameraToObject(2,view)
text 0,0,"Use W/A/S/D to move, and V to change view"
text 0,40,"FPS: "+str$(screen fps())
sync
loop
function makeLevel()
`add my own object?
set normalization on `so object normals are normalised (because are scaling mesh)
load object "rad1_bumpysphere1.x",3
scale object 3,21000,21000,21000 `make it radius 200
make mesh from object 3,3
delete object 3
make object 3,3,0
delete mesh 3
load image "RockyL.jpg",3
texture object 3,3
scale object texture 3,10,10
sc_setupComplexObject 3,1,2 `not sure what best thing to use is
for n=4 to 19
t=rnd(1) `no cones and cylinders!
select t
case 0
make object box n,10+rnd(20),20,30
rotate object n,rnd(360),rnd(360),rnd(360)
move object n,200.0
rotate object n,rnd(360),rnd(360),rnd(360)
sc_setupObject n,1,2
endcase
case 1
make object sphere n,30+rnd(20)
rotate object n,rnd(360),rnd(360),rnd(360)
move object n,200.0
rotate object n,rnd(360),rnd(360),rnd(360)
sc_setupObject n,1,1
endcase
case 2
make object cone n,30
rotate object n,rnd(360),rnd(360),rnd(360)
move object n,200.0
rotate object n,rnd(360),rnd(360),rnd(360)
sc_setupObject n,1,0
endcase
case 3
make object cylinder n,30
rotate object n,rnd(360),rnd(360),rnd(360)
move object n,200.0
rotate object n,rnd(360),rnd(360),rnd(360)
sc_setupComplexObject n,1,2
endcase
endselect
texture object n,3
next n
rem all level objects are group 1
endfunction
function makePlayer()
make object sphere 2,radius#*2.0
position object 2,-80,15,-20
sc_setupObject 2,0,1
set alpha mapping on 2,50
set object transparency 2,2
disable object zwrite 2
rem player has no group
endfunction
function movePlayer()
rem rotate player with mouse
` yrotate object 2,object angle y(2)+mousemovex()/3.0
` xrotate object 2,object angle x(2)+mousemovey()/3.0
`new controls
turn object right 2,mousemovex()/3.0
` pitch object down 2,mousemovey()/3.0 `NO LONGER
` roll object left 2,(mouseclick()=1) - (mouseclick()=2) `USED
roll object left 2,0 `to fix DBP bug!
oldx# = object position x(2)
oldy# = object position y(2)
oldz# = object position z(2)
move object 2,movespeed#*(keystate(17)-keystate(31))
move object left 2,movespeed#*(keystate(30)-keystate(32))
x# = object position x(2)
y# = object position y(2)
z# = object position z(2)
`for readibility, make vector that is difference between x,y,z and old x,y,z
mx#=x#-oldx#
my#=y#-oldy#
mz#=z#-oldz#
`EXTRACT ROTATION MATRIX OF OBJECT 2 ==================================================
rotate object testobject, object angle x(2), object angle y(2), object angle z(2)
position object testobject,0,0,0
move object testobject,1
fwdx#=object position x(testobject)
fwdy#=object position y(testobject)
fwdz#=object position z(testobject)
position object testobject,0,0,0
move object up testobject,1
upx#=object position x(testobject) `up vector is not used by program except for debugging display.
upy#=object position y(testobject) `I left it in for completeness
upz#=object position z(testobject)
position object testobject,0,0,0
move object left testobject,1
leftx#=object position x(testobject)
lefty#=object position y(testobject)
leftz#=object position z(testobject)
`======================================================================================
if vy#=0 and jumptimer=0 then vy# = vy# + 10*gravity# else vy# = vy# + gravity# `not sure wtf this is for!
`gravity higher when you're on the ground?!!
`Sparky isn't stupid and I assume he put it in for a reason?!!
`i suggest using just use this.
` vy# = vy# + gravity# `<==
rem only jump if on ground, and a certain time after last jump
if ground=1
if spacekey()=1 and jumptimer=0 then vy# = vy# + 3.0 : jumptimer = 20
endif
`vy# is in object frame.
`this is kind of wierd because it casts straight down rather in direction of motion
collide = sc_SphereCastGroup(1,oldx#,oldy#,oldz#,oldx#+upx#*vy#,oldy#+upy#*vy#,oldz#+upz#*vy#,radius#,0)
if collide
rem how flat is this ground
nxw# = sc_getCollisionNormalX() `w denotes world frame
nyw# = sc_getCollisionNormalY()
nzw# = sc_getCollisionNormalZ()
ny#=upx#*nxw# + upy#*nyw# + upz#*nzw# `dot product of normal vector with up direction (player's up)
if abs(ny#)>slope#
rem FLAT, stick
oldx# = sc_getStaticCollisionX() `sparky standard version only sets value for oldy here, because
oldy# = sc_getStaticCollisionY() `x,z remained the same.
oldz# = sc_getStaticCollisionZ() `(setting new "start point" for second collision test)
else
rem STEEP, slide
oldx# = sc_getCollisionSlideX() `(setting new "start point" for second collision test)
oldy# = sc_getCollisionSlideY()
oldz# = sc_getCollisionSlideZ()
endif
rem ny#<0 means the player has hit a ceiling rather than a floor
if ny#>slope#
rem only on ground if standing on flat ground
ground = 1
vy# = 0
else
ground = 0
rem if player has hit a flat ceiling then stop vy# movement
if ny#<-slope# then vy# = gravity#
endif
else
rem nothing below player, not on ground, add vertical speed to player
oldx# = oldx# + upx#*vy#
oldy# = oldy# + upy#*vy#
oldz# = oldz# + upz#*vy#
ground = 0
endif
x#=oldx#+mx# `(setting new "endpoint" for second collsion test)
y#=oldy#+my# `second collsion test is for only side/forwards motion (in player frame), and no vertical motion.
z#=oldz#+mz#
rem jumptimer will decrease only when player is back on ground
rem creates a pause between two successive jumps
if ground = 1 and jumptimer>0 then dec jumptimer
rem handle horizontal movement as sliding
rem player only collides with group 1 (level) objs and moves freely through others
` collide = sc_SphereSlideGroup(1,oldx#,oldy#,oldz#,x#,oldy#,z#,radius#,0)
collide = sc_SphereSlideGroup(1,oldx#,oldy#,oldz#,x#,y#,z#,radius#,0)
if collide
rem if hit, reposition player, halt movement vector
x# = sc_getCollisionSlideX()
y# = sc_getCollisionSlideY()
z# = sc_getCollisionSlideZ()
endif
`previous system
REMSTART
`simple thing for gravity. this won't be correct, but should stick thing to surface
`basically works fine if assume that distance from centre of planet is fairly constant.
x#=x#*0.999 `also assumes that aren't jumping! just fall at constant velocity! rubbish!
y#=y#*0.999
z#=z#*0.999
rem player only collides with group 1 (level) objs and moves freely through others
collide = sc_SphereSlideGroup(1,oldx#,oldy#,oldz#,x#,y#,z#,radius#,0)
if collide>0
rem if hit, reposition player, halt movement vector
x# = sc_getCollisionSlideX()
y# = sc_getCollisionSlideY()
z# = sc_getCollisionSlideZ()
rem re-position the player
` position object 2,x#,y#,z# `moved to outside of If
rem count the contact points and mark them
num = sc_getNumCollisions()
for i=20 to num+19
newx# = sc_getStaticCollisionX(i-19) : newy# = sc_getStaticCollisionY(i-19) : newz# = sc_getStaticCollisionZ(i-19)
normx# = sc_getCollisionNormalX(i-19) : normy# = sc_getCollisionNormalY(i-19) : normz# = sc_getCollisionNormalZ(i-19)
position object i,newx#-normx#*radius#, newy#-normy#*radius#, newz#-normz#*radius#
show object i
next i
endif
REMEND
position object 2,x#,y#,z# `********** moved here because still want to reposition if no collision
`GET PLAYER UPRIGHT AGAIN - need wanted up vector for new player position
sumsq#=x#*x#+y#*y#+z#*z# `get distance from centre to point so can normalise it (to get direction vector = wanted up vector)
if sumsq# `if nonzero
invdist#=sqrt(1.0/sumsq#)
else
invdist#=0.0 `won't happen - player is never at world centre
endif
newupx#=x#*invdist#
newupy#=y#*invdist#
newupz#=z#*invdist#
`get wanted up vector in current player frame.
`dot products between newup vector and up,left,fwd vectors
`note that up_up# line is not required.
up_up#=upx#*newupx# + upy#*newupy# + upz#*newupz# :text 0,60,str$(up_up#) `display dot product - see how close the vectors are.
left_up#=leftx#*newupx# + lefty#*newupy# + leftz#*newupz#
fwd_up#=fwdx#*newupx# + fwdy#*newupy# + fwdz#*newupz#
roll object left 2,asin(left_up#)
pitch object down 2,asin(fwd_up#)
`note that these are only "exact" for small angles. However, since this is done every loop, errors do not add up.
`you can get more exact by doing turn-pitch-unturn, or turn-roll-unturn, but it's not required.
pitch object down 2,0 `fixes DBP bug!
sc_updateObject 2
endfunction
function positionCameraToObject(obj,thirdPerson)
position camera object position x(2),object position y(2),object position z(2)
rotate camera object angle x(2),object angle y(2),object angle z(2)
if thirdPerson=1
pitch camera down 10
` move camera -30
move camera -camdist#
camdist#=camdist#*(0.999^mousemovez()) `mousewheel to move cam in and out
if camdist#<camdistlolimit# then camdist#=camdistlolimit#
if camdist#>camdisthilimit# then camdist#=camdisthilimit#
endif
endfunction
if memblock exist(1) then delete memblock 1
REMSTART
global numSpheres as integer : numSpheres = 5
global radius# as double float : radius# = 7.0
global littleRadius# as double float : littleRadius# = 2.0
global rtimer as integer
global stimer as integer
global vtimer as integer
rem player movement vector
global vx# as double float
global vy# as double float
global vz# as double float
global gravity# as double float : gravity# = -0.1
global slope# as double float : slope# = 0.5
global ground as integer : ground = 1
global jumptimer as integer : jumptimer = 0
global syncmode as integer : syncmode = 60
global view as integer : view = 1
global hide as integer : hide = 0
do
MovePlayer()
rem change view
if inkey$()="v" and vtimer<timer() then vtimer = timer()+300 : view = 1-view
rem enable/disable sync limit
if inkey$()="l" and stimer<timer()
stimer = timer()+300
syncmode = 60-syncmode
sync rate syncmode
endif
positionCameraToObject(2,view)
text 0,0,"Use W/A/S/D to move, SPACE to jump and V to change view"
text 0,20,"Press L to enable/disable sync limiting"
text 0,40,"Press RETURN to show/hide colored spheres"
text 0,80,"FPS: "+str$(screen fps())
text 0,100,"Touching Ground: "+str$(ground)
sync
loop
REMEND
`from sparky's more advanced thing with sliding, sticking, jumping mechanics.
`not totally satisfactory, but the kind of mechanic C0wbox wants I think.
function movePlayer2()
rem rotate player with mouse
yrotate object 2,object angle y(2)+mousemovex()/3.0
xrotate object 2,object angle x(2)+mousemovey()/3.0
oldx# = object position x(2)
oldy# = object position y(2)
oldz# = object position z(2)
rem apply gravity, and user changes to movement
angy# = object angle y(2)
vx# = 0
vz# = 0
rem if player is jumping or falling then apply 'normal' gravity
rem if not attempt to keep the player stuck to the floor
if vy#=0 and jumptimer=0 then vy# = vy# + 10*gravity# else vy# = vy# + gravity#
if keystate(32)=1 then vx# = vx# + cos(angy#) : vz# = vz# - sin(angy#)
if keystate(30)=1 then vx# = vx# - cos(angy#) : vz# = vz# + sin(angy#)
if keystate(31)=1 then vx# = vx# - sin(angy#) : vz# = vz# - cos(angy#)
if keystate(17)=1 then vx# = vx# + sin(angy#) : vz# = vz# + cos(angy#)
rem only jump if on ground, and a certain time after last jump
if ground=1
if spacekey()=1 and jumptimer=0 then vy# = vy# + 3.0 : jumptimer = 20
endif
rem this would be the player's final position without collision
x# = oldx#+vx#
y# = oldy#+vy#
z# = oldz#+vz#
rem first handle gravity - seperated from horizontal movement
rem to achieve a more realistic effect
rem Method: simple - cast a sphere vertically down, if it hits the level then
rem position the object there (sticky collision) then move
rem on to horizontal movement
rem more complex - if we were to only use the simple method the player would be
rem allowed to climb almost vertical slopes. Alternative is to
rem get the normalY direction to work out how flat the gorund
rem below the player is, 0-slope# is flatter, slope#-1 is steeper.
rem if it's flat, use sticky collision, if it's steep slide the
rem player down the slope. Changing slope# determines how steep the
rem player can climb. NOTE: this also effects stairs.
collide = sc_SphereCastGroup(1,oldx#,oldy#,oldz#,oldx#,oldy#+vy#,oldz#,radius#,0)
if collide>0
rem how flat is this ground
ny# = sc_getCollisionNormalY()
if abs(ny#)>slope#
rem FLAT, stick
oldy# = sc_getStaticCollisionY()
else
rem STEEP, slide
x# = x# - oldx# : z# = z# - oldz#
oldx# = sc_getCollisionSlideX()
oldy# = sc_getCollisionSlideY()
oldz# = sc_getCollisionSlideZ()
x# = x# + oldx# : z# = z# + oldz#
endif
rem ny#<0 means the player has hit a ceiling rather than a floor
if ny#>slope#
rem only on ground if standing on flat ground
ground = 1
vy# = 0
else
ground = 0
rem if player has hit a flat ceiling then stop vy# movement
if ny#<-slope# then vy# = gravity#
endif
else
rem nothing below player, not on ground, add vertical speed to player
oldy# = oldy# + vy#
ground = 0
endif
rem jumptimer will decrease only when player is back on ground
rem creates a pause between two successive jumps
if ground = 1 and jumptimer>0 then dec jumptimer
rem handle horizontal movement as sliding
rem player only collides with group 1 (level) objs and moves freely through others
collide = sc_SphereSlideGroup(1,oldx#,oldy#,oldz#,x#,oldy#,z#,radius#,0)
if collide>0
rem if hit, reposition player, halt movement vector
x# = sc_getCollisionSlideX()
oldy# = sc_getCollisionSlideY()
z# = sc_getCollisionSlideZ()
vx# = 0
vz# = 0
rem possible code for giving the player a jumping help up stairs...
rem might be useful if slope# is set very high but stairs are still required
`dy# = oldy#-sc_getStaticCollisionY()
`if dy#<slope# and dy#>0 and ground=1 then vy# = 0.5
endif
rem position the player
position object 2,x#,oldy#,z#
sc_updateObject 2
endfunction
I've basically ported the second sparky demo. It works, apart from some juddery wierdness on occasion, but I think this may happen with the the original engine anyway. Though it has a number of features that I find unsatisfactory, like air control, no momentum, I expect this is the mechanic with which you are familiar.
