Sorry your browser is not supported!

sync on
sync rate 60
autocam off

rem include Sparky's DLL
#INCLUDE "DBCcollisions.dba"

make object cube 1,25
set object 1,0,1,0

rem setup collision
setupObjectDBC(1,0,0)

rem make two spheres to track the start and end position of the ray
make object sphere 2,5
turn object left 2,90
make object sphere 3,5
position object 3,-100,0,0

position camera -50,0,-120

do
   rem move the object from inside the cube
   if leftkey()=1 then move object 2,.5
   if rightkey()=1 then move object 2,-.5

   oldx#=object position x(2)
   oldy#=object position y(2)
   oldz#=object position z(2)

   x#=object position x(3)
   y#=object position y(3)
   z#=object position z(3)

   ink rgb(255,0,0),0
   line object screen x(2),object screen y(2),object screen x(3),object screen y(3)
   text object screen x(2),object screen y(2)-30,"Start of ray"
   text object screen x(3),object screen y(3)-30,"End of ray"

   rem as the distance between the spheres changes, change
   rem the length and position of the ray and detect the collision
   rem of the cube
   result=intersectObjectDBC(1,0,oldx#,oldy#,oldz#,x#,y#,z#,0)

   ink rgb(255,255,255),0
   if result=1
      text 0,0,"The ray is passing through the cube"
   else
      text 0,0,"The ray is NOT passing through the cube"
   endif

   sync
loop

obj=Object
r#=Radius
co#=Correct Origin
function slideObject(obj,r#,co#)
    result=0
    x#=object position x(obj)
    y#=object position y(obj)
    z#=object position z(obj)

    if intersectObjectDBC(0,0,x#,y#+co#,z#,x#-r#,y#+co#,z#,obj)>0
        x#=getStaticCollisionX()+r#
        position object obj,x#,y#,z#
    endif

    if intersectObjectDBC(0,0,x#,y#+co#,z#,x#+r#,y#+co#,z#,obj)>0
        x#=getStaticCollisionX()-r#
        position object obj,x#,y#,z#
    endif

    if intersectObjectDBC(0,0,x#,y#+co#,z#,x#,y#+co#,z#-r#,obj)>0
        z#=getStaticCollisionZ()+r#
        position object obj,x#,y#,z#
    endif

    if intersectObjectDBC(0,0,x#,y#+co#,z#,x#,y#+co#,z#+r#,obj)>0
        z#=getStaticCollisionZ()-r#
        position object obj,x#,y#,z#
    endif

    if intersectObjectDBC(0,0,x#,y#+co#,z#,x#,y#+co#+r#,z#,obj)>0
        y#=getStaticCollisionY()+co#-r#
        position object obj,x#,y#,z#
    endif

    result=intersectObjectDBC(0,0,x#,y#+co#,z#,x#,y#+co#-r#,z#,obj)

    if result>0
        y#=getStaticCollisionY()+co#+r#
        position object obj,x#,y#,z#
    endif
endfunction result

col=intersectObjectDBC(0,1,x#,y#,z#,object position x(1),object position y(1),object position z(1),1)

sync on
sync rate 60
autocam off

rem include Sparky's DLL
#INCLUDE "DBCcollisions.dba"

make object cube 1,25
set object 1,0,1,0

rem setup collision
setupObjectDBC(1,0,0)

rem make two spheres to track the start and end position of the ray
make object sphere 2,5
turn object left 2,90
make object sphere 3,5
position object 3,-100,0,0

position camera -50,0,-120

do
   rem move the object from inside the cube
   if leftkey()=1 then move object 2,.5
   if rightkey()=1 then move object 2,-.5

   oldx#=object position x(2)
   oldy#=object position y(2)
   oldz#=object position z(2)

   x#=object position x(3)
   y#=object position y(3)
   z#=object position z(3)

   ink rgb(255,0,0),0
   line object screen x(2),object screen y(2),object screen x(3),object screen y(3)
   text object screen x(2),object screen y(2)-30,"Start of ray"
   text object screen x(3),object screen y(3)-30,"End of ray"

   rem as the distance between the spheres changes, change
   rem the length and position of the ray and detect the collision
   rem of the cube
   result=intersectObjectDBC(1,0,oldx#,oldy#,oldz#,x#,y#,z#,0)

   ink rgb(255,255,255),0
   if result=1
      text 0,0,"The ray is passing through the cube"
   else
      text 0,0,"The ray is NOT passing through the cube"
   endif

   sync
loop

`Setup
hide mouse
sync on
sync rate 60
backdrop on
color backdrop 0
autocam off

`Make player and set it up for collision
make object sphere 1,4
position object 1,50,10,50
setupObjectDBC(1,1,1)

`Make level and set it up for collision
make object sphere 2,100
color object 2,255
position object 2,0,-50,0
setupObjectDBC(2,1,0)

`Start control loop
do
   `Call player control/collision function
   control(.02,.3,.3,3,4.)
   sync
loop
`End loop

end

`functions-----------

`Player control/collision function
`g#=Gravity, j#=Jump strength, s#=Speed, r=Rotational speed, damp#=Mouse damper
function control(g#,j#,s#,r,damp#)
   oay#=object angle y(1):x#=object position x(1):y#=object position y(1):z#=object position z(1)
   if scancode() then yrotate object 1,ay#
   if keystate(17)>0 then move object 1,s#
   if upkey()>0 and keystate(17)=0 then move object 1,s#
   if keystate(31)>0 then move object 1,s#*-1
   if downkey()>0 and keystate(31)=0 then move object 1,s#*-1
   if keystate(32)>0
      if upkey()=0 and downkey()=0 and keystate(17)=0 and keystate(31)=0
         yrotate object 1,wrapvalue(object angle y(1)+90)
         move object 1,s#:yrotate object 1,wrapvalue(object angle y(1)-90)
      endif
      if keystate(17)>0 then move object 1,-1*s#:yrotate object 1,wrapvalue(object angle y(1)+45):move object 1,s#:yrotate object 1,wrapvalue(object angle y(1)-45)
      if keystate(31)>0 then move object 1,s#:yrotate object 1,wrapvalue(object angle y(1)-45):move object 1,-1*s#:yrotate object 1,wrapvalue(object angle y(1)+45)
   endif
   if rightkey()>0 then ay#=wrapvalue(ay#+r)
   if keystate(30)>0
      if upkey()=0 and downkey()=0 and keystate(17)=0 and keystate(31)=0
         yrotate object 1,wrapvalue(object angle y(1)-90)
         move object 1,s#:yrotate object 1,wrapvalue(object angle y(1)+90)
      endif
      if keystate(17)>0 and keystate(31)=0 then move object 1,-1*s#:yrotate object 1,wrapvalue(object angle y(1)-45):move object 1,s#:yrotate object 1,wrapvalue(object angle y(1)+45)
      if keystate(31)>0 and keystate(17)=0 then move object 1,s#:yrotate object 1,wrapvalue(object angle y(1)+45):move object 1,-1*s#:yrotate object 1,wrapvalue(object angle y(1)-45)
   endif
   if leftkey()>0 then ay#=wrapvalue(ay#-r)
   ay#=wrapvalue(ay#+(mousemovex()/damp#))
   if spacekey() then position object 1,object position x(1),object position y(1)+j#,object position z(1)
   f#=f#-g#:position object 1,object position x(1),object position y(1)+f#,object position z(1)
   updateObjectDBC(1)
   col=intersectObjectDBC(1,1,x#,y#,z#,object position x(1),object position y(1),object position z(1),1)
   position object 1,getStaticCollisionX(),getStaticCollisionY(),getStaticCollisionZ()
   show object 1
   if mouseclick()>1
      hide object 1
      ax#=wrapvalue(camera angle x()+(mousemovey()/damp#))
      ay#=wrapvalue(object angle y(1)+(mousemovex()/damp#))
      if ax#<270 and ax#>180 then ax#=270
      if ax#>90 and ax#<180 then ax#=90
      position camera object position x(1),object size y(1)+object position y(1),object position z(1)
      yrotate object 1,ay#:rotate camera ax#,ay#,0
   else
      set camera to follow object position x(1),object size y(1)+object position y(1),object position z(1),ay#,object size y(1)*1.7,object size y(1)*1.5+object position y(1),2,0
      point camera object position x(1),object size y(1)+object position y(1),object position z(1)
   endif
   position listener camera position x(),camera position y(),camera position z()
   rotate listener camera angle x(),camera angle y(),camera angle z()
   text 0,0,str$(col)
endfunction
`End player control/collision function

`Start Sparky's functions
function setupObjectDBC(objNum,groupNum,objectType)
    commonSetup(objNum)

    vertData = get memblock ptr(254)
    objectData = get memblock ptr(255)
    call dll 1,"setupObject",objNum,groupNum,objectType,vertData,objectData

    delete memblock 254
endfunction

function setupComplexObjectDBC(objNum,groupNum,facesPerNode)
    commonSetup(objNum)

    vertData = get memblock ptr(254)
    objectData = get memblock ptr(255)
    call dll 1,"setupComplexObject",objNum,groupNum,facesPerNode,vertData,objectData

    delete memblock 254
endfunction

function commonSetup(objNum)
    if dll exist(1)=0 then load dll "DBCcollision.dll",1
    if memblock exist(255)=0 then make memblock 255,24

    x#=object position x(objNum)
    y#=object position y(objNum)
    z#=object position z(objNum)
    angx#=object angle x(objNum)
    angy#=object angle y(objNum)
    angz#=object angle z(objNum)

    write memblock float 255,0,x#
    write memblock float 255,4,y#
    write memblock float 255,8,z#
    write memblock float 255,12,angx#
    write memblock float 255,16,angy#
    write memblock float 255,20,angz#

    position object objNum,0,0,0
    rotate object objNum,0,0,0
    make mesh from object 255,objNum
    make memblock from mesh 254,255
    delete mesh 255
    position object objNum,x#,y#,z#
    rotate object objNum,angx#,angy#,angz#
endfunction

function updateObjectDBC(objNum)
    if memblock exist(255)=0 then make memblock 255,24

    write memblock float 255,0,object position x(objNum)
    write memblock float 255,4,object position y(objNum)
    write memblock float 255,8,object position z(objNum)
    write memblock float 255,12,object angle x(objNum)
    write memblock float 255,16,object angle y(objNum)
    write memblock float 255,20,object angle z(objNum)

    objectData = get memblock ptr(255)

    call dll 1,"updateObject",objNum,objectData
endfunction

function intersectObjectDBC(objNum,groupFlag,oldx#,oldy#,oldz#,x#,y#,z#,excludeObj)
    collide=call dll(1,"intersectObject",objNum,groupFlag,oldx#,oldy#,oldz#,x#,y#,z#,excludeObj)
endfunction collide

function setObjectCollisionOnDBC(objNum)
    call dll 1,"set_object_collision_on",objNum
endfunction

function setObjectCollisionOffDBC(objNum)
    call dll 1,"set_object_collision_off",objNum
endfunction

function collisionStatusDBC(objNum)
    result=call dll(1,"collisionstatus",objNum)
endfunction result

function getStaticCollisionX()
    result#=call dll(1,"getStaticCollisionX")
endfunction result#

function getStaticCollisionY()
    result#=call dll(1,"getStaticCollisionY")
endfunction result#

function getStaticCollisionZ()
    result#=call dll(1,"getStaticCollisionZ")
endfunction result#

function getCollisionNormalX()
    result#=call dll(1,"getCollisionNormalX")
endfunction result#

function getCollisionNormalY()
    result#=call dll(1,"getCollisionNormalY")
endfunction result#

function getCollisionNormalZ()
    result#=call dll(1,"getCollisionNormalZ")
endfunction result#

remstart
   ==============================================================
   =  Title  : sparky's collision demo
   =  Author : latch
   =  Date   : 06/22/2009
   =  Update :
   =  Version:
   ==============================================================
   Comments  A quick sparky's demo testing for collision between
             a sphere and a cube
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,32
   sync on
   sync rate 60
   hide mouse
   autocam off

rem include the sparky's collision library
#include "DBCcollisions.dba"

rem =============================================================
rem = MAIN
rem =============================================================
_main:
   gosub _init

   do
      rem move the sphere and camera
      gosub _move_sphere

      rem check for collision
      gosub _collision

      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      rem first create a matrix to give the scene reference and scale
      make matrix 1,1000,1000,5,5

      rem make a sphere and set it up for collision using the DLL
      `setupObjectDBC(<objNum>,<GroupNum>,<Collision Type>)
      make object sphere 1,25
      setupObjectDBC(1,0,1)

      rem make a cube and set it up too
      rem the box collision seems to have glitches so i'm using
      rem polygon collision
      make object cube 2,50
      setupObjectDBC(2,0,0)

      rem position the object on the matrix and update their collision
      position object 2,500,25,500
      updateObjectDBC(2)
      position object 1,0,13,0
      updateObjectDBC(1)

      rem make a sphere that we will  always
      rem be in front of the main sphere.  This is just to draw a line
      rem so the ray can be seen
      make object sphere  3,5
      `hide object 3
      color object 3,rgb(255,255,0)

      color backdrop 0

      rem colors so I don't have to keep calling the rgb() function
      yellow=rgb(255,255,0)
      white=rgb(255,255,255)
   return
`----------------------------------------------------------------
   _move_sphere:
      rem move the sphere around with W + S, steer with mouse
      speed#=5
      yang#=wrapvalue(object angle y(1)+mousemovex())
      yrotate object 1,yang#
      move object 1,speed#*(keystate(17)-keystate(31))

      rem get the position of object 1 so we can use them later
      objx#=object position x(1)
      objy#=object position y(1)
      objz#=object position z(1)

      rem position the little sphere in front of the main sphere
      rem this is just so we can draw a 2d line to show the ray
      rem for the demo we'll  cast an exaggerated ray 100 units-sphere radius
      rem in front of the sphere.  Normally, you won't want to cast
      rem a ray so much farther ahead of the object you want to test for
      rem collision directly in front of.  The ray's length in this case
      rem is for visual aid only
      length=100
      newx#=newxvalue(objx#,yang#,length)
      newz#=newzvalue(objz#,yang#,length)
      position object 3,newx#,objy#,newz#

      rem draw a 2d line so we can see the ray
      ink yellow,0
      line object screen x(1),object screen y(1),object screen x(3),object screen y(3)
      ink white,0

      rem make sure the camera is following behind
      set camera to follow objx#,objy#,objz#,yang#,200,100,10,0
   return
`----------------------------------------------------------------
   _collision:
      rem now that the movement is setup and we have our ray start
      rem and finish points (from the main sphere to the little sphere)
      rem let's test for collision

      rem first thing, update the collision for the sphere because
      rem it is moving around.  The only real reason to do this
      rem would be so another ray could test for collision against
      rem the sphere.
      updateObjectDBC(1)

      rem now let's check if that ray is running into anything
      `intersectObjectDBC(<obj/groupNum>,<GroupFlag>,<oldx>,<oldy>,<oldz>,<x>,<y>,<z>,<excludeObj>)
      rem there's only 1 other object that we are going to test for
      rem collision with with this ray.  That's the cube.  So there's no need
      rem to use a 0 here (all objects) we'll use it anyway so we can return
      rem the object number.  In this case, let's exclude the sphere since the
      rem ray is coming out of it.  Just a little insurance against any
      rem false positives.
      col=intersectObjectDBC(0,0,objx#,objy#,objz#,newx#,objy#,newz#,1)

      if col
         text 0,0,"The ray is hitting object "+str$(col)
      else
         text 0,0,"No collision"
      endif

   return
`----------------------------------------------------------------

`obj=Object
`r#=Radius
`co#=Correct Origin
function slideObject(obj,r#,co#)
    result=0
    x#=object position x(obj)
    y#=object position y(obj)
    z#=object position z(obj)

    c1=intersectObjectDBC(0,0,x#,y#+co#,z#,x#,y#+co#+r#,z#,obj)

    if c1>0
        ny#=getStaticCollisionY()
        result=c1
        position object obj,x#,ny#+co#-r#,z#
    endif

    c2=intersectObjectDBC(0,0,x#,y#+co#,z#,x#,y#+co#-r#,z#,obj)

    if c2>0
        ny#=getStaticCollisionY()
        result=c2
        position object obj,x#,ny#+co#+r#,z#
    endif
endfunction result