Collision optimization question

Advanced game related topics
Heathen
Enthusiast
Enthusiast
Posts: 498
Joined: Tue Sep 27, 2005 6:54 pm
Location: At my pc coding..

Collision optimization question

Post by Heathen »

Hey guys. In one of my programs, there are 2d circles which represent 'figures' in the world which need to do accurate collision tests with each other. Because of the nature of the program, I can't just use simple bounding boxes, I need to do distance calculations since they're all circles and the collision needs to be smooth. Here is how I'm doing it:

-Loop through the objects
--- Handle their actions, movement etc
--- Call collision procedure

Collision procedure
--- Loop through the objects
------ Do a simple distance calculation: abs(x1-x2)+abs(y1+y2)
------- If the distance check passes, do a more accurate distance calculation: sqr(pow(x1-x2,2) + pow(y1-y2,2))
------- If they lie within the distance of their radii, push the this object out of the collision
------- Call collision procedure on this object since it has now moved

This method works and looks natural, but it's not as fast as I need it to be. When there's around 200 objects, it slows to about 50 cycles per second when not rendering. The problem is, my program needs two things, the ability to handle a large number of objects, and the ability to do it fast. Every cycle lost per second is a problem with my program.

Does anyone know of a better way of doing this?

Here's the actual distance checking procedure:

Code: Select all

Procedure.f distance(x1.f,y1.f,x2.f,y2.f)
  !FLD dword[p.v_x2]
  !FLD dword[p.v_x1]
  !FSUBP 
  !FLD st0
  !FMULP
  !FLD dword[p.v_y2]
  !FLD dword[p.v_y1]
  !FSUBP 
  !FLD st0
  !FMULP
  !FADDP
  !FSQRT
  ProcedureReturn
EndProcedure
I love Purebasic.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Collision optimization question

Post by djes »

I think that doing two distance checks (and a IF condition test) is slower than only one check.
Heathen
Enthusiast
Enthusiast
Posts: 498
Joined: Tue Sep 27, 2005 6:54 pm
Location: At my pc coding..

Re: Collision optimization question

Post by Heathen »

djes wrote:I think that doing two distance checks (and a IF condition test) is slower than only one check.
Actually, that's not true. If I remove the first distance check, it slows down. Sqr and SQRT are slow compared to simple addition and subtraction. It would be faster if the objects were always colliding, but that's not the case. The first distance check usually fails and it moves on to the next object.
I love Purebasic.
User avatar
Kaeru Gaman
Addict
Addict
Posts: 4826
Joined: Sun Mar 19, 2006 1:57 pm
Location: Germany

Re: Collision optimization question

Post by Kaeru Gaman »

you can spare Sqr and Pow.

Pow( x, 2) is just x*x, that is way faster.

and since you only need to compare if the distance is smaller than the sum of the radiuses, you can eliminate the Sqr aswell.

here an example I wrote some time ago with the Help of NickTheQuick:

Code: Select all

Procedure P_BoundCircleColl(x1,y1,r1,x2,y2,r2)
  Coll = #False

  dist = (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2) - (r1 + r2) * (r1 + r2)

  If dist < 0
    Coll = #True
  EndIf

  ProcedureReturn Coll

EndProcedure
additionally, perhaps you can live with 60 FpS display when you can do the calculations faster?
splitting the actions into different threads maybe an advance.
the calculations thread could run with a lot of tics per second,
the display thread only needs 60 FpS to make you see all.
oh... and have a nice day.
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Re: Collision optimization question

Post by gnasen »

I just had an idea and it was fast done, I hope it helps you:

Idea: The circles are spread smooth. Now we could check everyone with everyone what is not performant. Its better to split the area in pieces and just check which of the objects in the areas are colliding.

Here are two examples, one with a screen (circles are moving to down right) where you can see if they are colliding. If they leave the screen you will notice that they turn their color to not colliding. This is because they leave their group, so everything is fine. If you just want to see if it checks well at all, just remove the two lines.

The second one ist just to check the speed. If you comment circle_group() out, you will see that the check if a circle is inside an area doesnt effect the time very much. If its not commented out, the program thinks every circle has been moved and will check them, because they have been placed the first time. So if only a few move the speed is a little bit higher.

I hope it helps, just ask

Code: Select all

#screen_width  = 800
#screen_height = 600

#group_width  = 4
#group_height = 3

Structure circle
  posx.f
  posy.f
  radius.f
  group.i
  changed.i
  
  MOVED.i
EndStructure
Structure group
  x.i
  y.i
  width.i
  height.i
  flag.i
EndStructure
Global NewList circles.circle()
Global Dim groups.group(#group_width * #group_height - 1)

Procedure.f distance(x1.f,y1.f,x2.f,y2.f)
  !FLD dword[p.v_x2]
  !FLD dword[p.v_x1]
  !FSUBP 
  !FLD st0
  !FMULP
  !FLD dword[p.v_y2]
  !FLD dword[p.v_y1]
  !FSUBP 
  !FLD st0
  !FMULP
  !FADDP
  !FSQRT
  ProcedureReturn
EndProcedure

Procedure.i groups_create()
  
  Protected a.i
  Protected b.i
  
  For a=0 To #group_width - 1
    For b=0 To #group_height - 1
      groups(a+b*#group_width)\x      = #screen_width  / #group_width  * a
      groups(a+b*#group_width)\y      = #screen_height / #group_height * b
      groups(a+b*#group_width)\width  = #screen_width  / #group_width
      groups(a+b*#group_width)\height = #screen_height / #group_height
      groups(a+b*#group_width)\flag   = Pow(2,a*#group_width+b)
    Next
  Next
  
EndProcedure

Procedure.i circle_add(posx.f,posy.f,radius.f)
  
  AddElement(circles())
  circles()\posx    = posx
  circles()\posy    = posy
  circles()\radius  = radius
  circles()\changed = #true 
  
EndProcedure
Procedure.i circle_group()
  
  Protected a.i
  
  ForEach circles()
    If circles()\changed
      
      circles()\changed = #False
      circles()\group   = 0
      
      For a=0 To #group_width * #group_height - 1
        If (circles()\posx + circles()\radius >= groups(a)\x) And (circles()\posx - circles()\radius <= groups(a)\x + groups(a)\width)
          If (circles()\posy + circles()\radius >= groups(a)\y) And (circles()\posy - circles()\radius <= groups(a)\y + groups(a)\height)
            circles()\group | groups(a)\flag
          EndIf
        EndIf
      Next
      
    EndIf
  Next
  
EndProcedure
Procedure.i circle_check()
  
  Protected groups_count.i = #group_width * #group_height - 1
  Protected *circle1.circle
  Protected *circle2.circle
  
  ForEach circles()
    circles()\MOVED = #False
  Next
  
  ForEach circles()
    
    *circle1 = circles()

    While NextElement(circles())
      
      *circle2 = circles()
      
      If *circle1\group & *circle2\group
        If distance(*circle1\posx,*circle1\posy,*circle2\posx,*circle2\posy) <= (*circle1\radius + *circle2\radius)
          *circle1\MOVED = #true
          *circle2\MOVED = #true
        EndIf
      EndIf
      
    Wend
    
    ChangeCurrentElement(circles(), *circle1)
    
  Next
  
EndProcedure

Define count.i

For count=1 To 200
  circle_add(Random(#screen_width),Random(#screen_height),Random(20)+10)
Next


groups_create()

InitSprite()

OpenScreen(#screen_width,#screen_height,32,"")

Repeat
  
  circle_group()
  circle_check()
  
  ForEach circles()
    circles()\posx + 1
    circles()\posy + 1
    circles()\changed = #true
  Next
  
  ExamineKeyboard()
  
  ClearScreen(RGB(0,0,0))

  StartDrawing(ScreenOutput())
  ForEach circles()
    If circles()\MOVED
      Circle(circles()\posx,circles()\posy,circles()\radius,$FF0000)
    Else
      Circle(circles()\posx,circles()\posy,circles()\radius,$FFFFFF)
    EndIf
  Next
  StopDrawing()
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)

Code: Select all

#screen_width  = 800
#screen_height = 600

#group_width  = 4
#group_height = 3

Structure circle
  posx.f
  posy.f
  radius.f
  group.i
  changed.i
EndStructure
Structure group
  x.i
  y.i
  width.i
  height.i
  flag.i
EndStructure
Global NewList circles.circle()
Global Dim groups.group(#group_width * #group_height - 1)

Procedure.f distance(x1.f,y1.f,x2.f,y2.f)
  !FLD dword[p.v_x2]
  !FLD dword[p.v_x1]
  !FSUBP 
  !FLD st0
  !FMULP
  !FLD dword[p.v_y2]
  !FLD dword[p.v_y1]
  !FSUBP 
  !FLD st0
  !FMULP
  !FADDP
  !FSQRT
  ProcedureReturn
EndProcedure

Procedure.i groups_create()
  
  Protected a.i
  Protected b.i
  
  For a=0 To #group_width - 1
    For b=0 To #group_height - 1
      groups(a+b*#group_width)\x      = #screen_width  / #group_width  * a
      groups(a+b*#group_width)\y      = #screen_height / #group_height * b
      groups(a+b*#group_width)\width  = #screen_width  / #group_width
      groups(a+b*#group_width)\height = #screen_height / #group_height
      groups(a+b*#group_width)\flag   = Pow(2,a*#group_width+b)
    Next
  Next
  
EndProcedure

Procedure.i circle_add(posx.f,posy.f,radius.f)
  
  AddElement(circles())
  circles()\posx    = posx
  circles()\posy    = posy
  circles()\radius  = radius
  circles()\changed = #true 
  
EndProcedure
Procedure.i circle_group()
  
  Protected a.i
  
  ForEach circles()
    If circles()\changed
      
      circles()\changed = #False
      circles()\group   = 0
      
      For a=0 To #group_width * #group_height - 1
        If (circles()\posx + circles()\radius >= groups(a)\x) And (circles()\posx - circles()\radius <= groups(a)\x + groups(a)\width)
          If (circles()\posy + circles()\radius >= groups(a)\y) And (circles()\posy - circles()\radius <= groups(a)\y + groups(a)\height)
            circles()\group | groups(a)\flag
          EndIf
        EndIf
      Next
      
    EndIf
  Next
  
EndProcedure
Procedure.i circle_check()
  
  Protected groups_count.i = #group_width * #group_height - 1
  Protected *circle1.circle
  Protected *circle2.circle
  
  ForEach circles()
    
    *circle1 = circles()
    
    While NextElement(circles())
      
      *circle2 = circles()
      
      If *circle1\group & *circle2\group
        If distance(*circle1\posx,*circle1\posy,*circle2\posx,*circle2\posy) <= (*circle1\radius + *circle2\radius)
          ; !!!!!!!!!!!!!!!!!
          ; !!! collision !!!
          ; !!!!!!!!!!!!!!!!!
        EndIf
      EndIf
      
    Wend
    
    ChangeCurrentElement(circles(), *circle1)
    
  Next
  
EndProcedure

Define count.i

For count=1 To 10000
  circle_add(Random(#screen_width),Random(#screen_height),Random(20)+10)
Next

groups_create()

; If you call circle_group() here instead, speed will increase

Define time1.i = ElapsedMilliseconds()
circle_group()
circle_check()
Define time2.i = ElapsedMilliseconds()

MessageRequester("",Str(time2-time1))

Edit:
I just saw the new post by Kaeru, you may try to replace the collision check itself with his one. This should increase the speed.
pb 5.11
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Collision optimization question

Post by djes »

Heathen wrote:
djes wrote:I think that doing two distance checks (and a IF condition test) is slower than only one check.
Actually, that's not true. If I remove the first distance check, it slows down. Sqr and SQRT are slow compared to simple addition and subtraction. It would be faster if the objects were always colliding, but that's not the case. The first distance check usually fails and it moves on to the next object.
I'd suggest you to use a quadtree, but it's what is doing the gnasen's code.
Here's an article about fast distance : http://www.flipcode.com/archives/Fast_A ... ions.shtml
User avatar
Comtois
Addict
Addict
Posts: 1432
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Re: Collision optimization question

Post by Comtois »

You can also try 'Separating axis collision detection', i dont know if it will be faster.
If you just need a collision test (Collision\Detectee), you can delete ChercheDeplacementMini(), and delete these lines in CollisionReponse()

Code: Select all

    ;Séparation des polygones   
    If Collision\Detectee
      *Voiture\Position\x - (Collision\Normale\x * (Collision\Distance * 1.0)) ; ou un peu moins que 1.5
      *Voiture\Position\y - (Collision\Normale\y * (Collision\Distance * 1.0)) ; ou un peu moins que 1.5
      MouseLocate(*Voiture\Position\x, *Voiture\Position\y)
     EndIf
So here is a try (use cursor to move white circle ):

Code: Select all

; Comtois 4.40 b3 22/09/09

If InitSprite()=0 Or InitMouse()=0 Or InitKeyboard()=0
  MessageRequester("Erreur","Initialisation impossible",0)
  End
EndIf
If OpenScreen(800, 600, 32,"Collision par la méthode de séparation des axes")=0
  MessageRequester("Erreur","Ouverture d'un écran 800x600x32 impossible",0)
  End
EndIf

#Epsilon = 0.00001
#NbSommet = 32              ;Nombre de Sommet maxi pour un polygone
#NbPlan = (#NbSommet*2)-1   ;Un plan par Sommet pour deux polygones
#DeltaAngle = 0.09/#PI
#NbPolygones = 50

Enumeration
  #A
  #B
EndEnumeration

Macro PRODUIT_SCALAIRE(V1, V2)
  (V1\x * V2\x + V1\y * V2\y)
EndMacro

Structure s_Vecteur2D
  x.f
  y.f
EndStructure

Structure s_Polygone
  Position.s_Vecteur2D         
  Vitesse.f
  Angle.f
  NbSommet.l
  Couleur.l
  Sommet.s_Vecteur2D[#NbSommet]
EndStructure

Structure s_Collision
  Detectee.l
  Normale.s_Vecteur2D
  Distance.f
EndStructure

Structure s_Intervalle
  Mini.f
  Maxi.f
EndStructure

;- Declare
Declare InitialiseJeu(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare CollisionReponse(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare GestionClavier(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare ConstructionPolygone(*Polygone.s_Polygone, Rayon.f)
Declare ConstructionMur(*Polygone.s_Polygone)
Declare AffichePolygone(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare CollisionPolygone(*A.s_Polygone, *B.s_Polygone, *Distance.s_Vecteur2D, *Collision.s_Collision)
Declare CalculeProjection(*Polygone.s_Polygone, *Axe.s_Vecteur2D, *Projection.s_Intervalle)
Declare CalculeIntersection(*A.s_Polygone, *B.s_Polygone, *Axe.s_Vecteur2D, *Distance.s_Vecteur2D, *Chevauchement.Float)
Declare ChercheDeplacementMini(Array Axe.s_Vecteur2D(1), Array Chevauchement.f(1), NbAxes.l, *Collision.s_Collision)
Declare.f Normalise(*V.s_Vecteur2D)

Define.s_Polygone Voiture
NewList Mur.s_Polygone()

InitialiseJeu(@Voiture, Mur())
;- Main
Repeat
  ClearScreen(#Black)
  GestionClavier(@Voiture, Mur())
  CollisionReponse(@Voiture, Mur())
  AffichePolygone(@Voiture, Mur())
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Procedure InitialiseJeu(*Voiture.s_Polygone, List Mur.s_Polygone())
  ;Création du jeu
  Define.l i, Rayon

  ;Mouse
  *Voiture\Position\x = x
  *Voiture\Position\y = y
  *Voiture\NbSommet = 12
  *Voiture\Vitesse = 3
  *Voiture\Couleur = #White
  Rayon = 6
  ConstructionPolygone(*Voiture, Rayon)
 
  ClearList(Mur())
  For i = 0 To #NbPolygones-1
    AddElement(Mur())
    Rayon = Random(20)+16
    Mur()\Position\x = Rayon + Random(800-Rayon*2)
    Mur()\Position\y = Rayon + Random(600-Rayon*2)
    Mur()\NbSommet = Random(10)+3   
    Mur()\Couleur = #Yellow
    ConstructionPolygone(Mur(), Rayon)
  Next i
EndProcedure

Procedure CollisionReponse(*Voiture.s_Polygone, List Mur.s_Polygone())
  ;A reprendre
  ; Il faudrait d'abord chercher le point d'impact le plus proche en testant tous les polygones
  ; Puis calculer la réponse d'une façon récursive, en prenant un vecteur vitesse en compte.
  Define.s_Vecteur2D Distance
  Define.s_Collision Collision
  *Voiture\Couleur = #White
  ForEach Mur()
    Distance\x = *Voiture\Position\x - Mur()\Position\x
    Distance\y = *Voiture\Position\y - Mur()\Position\y
    Collision\Detectee = CollisionPolygone(*Voiture, Mur(), @Distance, @Collision)
    ;Séparation des polygones   
    If Collision\Detectee
      *Voiture\Couleur = #Green
      ;Mur()\Couleur = #Red
      *Voiture\Position\x - (Collision\Normale\x * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
      *Voiture\Position\y - (Collision\Normale\y * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
      MouseLocate(*Voiture\Position\x, *Voiture\Position\y)
      Mur()\Position\x + (Collision\Normale\x * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
      Mur()\Position\y + (Collision\Normale\y * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
    EndIf
  Next
EndProcedure

Procedure GestionClavier(*Voiture.s_Polygone, List Mur.s_Polygone())
  If ExamineKeyboard()
    If KeyboardReleased(#PB_Key_Space)
      InitialiseJeu(*Voiture, Mur())
    EndIf
    If KeyboardPushed(#PB_Key_Up)
      *Voiture\Position\y - *Voiture\Vitesse
    ElseIf KeyboardPushed(#PB_Key_Down)
      *Voiture\Position\y + *Voiture\Vitesse
    EndIf
    If KeyboardPushed(#PB_Key_Left)
      *Voiture\Position\x - *Voiture\Vitesse
    ElseIf KeyboardPushed(#PB_Key_Right)
      *Voiture\Position\x + *Voiture\Vitesse
    EndIf
  EndIf   

;   If ExamineMouse()
;     *Voiture\Position\x = MouseX()
;     *Voiture\Position\y = MouseY()   
;   EndIf   
EndProcedure

Procedure ConstructionPolygone(*Polygone.s_Polygone, Rayon.f)
  ;Permet de calculer un polygone convexe
  Define.l i
   Define.f Angle, Rayon
   For i = 0 To *Polygone\NbSommet-1
    *Polygone\Sommet[i]\x = Cos(Angle) * Rayon
    *Polygone\Sommet[i]\y = Sin(Angle) * Rayon
    Angle + 2.0 * #PI / *Polygone\NbSommet
   Next i
EndProcedure

Procedure ConstructionMur(*Polygone.s_Polygone)
  Define.l i
   Define.f Angle, Rayon
  Rayon = 22.63
   Angle = #PI/4
   For i = 0 To *Polygone\NbSommet-1
    *Polygone\Sommet[i]\x = Cos(Angle) * Rayon
    *Polygone\Sommet[i]\y = Sin(Angle) * Rayon
    Angle + 2.0 * #PI / *Polygone\NbSommet
   Next i
EndProcedure

Procedure AffichePolygone(*Voiture.s_Polygone, List Mur.s_Polygone())
  StartDrawing(ScreenOutput())
  ;Affiche les murs   
  With Mur()
  ForEach  Mur()
    For i = 0 To \NbSommet-2
      LineXY(\Position\x + \Sommet[i]\x, \Position\y + \Sommet[i]\y, \Position\x + \Sommet[i+1]\x, \Position\y + \Sommet[i+1]\y, \Couleur)
    Next i
    LineXY(\Position\x + \Sommet[\NbSommet-1]\x, \Position\y + \Sommet[\NbSommet-1]\y, \Position\x + \Sommet[0]\x, \Position\y + \Sommet[0]\y, \Couleur)
   Next
   EndWith
  ;Affiche la voiture
  With *Voiture
  For i = 0 To \NbSommet-2
    LineXY(\Position\x + \Sommet[i]\x, \Position\y + \Sommet[i]\y, \Position\x + \Sommet[i+1]\x, \Position\y + \Sommet[i+1]\y, \Couleur)
  Next i
  LineXY(\Position\x + \Sommet[\NbSommet-1]\x, \Position\y + \Sommet[\NbSommet-1]\y, \Position\x + \Sommet[0]\x, \Position\y + \Sommet[0]\y, \Couleur)
  EndWith
  StopDrawing()
EndProcedure   

Procedure CollisionPolygone(*A.s_Polygone, *B.s_Polygone, *Distance.s_Vecteur2D, *Collision.s_Collision)
  Define.l j, i
  Define.s_Vecteur2D Segment
  If *A=0  Or *B=0 : ProcedureReturn #False : EndIf
   
   ; Tous les axes de séparation
   Dim Axe.s_Vecteur2D(#NbPlan)
   Dim Chevauchement.f(#NbPlan)
   Define.l NoAxe

   ;Utilisation de la méthode générale,
   ;pour un rectangle on pourrait se contenter de tester 2 segments(largeur et longueur)
   ;Une autre méthode projette le centre et le rayon du rectangle(à tester).
   
   ; test séparation des axes du polygone A
   j = *A\NbSommet-1
   For i = O To *A\NbSommet-1
     ;Calcule chaque segment du polygone
      Segment\x  = *A\Sommet[i]\x - *A\Sommet[j]\x
      Segment\y  = *A\Sommet[i]\y - *A\Sommet[j]\y
      ;Calcul la normale pour chaque segment du polygone
      Axe(NoAxe)\x = -Segment\y
      Axe(NoAxe)\y =  Segment\x
      If CalculeIntersection(*A, *B, Axe(NoAxe), *Distance, @Chevauchement(NoAxe)) = #False
         ProcedureReturn #False ; dès qu'on trouve un axe de séparation on peut sortir
      EndIf
      NoAxe + 1
      j = i
   Next i
   ; test séparation des axes du polygone B
   j = *B\NbSommet-1
   For i = O To *B\NbSommet-1
     ;Calcule chaque segment du polygone     
      Segment\x  = *B\Sommet[i]\x - *B\Sommet[j]\x ; Le polygone pourrait être stocké avec cette valeur
      Segment\y  = *B\Sommet[i]\y - *B\Sommet[j]\y ; ça éviterait de la calculer à chaque fois
      ;Calcul la normale pour chaque segment du polygone
      Axe(NoAxe)\x = -Segment\y
      Axe(NoAxe)\y =  Segment\x
      If CalculeIntersection(*A, *B, Axe(NoAxe), *Distance, @Chevauchement(NoAxe)) = #False
         ProcedureReturn #False ; dès qu'on trouve un axe de séparation on peut sortir
      EndIf
      NoAxe + 1
      j = i
   Next i
   
   ;Il faudra chercher le point d'impact !
   If ChercheDeplacementMini(Axe(), Chevauchement(), NoAxe, *Collision) = #False
      ProcedureReturn #False
   EndIf   

   ; Inverse la normale si nécessaire pour être sûr que les polygones seront bien séparés.
   If PRODUIT_SCALAIRE(*Collision\Normale, *Distance) < 0.0
      *Collision\Normale\x = -*Collision\Normale\x
      *Collision\Normale\y = -*Collision\Normale\y
   EndIf   

   ProcedureReturn #True
   
EndProcedure

; calcule la projection du polygone sur l'axe en cours de test
Procedure CalculeProjection(*Polygone.s_Polygone, *Axe.s_Vecteur2D, *Projection.s_Intervalle)
  Define.l i
  Define.f Projection
  ;Calcul la projection du Sommet[0] sur la normale du plan en cours de test
   *Projection\mini = *Polygone\Sommet[0]\x * *Axe\x + *Polygone\Sommet[0]\y * *Axe\y
   *Projection\maxi = *Projection\mini

  ;Recherche les projections mini et maxi en testant tous les sommets du polygone
   For i = 1 To *Polygone\NbSommet-1
     Projection = *Polygone\Sommet[i]\x * *Axe\x + *Polygone\Sommet[i]\y * *Axe\y
      If (Projection < *Projection\mini)
        *Projection\mini = Projection
      ElseIf (Projection > *Projection\maxi)
         *Projection\maxi = Projection
      EndIf   
   Next i
EndProcedure

Procedure CalculeIntersection(*A.s_Polygone, *B.s_Polygone, *Axe.s_Vecteur2D, *Distance.s_Vecteur2D, *Chevauchement.Float)
  Define.f h, dist0, dist1
  Define.s_Intervalle A, B
  ;Calcul la projection des sommets du polygone A sur la normale du plan en cours de test
   CalculeProjection(*A, *Axe, @A)
   ;Calcul la projection des sommets du polygone B sur la normale du plan en cours de test
   CalculeProjection(*B, *Axe, @B)

  ;Calcul la projection de l'offset entre les polygones
   h = *Distance\x *  *Axe\x + *Distance\y * *Axe\y
   
   ;Ajoute la projection de l'offset à la projection du polygone A
   A\mini + h
   A\maxi + h

  ;Calcul le chevauchement entre les projections de A et B
   dist0 = A\mini - B\maxi
   dist1 = B\mini - A\maxi


  ;Test le chevauchement
   If dist0 > 0.0 Or dist1 > 0.0
      ProcedureReturn #False
   Else
     If dist0 > dist1
       *Chevauchement\f = dist0
     Else
       *Chevauchement\f = dist1
    EndIf
      ProcedureReturn #True
   EndIf
EndProcedure

Procedure ChercheDeplacementMini(Array Axe.s_Vecteur2D(1), Array Chevauchement.f(1), NbAxes.l, *Collision.s_Collision)
   Define.l mini, i
   Define.f n
   
   ;Initialise les données collision
   mini = -1
   *Collision\distance = 0
   *Collision\Normale\x = 0
   *Collision\Normale\y = 0

  ;On cherche parmi tous les axes de séparation le chevauchement le plus petit
   For i = 0 To NbAxes-1
      n = Normalise(@Axe(i)) ; Normalise l'axe et récupère sa longueur
      Chevauchement(i) / n
   
    ;On retient le plus petit chevauchement pour se dégager de l'autre polygone
      ;les valeurs de chevauchement sont négatives d'où le test > ci dessous
      ;Par la suite il faudra aussi tenir compte du point d'impact !!
      If (Chevauchement(i) > *Collision\distance) Or (mini = -1)
         mini = i
         *Collision\distance  = Chevauchement(i)
         *Collision\Normale\x = Axe(i)\x
         *Collision\Normale\y = Axe(i)\y
      EndIf
   Next i

ProcedureReturn (mini <> -1)
EndProcedure

Procedure.f Normalise(*V.s_Vecteur2D)
  Define.f    Longueur
   Longueur = Sqr(*V\x * *V\x + *V\y * *V\y)   
   If Longueur <> 0.0
     *V\x / Longueur
    *V\y / Longueur
  EndIf
   ProcedureReturn Longueur   
EndProcedure
Last edited by Comtois on Sat Sep 26, 2009 10:31 pm, edited 2 times in total.
Please correct my english
http://purebasic.developpez.com/
User avatar
Comtois
Addict
Addict
Posts: 1432
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Re: Collision optimization question

Post by Comtois »

QuadTree demonstration

I coded a Quadtree last year : see code
Please correct my english
http://purebasic.developpez.com/
Post Reply