REM ***********************************************
REM Title: Line-Sphere Intersection
REM Author: Unknown
REM Downloaded from: http://dbcc.zimnox.com/
REM ***********************************************
 
Rem Project: Line-Sphere
Rem Created: 13/11/2003 20:59:51
 
Rem Based on http://www.cleverentertainment.com/coding/tutorials/linesphere_intersection.htm
 
`PA: the start point of the line segment (point of origin)
`PB: end point of the line segment
`X: Center of the sphere
`r: radius of sphere
`cp(): If there is no collision cp(0) and cp(1) are NULL
`If there is 1 point of collision cp(0) is the coordinate of that point, cp(1) is NULL
`If there are 2 points of collision cp(0) and cp(1) are the coordinates of both points of intersection
 
sync on
sync rate 60
autocam off
hide mouse
 
make matrix 1,1000,1000,40,40
`Set-up Variables
type Vertex
x as float
y as float
z as float
endtype
dim CP(1) as Vertex
global Col as integer
global SegCol as integer
 
radius#=10.0
line#=100.0
ly#=50.0
ly2#=50.0
offsetx# = 50.0
offsetz# = 50.0
 
make object sphere 1,radius#*2
make object cube 2,100
scale object 2,line#,0.5,0.5
 
position object 1, 50,50,50
position object 2,50,50,50
 
 
make object sphere 3,2 : color object 3,rgb(200,0,0)
make object sphere 4,2 : color object 4,rgb(0,200,0)
 
 
DO
 
  if shiftkey() then ya#=wrapvalue(ya#+2)
  if controlkey() then ya#=wrapvalue(ya#-2)
 
  lx#=cos(wrapvalue(ya#+180))*(line#/2) + offsetx#
  lz#=sin(wrapvalue(ya#+180))*(line#/2) + offsetz#
  lx2#=cos(ya#)*(line#/2) + offsetx#
  lz2#=sin(ya#)*(line#/2) + offsetz#
 
  yrotate object 2,360-ya#
 
  `Call Collision Function
  `                  { POINT 1 } {    POINT 2    } {  CIRCLE  } {RAD}
  LineSphereCollision( lx# , ly# , lz# , lx2# , ly2# , lz2# , 50 , 50 , 50 , radius# )
 
 
`  position object 3,lx#,ly#,lz#
`  position object 4,lx2#,ly2#,lz2#
 
  position object 3,cp(0).x,cp(0).y,cp(0).z
  position object 4,cp(1).x,cp(1).y,cp(1).z
 
 
  gosub PLAYER_CONTROLS
  gosub camera_status
 
 
  `Display Collision Check Results
  text 0,0,"Collision: "+str$(Col)
  text 0,20,"Points of intersection: "+str$(SegCol)
  text 0,40,"Point 1"
  text 0,55,"X: "+str$(cp(0).x)+" Y: "+str$(cp(0).y)+" Z: "+str$(cp(0).z)
  text 0,80,"Point 2"
  text 0,95,"X: "+str$(cp(1).x)+" Y: "+str$(cp(1).y)+" Z: "+str$(cp(1).z)
 
  sync
LOOP
 
 
 
`===================================================================================
`Line / Sphere collision function
`(POINTA.x,POINTA.y,POINTA.z,POINTB.x,POINTB.y,POINTB.z,CIRCLE.x,CIRCLE.y,CIRCLE.z,Radius)
function LineSphereCollision( PAx#, PAy#, PAz#, PBx#, PBy#, PBz#, Cx#, Cy#, Cz#, r# )
SegCol=0
Col=0
Px#=PBx#-PAx# : Py#=PBy#-PAy# : Pz#=PBz#-PAz#
A# = BI(Px#) + BI(Py#) + BI(Pz#)
B# = 2*( (Px#)*(PAx# - Cx#) + (Py#)*(PAy# - Cy#) + (Pz#)*(PAz# - Cz#) )
C# = BI(Cx#) + BI(Cy#) + BI(Cz#) + BI(PAx#) + BI(PAy#) + BI(PAz#) - 2*(Cx# * PAx# + Cy# * PAy# + Cz# * PAz#) - BI(r#)
V# = BI(B#) - 4*A#*C#
if V#>=-0.5
  if V#<0.5
      U#=-B#/(2*A#)
      cp(0).x= PAx# + U#*Px#
      cp(0).y= PAy# + U#*Py#
      cp(0).z= PAz# + U#*Pz#
      Col=1
  endif
endif
if V#>0
  SV# = sqrt(V#)
  U1#=(-B# + SV#)/(2.0*A#)
  U2#=(-B# - SV#)/(2.0*A#)
  if U1#>=0.0
      if U1#<=1.0
        cp(0).x= PAx# + U1#*(Px#)
        cp(0).y= PAy# + U1#*(Py#)
        cp(0).z= PAz# + U1#*(Pz#)
        inc SegCol
      endif
  endif
  if U2#>=0.0
      if U2#<=1.0
        cp(SegCol).x= PAx# + U2#*(Px#)
        cp(SegCol).y= PAy# + U2#*(Py#)
        cp(SegCol).z= PAz# + U2#*(Pz#)
        inc SegCol
      endif
  endif
  Col=1
endif
endfunction
`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
`x#^2
function BI(x#)
x#=x#*x#
endfunction x#
`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 
 
 
 
PLAYER_CONTROLS:
 
  if upkey()=1
    x#=newxvalue(x#,a#,6)
    z#=newzvalue(z#,a#,6)
  endif
  if downkey()=1
    x#=newxvalue(x#,a#,-6)
    z#=newzvalue(z#,a#,-6)
  endif
  if leftkey()=1
    x#=newxvalue(x#,wrapvalue(a#-90.0),5.0)
    z#=newzvalue(z#,wrapvalue(a#-90.0),5.0)
  endif
  if rightkey()=1
    x#=newxvalue(x#,wrapvalue(a#+90.0),5.0)
    z#=newzvalue(z#,wrapvalue(a#+90.0),5.0)
  endif
 
RETURN
 
 
CAMERA_STATUS:
  rem rotate camera according to mouse
  a#=wrapvalue(a#+(mousemovex()/3.0))
  rem position and rotate camera
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  position camera x#,100,z#
  rotate camera wrapvalue(cxa#),a#,0
RETURN