Source:CollisionSpherique.pb

;Comtois 02/12/04
;Tut sur les Collisions Sphériques
;l'exemple est en 2D , mais le principe est le même pour la 3D.
;la différence réside dans le calcul de la distance
;en 2D on a Distance=Sqr((x1-x2)²+(y1-y2)²)
;en 3D on a Distance=Sqr((x1-x2)²+(y1-y2)²+(z1-z2)²)
;Avec x1,y1,z1 les coordonnées de la sphere 1
;et x2,y2,z2 les coordonnées de la sphere 2

;Pour détecter une collision entre deux entitys 3D , il suffit de définir une sphère qui enveloppe chacune des entitys
;et de tester la distance entre les entitys 3D. Bien sûr cette méthode a ses limites .
;Il est très rare d'avoir des entitys de forme sphérique :p
;l'avantage c'est que cette méthode est simple à mettre en oeuvre et elle est rapide (elle nécessite peu de calculs).

;-Declare
Declare Erreur(Message$)

;-Initialisation
#ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 32
If InitEngine3D() = 0
  Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll")
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "" ) = 0
  Erreur("Impossible d'ouvrir l'écran ")
EndIf
Structure Sphere
  x.l
  y.l
  Rayon.l
EndStructure
Global Sprite1.Sphere
Global Sprite2.Sphere

;/Sprite 1
Sprite1\x=400
Sprite1\y=300
Sprite1\Rayon=60
CreateSprite(1,128,128)
If StartDrawing(SpriteOutput(1))
  Circle(SpriteWidth(1)/2,SpriteHeight(1)/2,Sprite1\Rayon,RGB(185,155,255))
  StopDrawing()
EndIf

;/Sprite 2
Sprite2\x=0 ; utilise les coordonnées de la souris
Sprite2\y=0 ; utilise les coordonnées de la souris
Sprite2\Rayon=40
CreateSprite(2,82,82)
If StartDrawing(SpriteOutput(2))
  Circle(SpriteWidth(2)/2,SpriteHeight(2)/2,Sprite2\Rayon,RGB(55,55,255))
  StopDrawing()
EndIf
;-Procedures
Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure

Procedure.f CalculDistance(X1,Y1,X2,Y2)
  ;en 2D Distance=Sqr((x1-x2)²+(y1-y2)²)
  ;en 3D Distance=Sqr((x1-x2)²+(y1-y2)²+(z1-z2)²)
  Distance.f=Sqr((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2))
  ProcedureReturn Distance
EndProcedure

Procedure AfficheDistance(X1,Y1,X2,Y2)
  If StartDrawing(ScreenOutput())
    ;Affiche la distance entre la sphère 1 et la sphère 2
    R1=Sprite1\Rayon
    R2=Sprite2\Rayon
    LineXY(X1,Y1,X2,Y2,RGB(255,0,0))
    x=(X1+X2)/2
    y=(Y1+Y2)/2
    FrontColor(0,155,0)
    BackColor(255,255,0)
    Locate(x,y)
    Distance.f=CalculDistance(X1,Y1,X2,Y2)
    DrawText("d="+StrF(Distance,1))
    ;/Affiche le rayon 1
    Locate(X1,Y1)
    DrawText("R1="+Str(R1))
    ;/Affiche le rayon 2
    Locate(X2,Y2)
    DrawText("R2="+Str(R2))
    ;/Commentaire et collision
    FrontColor(255,255,255)
    BackColor(0,0,0)
    Locate(0,0)
    DrawText("Soit 'R1' le rayon de la sphère 1 ,'R2' le rayon de la sphère 2 et 'd' la distance entre la sphère 1 et 2")
    Locate(0,20)
    DrawText("Il y a collision entre les deux sphères si la Distance 'd' est inférieure à la somme des deux rayons > 'd'<'R1+R2'")
    Locate(0,40)
    If Distance<R1+R2
      T$=" , Il y a collision"
    Else
      T$=" , il n'y a pas de collision"
    EndIf
    DrawText("R1 + R2 = "+Str(R1)+" + "+Str(R2)+" = "+Str(R1+R2)+ " ..... et d = "+StrF(Distance,1))
    ;/Collision?
    If Distance<R1+R2
      FrontColor(255,255,0)
      BackColor(255,0,0)
      T$="Il y a collision !"
    Else
      FrontColor(255,255,0)
      BackColor(0,0,255)
      T$="Il n'y a pas de collision"
    EndIf
    Locate(400-TextLength(T$)/2,580)
    DrawText(T$)
    StopDrawing()
  EndIf
EndProcedure


;- Boucle principale
Repeat
  ClearScreen(0,0,0)
  ExamineKeyboard()
  ExamineMouse()
  ;/Affiche le sprite 1
  CentreX1=Sprite1\x+SpriteWidth(1)/2
  Centrey1=Sprite1\y+SpriteHeight(1)/2
  DisplaySprite(1,Sprite1\x,Sprite1\y)
  ;/Affiche le sprite 2 à la position de la souris
  Sprite2\x=MouseX()
  Sprite2\y=MouseY()
  CentreX2=Sprite2\x+SpriteWidth(2)/2
  Centrey2=Sprite2\y+SpriteHeight(2)/2
  DisplayTransparentSprite(2,Sprite2\x,Sprite2\y)
  ;/
  ;Il y a collision si la distance entre la sphere de rayon R1 et la sphere de rayon R2 est < R1+R2
  AfficheDistance(CentreX1,Centrey1,CentreX2,Centrey2)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)