I have not taken the time to fix it and simplify it.
But it works a bit
[EDIT]
The bug is fixed with 5.00, and I modified the code so it can work with version 5.00.
math3D.pbi
Code: Select all
#Epsilon = 0.0001
;Vue Camera
Enumeration
#VueArriere
#VueDessus
EndEnumeration
;Body
Enumeration
#BodyBoite
#BodySphere
#BodyCylindre
EndEnumeration
Structure s_Vecteur
x.f
y.f
z.f
EndStructure
Structure s_Body
Entity.l ;Numéro de l'entity associé au Body
Name.s ;Nom de l'objet
Body.l ;Type du body -> Boîte, Sphère, Cylindre, Cône
StructureUnion
Origine.s_Vecteur ;Origine d'une sphere
Mini.s_Vecteur ;Position mini d'une boite
EndStructureUnion
Maxi.s_Vecteur ;Position maxi d'une boite
Taille.s_Vecteur ;Demi taille d'une boite
Rayon.f ;Rayon d'une sphère ou d'un cylindre
DemiHauteur.f ;Demi-Hauteur d'un cylindre
EndStructure
Structure s_Rayon
*Objet.s_Body ;Adresse de l'objet en collision avec le rayon
Origine.s_Vecteur ;Origine du rayon
Direction.s_Vecteur ;Vecteur directeur du rayon
;Informations collisions
CollisionDetectee.l
DistanceLaPlusCourte.f
PointIntersection.s_Vecteur
EndStructure
Structure s_Plan
Constante.f
Origine.s_Vecteur
Normale.s_Vecteur
EndStructure
; Structure s_Souris
; Clic.l
; Pos2D.POINT
; Pos3D.s_Vecteur
; Rayon.s_Rayon
; EndStructure
Macro COPIE_VECTEUR(V, V1)
V\x = V1\x
V\y = V1\y
V\z = V1\z
EndMacro
Macro ADDITION_VECTEUR(V, V1, V2)
V\x = V1\x + V2\x
V\y = V1\y + V2\y
V\z = V1\z + V2\z
EndMacro
Macro SOUSTRACTION_VECTEUR(V, V1, V2)
V\x = V1\x - V2\x
V\y = V1\y - V2\y
V\z = V1\z - V2\z
EndMacro
Macro NORME(V)
(Sqr(V\x * V\x + V\y * V\y + V\z * V\z))
EndMacro
Macro NORME_AU_CARRE(V)
(V\x * V\x + V\y * V\y + V\z * V\z)
EndMacro
Macro PRODUIT_VECTORIEL(N, V1, V2)
N\x = ((V1\y * V2\z) - (V1\z * V2\y))
N\y = ((V1\z * V2\x) - (V1\x * V2\z))
N\z = ((V1\x * V2\y) - (V1\y * V2\x))
EndMacro
Macro PRODUIT_SCALAIRE(V1, V2)
(V1\x * V2\x + V1\y * V2\y + V1\z * V2\z)
EndMacro
Macro NEW_X(x, Angle, Distance)
((x) + Cos(Radian(Angle) ) * (Distance))
EndMacro
Macro NEW_Z(z, Angle, Distance)
((z) + Sin(Radian(Angle)) * (Distance))
EndMacro
Procedure UpdateObjets(List Objet.s_Body())
;Ajouter la gestion des rotations
Select Objet()\Body
Case #BodyBoite
Objet()\Mini\x = EntityX(Objet()\Entity) - Objet()\Taille\x
Objet()\Mini\y = EntityY(Objet()\Entity) - Objet()\Taille\y
Objet()\Mini\z = EntityZ(Objet()\Entity) - Objet()\Taille\z
Objet()\Maxi\x = EntityX(Objet()\Entity) + Objet()\Taille\x
Objet()\Maxi\y = EntityY(Objet()\Entity) + Objet()\Taille\y
Objet()\Maxi\z = EntityZ(Objet()\Entity) + Objet()\Taille\z
Case #BodySphere, #BodyCylindre
Objet()\Origine\x = EntityX(Objet()\Entity)
Objet()\Origine\y = EntityY(Objet()\Entity)
Objet()\Origine\z = EntityZ(Objet()\Entity)
EndSelect
EndProcedure
Procedure Normalise(*N.s_Vecteur)
Define.f NormeVecteur
NormeVecteur = NORME(*N)
If NormeVecteur <> 0.0
*N\x / NormeVecteur
*N\y / NormeVecteur
*N\z / NormeVecteur
EndIf
EndProcedure
Procedure ChercheSolution(a.f, b.f, c.f, *Solution1.Float, *Solution2.Float)
Define.f Determinant, t1, t2, q
;Cherche les solutions d'une équation de cette forme : At²+Bt+C=0
;http://fr.wikipedia.org/wiki/%C3%89quation_du_second_degr%C3%A9 (bas de la page "Gain de précision")
;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
If a = 0.0
t1 = -c / b
If t1 >= #Epsilon
*Solution1\f = t1
*Solution2\f = -1
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
Else
t1 = (-b - Sqr(Determinant)) / (2 * a)
t2 = (-b + Sqr(Determinant)) / (2 * a)
If t2 < #Epsilon
ProcedureReturn #False
EndIf
*Solution1\f = t1
*Solution2\f = t2
ProcedureReturn #True
EndIf
EndProcedure
Procedure IntersectionRayonPlan(*Rayon.s_Rayon, *Plan.s_Plan)
Define.s_Vecteur PointCollision,PointIntersectionSurLePlan
Define.f PScalaireNormalePlanRayon, DistanceRayonPlan, t
;Calcul le produit scalaire Normale du plan avec le vecteur directeur du rayon
PScalaireNormalePlanRayon = PRODUIT_SCALAIRE(*Plan\normale, *Rayon\Direction)
;Le rayon est parallèle au plan
If PScalaireNormalePlanRayon >= -#Epsilon And PScalaireNormalePlanRayon <= #Epsilon
ProcedureReturn #False
EndIf
;Calcul la distance du rayon au plan (d=N.S0+Cp : http://homeomath.imingo.net/displan.htm)
DistanceRayonPlan = PRODUIT_SCALAIRE(*Rayon\Origine, *Plan\normale) + *Plan\Constante
;Intersection avec le plan
t = -DistanceRayonPlan / PScalaireNormalePlanRayon
;Pas de collision
If t < #Epsilon
ProcedureReturn #False
EndIf
;Point d'intersection avec le plan
PointIntersectionSurLePlan\x = (*Rayon\Origine\x + t * *Rayon\Direction\x)
PointIntersectionSurLePlan\y = (*Rayon\Origine\y + t * *Rayon\Direction\y)
PointIntersectionSurLePlan\z = (*Rayon\Origine\z + t * *Rayon\Direction\z)
;Collision
COPIE_VECTEUR(*Rayon\PointIntersection, PointIntersectionSurLePlan)
*Rayon\CollisionDetectee = #True
EndProcedure
Procedure IntersectionRayonSphere(*Rayon.s_Rayon, *Sphere.s_Body)
Define.f RayonCarre, ProjectionOrthogonale
Define.f DistanceCarre, DistanceCentreRayon, DistanceSurface, Distance
Define.s_Vecteur RayonSphere
Define.l OrigineDansSphere
SOUSTRACTION_VECTEUR(RayonSphere, *Sphere\Origine, *Rayon\Origine)
DistanceCarre = NORME_AU_CARRE(RayonSphere)
RayonCarre = *Sphere\Rayon * *Sphere\Rayon
;L'origine du rayon est à l'intérieur de la sphère
If DistanceCarre <= RayonCarre
OrigineDansSphere = #True
EndIf
;Projection orthogonale du centre de la sphère sur le rayon
ProjectionOrthogonale = PRODUIT_SCALAIRE(RayonSphere, *Rayon\Direction)
If ProjectionOrthogonale < 0
ProcedureReturn #False
EndIf
;Distance du centre de la sphère au rayon (Au carré)
DistanceCentreRayon = DistanceCarre - (ProjectionOrthogonale * ProjectionOrthogonale)
;Distance le long du rayon pour atteindre la surface de la sphère (Au carré)
DistanceSurface = RayonCarre - DistanceCentreRayon
If DistanceSurface < 0
ProcedureReturn #False
EndIf
;Intersection du rayon avec la sphere
If OrigineDansSphere
Distance = ProjectionOrthogonale + Sqr(DistanceSurface)
Else
Distance = ProjectionOrthogonale - Sqr(DistanceSurface)
EndIf
If *Rayon\CollisionDetectee = #False Or Distance < *Rayon\DistanceLaPlusCourte
*Rayon\DistanceLaPlusCourte = Distance
*Rayon\Objet = *Sphere
*Rayon\CollisionDetectee = #True
EndIf
ProcedureReturn #True
EndProcedure
Procedure IntersectionRayonBoite(*Rayon.s_Rayon, *Boite.s_Body)
Define.f I_Proche, I_Loin, t0, t1
I_Proche = -2147483648.0
I_Loin = 2147483647.0
;Test les plans X
If *Rayon\Direction\x = 0.0
If *Rayon\Origine\X < *Boite\Mini\x Or *Rayon\Origine\X > *Boite\Maxi\x
ProcedureReturn #False
EndIf
Else
;Calcul les distances des intersections Rayon/plan
t0 = (*Boite\Mini\x - *Rayon\Origine\x) / *Rayon\Direction\x
t1 = (*Boite\Maxi\x - *Rayon\Origine\x) / *Rayon\Direction\x
If t0 > t1
Swap t0,t1
EndIf
If t0 > I_Proche
I_Proche = t0
EndIf
If t1 < I_Loin
I_Loin = t1
EndIf
If I_Proche > I_Loin Or I_Loin < #Epsilon
ProcedureReturn #False
EndIf
EndIf
;Test les plans Y
If *Rayon\Direction\y = 0.0
If *Rayon\Origine\y < *Boite\Mini\y Or *Rayon\Origine\y > *Boite\Maxi\y
ProcedureReturn #False
EndIf
Else
;Calcul les distances des intersections Rayon/plan
t0 = (*Boite\Mini\y - *Rayon\Origine\y) / *Rayon\Direction\y
t1 = (*Boite\Maxi\y - *Rayon\Origine\y) / *Rayon\Direction\y
If t0 > t1
Swap t0,t1
EndIf
If t0 > I_Proche
I_Proche = t0
EndIf
If t1 < I_Loin
I_Loin = t1
EndIf
If I_Proche > I_Loin Or I_Loin < #Epsilon
ProcedureReturn #False
EndIf
EndIf
;Test les plans Z
If *Rayon\Direction\z = 0.0
If *Rayon\Origine\z < *Boite\Mini\z Or *Rayon\Origine\z > *Boite\Maxi\z
ProcedureReturn #False
EndIf
Else
;Calcul les distances des intersections Rayon/plan
t0 = (*Boite\Mini\z - *Rayon\Origine\z) / *Rayon\Direction\z
t1 = (*Boite\Maxi\z - *Rayon\Origine\z) / *Rayon\Direction\z
If t0 > t1
Swap t0,t1
EndIf
If t0 > I_Proche
I_Proche = t0
EndIf
If t1 < I_Loin
I_Loin = t1
EndIf
If I_Proche > I_Loin Or I_Loin < #Epsilon
ProcedureReturn #False
EndIf
EndIf
;Intersection du rayon avec la boite
If I_Proche > #Epsilon
If *Rayon\CollisionDetectee = #False Or I_Proche < *Rayon\DistanceLaPlusCourte
*Rayon\DistanceLaPlusCourte = I_Proche
*Rayon\Objet = *Boite
EndIf
ElseIf *Rayon\CollisionDetectee = #False Or I_Loin < *Rayon\DistanceLaPlusCourte
*Rayon\DistanceLaPlusCourte = I_Loin
*Rayon\Objet = *Boite
EndIf
*Rayon\CollisionDetectee = #True
ProcedureReturn #True
EndProcedure
Procedure IntersectionRayonCylindre(*Rayon.s_Rayon, *Cylindre.s_Body)
Define.f a, b , c, d, x, y, z, t, t1, t2, th, tb, RayonCylindreCarre
Define.s_Vecteur PointIntersection, Distance
;Calcul Rayon du cylindre au carré (utilisé plusieurs fois)
RayonCylindreCarre = *Cylindre\Rayon * *Cylindre\Rayon
;Passe le rayon dans le repère du cylindre
*Rayon\Origine\x - *Cylindre\Origine\x
*Rayon\Origine\y - *Cylindre\Origine\y
*Rayon\Origine\z - *Cylindre\Origine\z
;Appliquer ici la matrice de rotation du cylindre au rayon (origine et vecteur directeur)
;Test le corps du cylindre
;Résolution de l'équation at² + bt + c = 0
a = (*Rayon\Direction\x * *Rayon\Direction\x) + (*Rayon\Direction\z * *Rayon\Direction\z)
b = 2 * ((*Rayon\Origine\x * *Rayon\Direction\x) + (*Rayon\Origine\z * *Rayon\Direction\z))
c = (*Rayon\Origine\x * *Rayon\Origine\x) + (*Rayon\Origine\z * *Rayon\Origine\z) - RayonCylindreCarre
t= -1
If ChercheSolution(a, b, c, @t1, @t2)
y = *Rayon\Origine\y + (t1 * *Rayon\Direction\y)
If t1>=#Epsilon And y >= -*Cylindre\DemiHauteur And y <= *Cylindre\DemiHauteur
t = t1
ElseIf t2>=#Epsilon
y = *Rayon\Origine\y + (t2 * *Rayon\Direction\y)
If y >= -*Cylindre\DemiHauteur And y <= *Cylindre\DemiHauteur
t= t2
EndIf
EndIf
EndIf
If t<>t1
;Test le haut du cylindre
th = (*Cylindre\DemiHauteur - *Rayon\Origine\y) / *Rayon\Direction\y
x = *Rayon\Origine\x + th * *Rayon\Direction\x
z = *Rayon\Origine\z + th * *Rayon\Direction\z
If (((x * x) + (z * z)) <= RayonCylindreCarre) And (th < t Or t=-1)
t = th
EndIf
;Test le bas du cylindre
tb = (-*Cylindre\DemiHauteur - *Rayon\Origine\y) / *Rayon\Direction\y
x = *Rayon\Origine\x + tb * *Rayon\Direction\x
z = *Rayon\Origine\z + tb * *Rayon\Direction\z
If (((x * x) + (z * z)) <= RayonCylindreCarre) And (tb < t Or t=-1)
t = tb
EndIf
EndIf
PointIntersection\x = *Rayon\Origine\x + t * *Rayon\Direction\x
PointIntersection\y = *Rayon\Origine\y + t * *Rayon\Direction\y
PointIntersection\z = *Rayon\Origine\z + t * *Rayon\Direction\z
SOUSTRACTION_VECTEUR(Distance, PointIntersection, *Rayon\Origine)
;Remet le rayon dans le repère de la scène
*Rayon\Origine\x + *Cylindre\Origine\x
*Rayon\Origine\y + *Cylindre\Origine\y
*Rayon\Origine\z + *Cylindre\Origine\z
;Calcul le point d'intersection
If t>-1
d = NORME(Distance)
If *Rayon\CollisionDetectee = #False Or d < *Rayon\DistanceLaPlusCourte
*Rayon\DistanceLaPlusCourte = d
*Rayon\Objet = *Cylindre
*Rayon\CollisionDetectee = #True
EndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.f curveValue(actuelle.f, Cible.f, P.f)
If P > 1000.0
P = 1000.0
EndIf
ProcedureReturn (actuelle + ( (Cible - actuelle) * P / 1000.0))
EndProcedure
Procedure.f CurveAngle(oldangle.f,newangle.f, increments.f)
If increments>1
If (oldangle+360)-newangle<newangle-oldangle
oldangle=360+oldangle
EndIf
If (newangle+360)-oldangle<oldangle-newangle
newangle=360+newangle
EndIf
oldangle=oldangle-(oldangle-newangle)/increments
EndIf
If increments<=1
ProcedureReturn newangle
EndIf
ProcedureReturn oldangle
EndProcedure
Procedure GestionCamera(Camera, Mode, Entity)
Define.f Px, Py, Pz, Pv, Pp
Static AngleCamera.f
Pv = 25
Pp = 10
Select Mode
Case #VueDessus
AngleCamera = CurveAngle(AngleCamera, EntityYaw(Entity) + 180, Pp)
Px = CurveValue(CameraX(Camera), NEW_X(EntityX(Entity), AngleCamera, 100), Pv)
Py = CurveValue(CameraY(Camera), EntityY(Entity) + 390, Pv)
Pz = CurveValue(CameraZ(Camera), NEW_Z(EntityZ(Entity), AngleCamera, 100), Pv)
Case #VueArriere
AngleCamera = CurveAngle(AngleCamera, EntityYaw(Entity) + 180, Pp)
Px = CurveValue(CameraX(Camera), NEW_X(EntityX(Entity), AngleCamera, 110), Pv)
Py = CurveValue(CameraY(Camera), EntityY(Entity) + 70, Pv)
Pz = CurveValue(CameraZ(Camera), NEW_Z(EntityZ(Entity), AngleCamera, 110), Pv)
EndSelect
CameraLocate(Camera, Px, Py, Pz)
CameraLookAt(Camera, EntityX(Entity), EntityY(Entity) + 15, EntityZ(Entity))
EndProcedure
Code: Select all
XIncludeFile "Math3D.pbi"
#PlayerSpeed = 2
#CameraSpeed = 2
#Speed = 250
Define.f MouseX, MouseY, VitesseRotation
Define Rayon.s_Rayon,Dist=25 , Sens = 1, Time = ElapsedMilliseconds()
NewList Objets.s_Body()
InitEngine3D()
InitSprite()
InitKeyboard()
InitMouse()
ExamineDesktops()
Sx=DesktopWidth(0)/2
Sy=DesktopHeight(0)/2
OpenScreen(DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "PointPick")
;-Mesh
CreatePlane(0, 500, 500, 30, 30, 1, 1)
CreateCube(1, 1)
CreateSphere(2, 10)
CreateCylinder(3,10, 70)
UpdateMeshBoundingBox(3)
CreateEntity(0,MeshID(0), #PB_Material_None, 0, 0, 0)
;Cube
AddElement(Objets())
Objets()\Entity = CreateEntity(#PB_Any, MeshID(1), #PB_Material_None, 0, 10, 90)
Objets()\Name = "Boite "
Objets()\Body = #BodyBoite
Objets()\Taille\x = 10
Objets()\Taille\y = 10
Objets()\Taille\z = 30
ScaleEntity(Objets()\Entity, Objets()\Taille\x *2, Objets()\Taille\y*2, Objets()\Taille\Z*2)
UpdateObjets(Objets())
;Sphere
AddElement(Objets())
Objets()\Entity = CreateEntity(#PB_Any, MeshID(2), #PB_Material_None, -70, 10, 0)
Objets()\Name = "Sphere "
Objets()\Body = #BodySphere
Objets()\Rayon = 10
UpdateObjets(Objets())
;Cylindre
AddElement(Objets())
Objets()\Entity = CreateEntity(#PB_Any, MeshID(3), #PB_Material_None, 70, 35, 0)
Objets()\Name = "Cylindre "
Objets()\Body = #BodyCylindre
Objets()\Rayon = 10
Objets()\DemiHauteur = 35
UpdateObjets(Objets())
;Entity chercheuse
CreateEntity(5,MeshID(1), #PB_Material_None, 0, 10, -230)
ScaleEntity(5, 20, 20, 20)
;-Camera haut
CreateCamera(0, 0, 0, 400, 100)
CameraLocate(0,0,100,300)
CameraLookAt(0, EntityX(0), EntityY(0), EntityZ(0))
;-Sprite
CreateSprite(1, 250, 25)
;-Light
CreateLight(0, $FFFFFF, 1560, 900, 500)
AmbientColor($330000)
Repeat
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
Mode=#VueArriere
ElseIf KeyboardReleased(#PB_Key_F2)
Mode=#VueDessus
EndIf
If KeyboardPushed(#PB_Key_Up)
MoveEntity(5, NEW_X(0, EntityYaw(5), #PlayerSpeed), 0, NEW_Z(0, EntityYaw(5), #PlayerSpeed))
ElseIf KeyboardPushed(#PB_Key_Down)
MoveEntity(5, NEW_X(0, EntityYaw(5), -#PlayerSpeed), 0, NEW_Z(0, EntityYaw(5), -#PlayerSpeed))
EndIf
If KeyboardPushed(#PB_Key_Left)
RotateEntity(5, 0, VitesseRotation, 0, #PB_Relative)
ElseIf KeyboardPushed(#PB_Key_Right)
RotateEntity(5, 0, -VitesseRotation ,0, #PB_Relative)
EndIf
EndIf
If ExamineMouse()
MouseX = -(MouseDeltaX()/10)*#Playerspeed
MouseY = -(MouseDeltaY()/10)*#PlayerSpeed
EndIf
Rayon\Origine\x = EntityX(5)
Rayon\Origine\y = EntityY(5)
Rayon\Origine\z = EntityZ(5)
Rayon\Direction\x = Cos(Radian(EntityYaw(5)))
Rayon\Direction\y = 0
Rayon\Direction\z = -Sin(Radian(EntityYaw(5)))
With Rayon\Origine
If Rayon\CollisionDetectee
VitesseRotation = 0.2
Rayon\PointIntersection\x = \x + Rayon\Direction\x * Rayon\DistanceLaPlusCourte
Rayon\PointIntersection\y = \y + Rayon\Direction\y * Rayon\DistanceLaPlusCourte
Rayon\PointIntersection\z = \z + Rayon\Direction\z * Rayon\DistanceLaPlusCourte
CreateLine3D(10, \x, \y, \z, RGB(255, 0, 0), Rayon\PointIntersection\x, Rayon\PointIntersection\y, Rayon\PointIntersection\z, RGB(255, 0, 0))
Else
VitesseRotation = 1
CreateLine3D(10, \x, \y, \z, $00FF00, \x + Rayon\Direction\x * Dist , \y + Rayon\Direction\y * Dist, \z + Rayon\Direction\z * Dist, $00FF00)
EndIf
EndWith
Rayon\CollisionDetectee = 0
ForEach Objets()
If Objets()\body = #BodySphere
IntersectionRayonSphere(@Rayon, Objets()) ; Le bug Assertion apparait si je valide mes fonctions Intersections
ElseIf Objets()\body = #BodyBoite
IntersectionRayonBoite(@Rayon, Objets())
ElseIf Objets()\body = #BodyCylindre
IntersectionRayonCylindre(@Rayon, Objets())
EndIf
Next
GestionCamera(0, Mode, 5)
RenderWorld()
StartDrawing(SpriteOutput(1))
Box(0,0,250,25,0)
If Rayon\CollisionDetectee
DrawText(0,0, Rayon\Objet\Name, $00FFFF)
EndIf
StopDrawing()
DisplayTransparentSprite(1,0,0)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
End