ça date un peu, aujourd'hui j'ai ajouté la souris pour indiquer la destination de la sphère 1.
Il y a deux sphères vertes avec un numéro.
La sphère 1 peut être déplacée au clavier, la seconde est fixe.
la sphère bleue indique la destination de la sphère 1.
Une sphère rouge est affichée au point d'impact s'il y a une collision.
Et la trajectoire est affichée (Ligne blanche),en partant de la position d'origine de la sphère 1 jusqu'à la sphère bleue qui indique la position finale après rebond.
Code : Tout sélectionner
;Comtois le 13 janvier 2008
;Algo de collision "à priori"
;Calcul la collision et la réponse entre deux sphères
;Le calcul d'une collision éventuelle est effectué avant de déplacer les sphères.
;Si une collision existe, t0 indique à quel moment elle aura lieu.
;Ce qui permet de calculer la position des sphères au moment de l'impact
;Et enfin de calculer le rebond, et la position finale en calculant le temps restant=1-t0.
;Cette méthode permet de détecter toutes les collisions et de gérer la position exacte
;des sphères , même avec des vitesses très grandes (bien supérieure à la taille d'une sphère).
InitSprite()
InitMouse()
InitKeyboard()
OpenScreen(800,600,32,"Sphere Collision")
Structure s_Vecteur
x.f
y.f
EndStructure
Structure s_Sphere
Origine.s_Vecteur
Direction.s_Vecteur
Finale.s_Vecteur
Rayon.f
Collision.l
EndStructure
#NbSphere = 2
#Rayon = 25
#Rayon2 = 4 * #Rayon * #Rayon
Global t0.f
Macro PRODUIT_SCALAIRE(V1, V2)
(V1\x * V2\x + V1\y * V2\y)
EndMacro
Macro NORME(V)
(Sqr(V\x * V\x + V\y * V\y))
EndMacro
Dim Sphere.s_Sphere(#NbSphere)
Declare InitSphere(Sphere.s_Sphere(1), n.l, x.f, y.f, dx.f, dy.f, r.f)
Declare ChercheLaPlusPetiteSolution(a.f, b.f, c.f, maxR.f, *Solution.Float)
Declare Collision(Sphere.s_Sphere(1))
Declare Normalise(*N.s_Vecteur)
InitSphere(Sphere(), 1, 200, 200, 0, 123, 25)
InitSphere(Sphere(), 2, 320, 320, 0, 0, 13)
CreateSprite(0,4,4)
StartDrawing(SpriteOutput(0))
Box(0,0,4,4,#Yellow)
StopDrawing()
Define.s_Vecteur Normale,Vitesse, Finale, CercleFinal
Repeat
ClearScreen(0)
If ExamineKeyboard()
If KeyboardPushed(#PB_Key_Up)
Sphere(1)\Origine\y - 1
ElseIf KeyboardPushed(#PB_Key_Down)
Sphere(1)\Origine\y + 1
EndIf
If KeyboardPushed(#PB_Key_Left)
Sphere(1)\Origine\x - 1
ElseIf KeyboardPushed(#PB_Key_Right)
Sphere(1)\Origine\x + 1
EndIf
EndIf
If ExamineMouse()
If MouseButton(#PB_MouseButton_Left)
Sphere(1)\Direction\x=MouseX()-Sphere(1)\Origine\x
Sphere(1)\Direction\y=MouseY()-Sphere(1)\Origine\y
EndIf
EndIf
DisplaySprite(0,MouseX(),MouseY())
StartDrawing(ScreenOutput())
;Affiche les cercles en position d'origine en Vert
DrawingMode(#PB_2DDrawing_Default)
For i = 1 To 2
Circle(Sphere(i)\Origine\x, Sphere(i)\Origine\y,Sphere(i)\Rayon,#Green)
DrawText(Sphere(i)\Origine\x-8, Sphere(i)\Origine\y-8,Str(i),#Black,#Green)
Next i
If Collision(Sphere())
;Affiche les cercles au point de collision en rouge
DrawingMode(#PB_2DDrawing_Outlined)
i=1
X1.f = Sphere(i)\Origine\x + t0 * Sphere(i)\Direction\x
Y1.f = Sphere(i)\Origine\y + t0 * Sphere(i)\Direction\y
Circle(X1, Y1, Sphere(i)\Rayon,#Red)
i=2
X2.f = Sphere(i)\Origine\x + t0 * Sphere(i)\Direction\x
Y2.f = Sphere(i)\Origine\y + t0 * Sphere(i)\Direction\y
Circle(X2, Y2, Sphere(i)\Rayon,#Red)
;Calcul la distance
Normale\x = X1 - X2
Normale\y = Y1 - Y2
Normalise(@Normale)
;Affiche les cercles dans la position finale après le calcul du rebond
For i = 1 To #NbSphere
Vitesse\x = Sphere(i)\Direction\x * (1.0 - t0)
Vitesse\y = Sphere(i)\Direction\y * (1.0 - t0)
ProduitScalaire.f = PRODUIT_SCALAIRE(Vitesse, Normale)
Finale\x = Vitesse\x - (2 * ProduitScalaire * Normale\x)
Finale\y = Vitesse\y - (2 * ProduitScalaire * Normale\y)
Sphere(i)\Finale\x=Sphere(i)\Origine\x + t0 * Sphere(i)\Direction\x + Finale\x
Sphere(i)\Finale\y=Sphere(i)\Origine\y + t0 * Sphere(i)\Direction\y + Finale\y
Circle(Sphere(i)\Finale\x,Sphere(i)\Finale\y, Sphere(i)\Rayon, #Blue)
Next i
;LineXY(Sphere(1)\Origine\x + t0 * Sphere(1)\Direction\x, Sphere(1)\Origine\y + t0 * Sphere(1)\Direction\y,Sphere(2)\Origine\x, Sphere(2)\Origine\y,#Red)
;Trajectoire de la sphere 1
LineXY(Sphere(1)\Origine\x + t0 * Sphere(1)\Direction\x, Sphere(1)\Origine\y + t0 * Sphere(1)\Direction\y,Sphere(1)\Origine\x, Sphere(1)\Origine\y,#White)
LineXY(Sphere(1)\Origine\x + t0 * Sphere(1)\Direction\x, Sphere(1)\Origine\y + t0 * Sphere(1)\Direction\y,Sphere(1)\Finale\x , Sphere(1)\Finale\y ,#White)
Else
;Affiches les cercles en position finale sans rebond
DrawingMode(#PB_2DDrawing_Outlined)
For i=1 To 2
Circle(Sphere(i)\Origine\x + Sphere(i)\Direction\x, Sphere(i)\Origine\y + Sphere(i)\Direction\y, Sphere(i)\Rayon,#Blue)
Next i
EndIf
StopDrawing()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
Procedure InitSphere(Sphere.s_Sphere(1), n.l, x.f, y.f, dx.f, dy.f, r.f)
Sphere(n)\Origine\x = x
Sphere(n)\Origine\y = y
Sphere(n)\Direction\x = dx
Sphere(n)\Direction\y = dy
Sphere(n)\Rayon = r
Sphere(n)\Collision = #False
EndProcedure
Procedure ChercheLaPlusPetiteSolution(a.f, b.f, c.f, maxR.f, *Solution.Float)
Define.f Determinant, t1, t2, q
;Calcul le déterminant
Determinant = b * b - 4.0 * a * c
;Si le déterminant est inférieur ou égal à zéro , il n'y a pas d'intersection significative.
If Determinant < 0.0 : ProcedureReturn #False : EndIf
;Calcul les deux solutions
If b < 0.0
q = 0.5 * (-b - Sqr(Determinant))
Else
q = 0.5 * (-b + Sqr(Determinant))
EndIf
t1 = q / a
t2 = c / q
;Est-ce vraiment utile ?
If t2 < t1
Swap t1, T2
EndIf
;Renvoie la solution la plus petite si elle est valide
If t1 > 0 And t1 < maxR
*Solution\f = t1
ProcedureReturn #True
EndIf
If t2 > 0 And t2 < maxR
*Solution\f = t2
ProcedureReturn #True
EndIf
;Pas de solution
ProcedureReturn #False
EndProcedure
Procedure Collision(Sphere.s_Sphere(1))
;Avant de déplacer les sphères
;Cette procédure calcule à quel moment aura lieu une collision
;Renommer direction en vitesse, ça sera plus parlant !
Define.f a, b, c, Distance, t
Define.s_Vecteur d, p
d\x = Sphere(1)\Direction\x - Sphere(2)\Direction\x
d\y = Sphere(1)\Direction\y - Sphere(2)\Direction\y
p\x = Sphere(1)\Origine\x - Sphere(2)\Origine\x
p\y = Sphere(1)\Origine\y - Sphere(2)\Origine\y
Distance = (Sphere(1)\Rayon + Sphere(2)\Rayon) * (Sphere(1)\Rayon + Sphere(2)\Rayon)
a = PRODUIT_SCALAIRE(d,d)
b = 2 * PRODUIT_SCALAIRE(d, p)
c = PRODUIT_SCALAIRE(p,p) - Distance
t = 1
If ChercheLaPlusPetiteSolution(a, b, c, t, @t)
t0 = t ; t0 = indique à quel moment aura lieu la collision
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure Normalise(*N.s_Vecteur)
Define.f NormeVecteur
NormeVecteur = NORME(*N)
If NormeVecteur > 0.0
*N\x / NormeVecteur
*N\y / NormeVecteur
EndIf
EndProcedure
