Source:CollisionSegments.pb

Télécharger ce code source
;Comtois 16/02/05
;Détection collision d'un segment avec un autre segment

;-Initialisation
Global ScreenHeight.l, ScreenWidth.l
Declare Erreur(Message$)
If ExamineDesktops()
  ScreenWidth  = DesktopWidth(0)
  ScreenHeight = DesktopHeight(0)
Else
  Erreur("Euh ?")
EndIf
If InitSprite() = 0 Or InitMouse() = 0 Or InitKeyboard()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenWindow(0,0,0,ScreenWidth,ScreenHeight,#PB_Window_BorderLess,"Collision") = 0
  Erreur("Impossible de créer la fenêtre")
EndIf
;{/ouvre un écran
If OpenWindowedScreen( WindowID(0), 0, 0, ScreenWidth , ScreenHeight, 0, 0, 0 ) = 0
  Erreur("Impossible d'ouvrir l'écran ")
EndIf

Structure Segment
  P1.point
  P2.point
EndStructure

Global Box1.Segment,Box2.Segment

Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure

Procedure.l Signe(a.l)
  If a>0
    ProcedureReturn 1
  ElseIf a=0
    ProcedureReturn 0
  Else
    ProcedureReturn -1
  EndIf
EndProcedure

Procedure.l Min(a.l,b.l)
  If a<b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure

Procedure.l Max(a.l,b.l)
  If a>b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure

Procedure Encadrement(*S1.Segment,*S2.Segment)
  ;Box Segment1
  Box1\P1\x = Min(*S1\P1\x, *S1\P2\x)
  Box1\P1\y = Min(*S1\P1\y, *S1\P2\y)
  Box1\P2\x = Max(*S1\P1\x, *S1\P2\x)
  Box1\P2\y = Max(*S1\P1\y, *S1\P2\y)
  ;Box Segment2
  Box2\P1\x = Min(*S2\P1\x, *S2\P2\x)
  Box2\P1\y = Min(*S2\P1\y, *S2\P2\y)
  Box2\P2\x = Max(*S2\P1\x, *S2\P2\x)
  Box2\P2\y = Max(*S2\P1\y, *S2\P2\y)
EndProcedure

Procedure CollisionSegmentSegment(*S1.Segment,*S2.Segment)
  ;Test Collision encadrement
  If Box1\P2\x >= Box2\P1\x And Box1\P1\x <= Box2\P2\x And Box1\P2\y >= Box2\P1\y And Box1\P1\y <= Box2\P2\y
    ;Test chevauchement segments
    R1.f=((*S2\P1\x-*S1\P1\x) * (*S1\P2\y-*S1\P1\y)) - ((*S2\P1\y-*S1\P1\y) * (*S1\P2\x-*S1\P1\x))
    R2.f=((*S2\P2\x-*S1\P1\x) * (*S1\P2\y-*S1\P1\y)) - ((*S2\P2\y-*S1\P1\y) * (*S1\P2\x-*S1\P1\x))
    R3.f=((*S1\P1\x-*S2\P1\x) * (*S2\P2\y-*S2\P1\y)) - ((*S1\P1\y-*S2\P1\y) * (*S2\P2\x-*S2\P1\x))
    R4.f=((*S1\P2\x-*S2\P1\x) * (*S2\P2\y-*S2\P1\y)) - ((*S1\P2\y-*S2\P1\y) * (*S2\P2\x-*S2\P1\x))
    If (Signe(R1) * Signe(R2) <= 0) And (Signe(R3) * Signe(R4) <= 0)
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndIf
EndProcedure

Procedure AffPoints(*S1.Segment,*S2.Segment,*P.point,mem)
  CouleurBox      = RGB(70,70,70)
  CouleurSegment1 = RGB(255,0,0)
  CouleurSegment2 = RGB(0,255,0)
  CouleurCurseur  = RGB(255,255,255)
  StartDrawing(ScreenOutput())
  ;/Affiche le Segment1
  Circle(*S1\P1\x, *S1\P1\y, 4, CouleurSegment1)
  Circle(*S1\P2\x, *S1\P2\y, 4, CouleurSegment1)
  LineXY(*S1\P1\x, *S1\P1\y, *S1\P2\x, *S1\P2\y, CouleurSegment1)
  ;/Affiche le Segment2
  Circle(*S2\P1\x, *S2\P1\y, 4, CouleurSegment2)
  Circle(*S2\P2\x, *S2\P2\y, 4, CouleurSegment2)
  LineXY(*S2\P1\x, *S2\P1\y, *S2\P2\x, *S2\P2\y, CouleurSegment2)
  ;/Affiche le point
  If mem
    DrawingMode(4)
    Circle(*P\x, *P\y, 6, CouleurCurseur)
  Else
    DrawingMode(0)
    Circle(*P\x,*P\y, 4, CouleurCurseur)
  EndIf
  ;/Affiche une croix pour mieux suivre le déplacement du point
  LineXY(*P\x, 0, *P\x, ScreenHeight - 1, CouleurCurseur)
  LineXY(0, *P\y, ScreenWidth - 1, *P\y, CouleurCurseur)
  Locate(0, 0)
  If CollisionSegmentSegment(*S1, *S2)
    FrontColor(255, 255, 0)
    BackColor(255, 0, 0)
    texte$  =" IN "
  Else
    FrontColor(255, 255, 255)
    BackColor(0, 255, 0)
    texte$ = " OUT "
  EndIf
  DrawText(texte$)
  StopDrawing()
EndProcedure

Procedure TestPoint(X1, Y1, X2, Y2, d)
  If X1 > X2 - d And X1 < X2 + d And Y1 > Y2 - d And Y1 < Y2 + d
    Resultat = #True
  EndIf
  ProcedureReturn Resultat
EndProcedure

Segment1.Segment
Segment2.Segment
Point.point
;Segment1
Segment1\P1\x = 50
Segment1\P1\y = 50
Segment1\P2\x = 110
Segment1\P2\y = 250
;Segment2
Segment2\P1\x = 210
Segment2\P1\y = 250
Segment2\P2\x = 410
Segment2\P2\y = 350
;Point à tester
Point\x = 340
Point\y = 100
DiametreSelection=6

Repeat
  While WindowEvent() : Wend
  ClearScreen(0, 0, 0)
  ExamineKeyboard()
  ExamineMouse()
  ;Les segments sont modifiables à la souris en cliquant sur un point 
  If MouseButton(1)
    If MemPoint = 1
      Segment1\P1\x = MouseX()
      Segment1\P1\y = MouseY()
    ElseIf MemPoint = 2
      Segment1\P2\x = MouseX()
      Segment1\P2\y = MouseY()
    ElseIf MemPoint = 3
      Segment2\P1\x = MouseX()
      Segment2\P1\y = MouseY()
    ElseIf MemPoint = 4
      Segment2\P2\x = MouseX()
      Segment2\P2\y = MouseY()
    EndIf
  Else
    MemPoint = 0
  EndIf
  If TestPoint(MouseX(), MouseY(), Segment1\P1\x, Segment1\P1\y, DiametreSelection)
    MemPoint = 1
  ElseIf TestPoint(MouseX(), MouseY(), Segment1\P2\x, Segment1\P2\y, DiametreSelection)
    MemPoint = 2
  ElseIf TestPoint(MouseX(), MouseY(), Segment2\P1\x, Segment2\P1\y, DiametreSelection)
    MemPoint = 3
  ElseIf TestPoint(MouseX(), MouseY(), Segment2\P2\x, Segment2\P2\y, DiametreSelection)
    MemPoint = 4
  EndIf
  ;Place le point à tester sous la souris
  Point\x = MouseX()
  Point\y = MouseY()
  ;Affiche le tout
  Encadrement(@Segment1, @Segment2)
  AffPoints(@Segment1, @Segment2, @Point, MemPoint)
  FlipBuffers()
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
Récupérée de « http://www.games-creators.org/wiki/Source:CollisionSegments.pb »
Catégorie: PureBasic