Sorry your browser is not supported!

cls
hide mouse

sync on
sync rate 60

autocam off
SET CAMERA RANGE 1,10000
backdrop on
color backdrop rgb(190,220,255)
ink rgb(255,255,255),0
set text size 18
set text font "Times new roman"

randomize timer()

global radius# as double float : radius# = 30.0
playerhp#=100
playermana#=100

makeLeveltestwrld()

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.3
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()
   

   positionCameraToObject(2)

   text 0,0,"Use W/A/S/D to move, Q/E to turn, SPACE to jump."
   text 0,20,"Hold down SHIFT to run."
   text 0,40,"Pressing ESC opens the menu"
   text 0,80,"FPS: "+str$(screen fps())
   text 0,100,"Touching Ground: "+str$(ground)


   sync
loop

function makeLeveltestwrld()
    CLS RGB(60,60,60)
    text 480,399,"LOADING"
    sync
    DELETE OBJECT 1
    load object "maptest/testwrld.dbo",1
    sc_setupComplexObject 1,1,2
    DELETE OBJECT 2
    make object sphere 2,radius#*2
    `hide object 2  *** I AM NOT HIDING THIS FOR TESTING FOR TESTING PURPOSES ***
    position object 2,0,400,0
    sc_setupObject 2,0,1
endfunction

function MovePlayer()

 rem rotate player with mouse
rx# = object angle x(2)+mousemovey()/3.0
if rx# > 65 THEN rx# = 65
if rx# < -65 THEN rx# = -65
   yrotate object 2,object angle y(2)+mousemovex()/2
   xrotate object 2,rx#


walkspeed# = 6
runon = SHIFTKEY()
if runon = 1 THEN walkspeed# = 12


   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# + 20*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#)
   if keystate(16)=1 then yrotate object 2,object angle y(2)-3
   if keystate(18)=1 then yrotate object 2,object angle y(2)+3
   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# + 13 : jumptimer = 20
   endif

   rem this would be the player's final position without collision
   x# = oldx#+vx#*walkspeed#
   y# = oldy#+vy#*walkspeed#
   z# = oldz#+vz#*walkspeed#

   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#*3
      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
   if oldy#<-50 then oldy#=100
   position object 2,x#,oldy#,z#

text 0,250,"X: "+str$(x#)
text 0,270,"Z: "+str$(z#)
text 0,290,"Y: "+str$(oldy#)

   sc_updateObject 2

endfunction


function positionCameraToObject(obj)
   if controlkey() = 1
      pl_crouching# = object position y(2)+25
   else
      pl_crouching# = object position y(2)+70
   endif
   position camera object position x(2),pl_crouching#,object position z(2)
   rotate camera object angle x(2),object angle y(2),object angle z(2)
endfunction

if memblock exist(1) then delete memblock 1