PureBasic Forums - English

Code: Select all

;Algorithm to detect the collision of 2 segments defined by 2 free vectors (4 points' coordinates) at any dimension (2D, 3D, 4D, ... )
;2007-03-07 by Psychophanta (Albert)
Define .f
SCREENWIDTH.l=GetSystemMetrics_(#SM_CXSCREEN):SCREENHEIGHT.l=GetSystemMetrics_(#SM_CYSCREEN)
;-INITS:
bitplanes.b=32
If InitSprite()=0 Or InitMouse()=0 Or InitKeyboard()=0
  MessageRequester("Error","Can't access DirectX",0):End
EndIf
While OpenScreen(SCREENWIDTH,SCREENHEIGHT,bitplanes.b,"")=0
  If bitplanes.b>16:bitplanes.b-8
  ElseIf SCREENHEIGHT>600:SCREENWIDTH=800:SCREENHEIGHT=600
  ElseIf SCREENHEIGHT>480:SCREENWIDTH=640:SCREENHEIGHT=480
  ElseIf SCREENHEIGHT>400:SCREENWIDTH=640:SCREENHEIGHT=400
  ElseIf SCREENHEIGHT>240:SCREENWIDTH=320:SCREENHEIGHT=240
  ElseIf SCREENHEIGHT>200:SCREENWIDTH=320:SCREENHEIGHT=200
  Else:MessageRequester("Listen:","Can't open Screen!",0):End
  EndIf
Wend
CreateSprite(0,16,16);<-The mouse cursor
StartDrawing(SpriteOutput(0)):BackColor(0)
Line(0,0,15,10,$CABE2A)
Line(0,0,5,15,$CABE2A)
LineXY(5,15,15,10,$CABE2A)
FillArea(2,2,$CABE2A,$C0C1D0)
StopDrawing()
;
Structure Vector
  x.f
  y.f
  z.f
  t.f; <- 4th dimension, you can add more dimensions, but the more dimensions the more process needed because of the vectorial products are more complex
  m2.f; <- modulus^2
  m.f; <- modulus
EndStructure
Procedure ProductoVectorialu3D(*in1.Vector,*in2.Vector,*out.Vector); <- Calculates the vectorial product of two 3D vectors. Just modify this procedure to get the vectorial product for 4D, 5D, 6D or any dimension you need.
  *out\x=*in1\y**in2\z-*in1\z**in2\y
  *out\y=*in1\z**in2\x-*in1\x**in2\z
  *out\z=*in1\x**in2\y-*in1\y**in2\x
  *out\m=Sqr(*out\x**out\x+*out\y**out\y+*out\z**out\z)
  *out\x/*out\m:*out\y/*out\m:*out\z/*out\m
EndProcedure
Define .Vector a0,b0,a,b,V,C,D,VectorialaCu,VectorialDbu,VectorialVau,VectorialVbu
;Vectores dados:
a0\x=Random(SCREENWIDTH-1):a0\y=Random(SCREENHEIGHT-1):a0\z=0
b0\x=Random(SCREENWIDTH-1):b0\y=Random(SCREENHEIGHT-1):b0\z=0
a\x=Random(SCREENWIDTH-1-a0\x):a\y=Random(SCREENHEIGHT-1-a0\y):a\z=0
b\x=Random(SCREENWIDTH-1-b0\x):b\y=Random(SCREENHEIGHT-1-b0\y):b\z=0
;
;Test it:
MouseLocate(SCREENWIDTH.l/2,SCREENHEIGHT.l/2)
Repeat
  ExamineKeyboard():ExamineMouse():ClearScreen(0)
  mx.l=MouseX():my.l=MouseY()
  ;
  V\x=b0\x-a0\x:V\y=b0\y-a0\y:V\z=b0\z-a0\z
  C\x=b0\x+b\x-a0\x:C\y=b0\y+b\y-a0\y:C\z=b0\z+b\z-a0\z
  D\x=a0\x+a\x-b0\x:D\y=a0\y+a\y-b0\y:D\z=a0\z+a\z-b0\z
  ProductoVectorialu3D(@V,@a,@VectorialVau)
  ProductoVectorialu3D(@a,@C,@VectorialaCu)
  ProductoVectorialu3D(@V,@b,@VectorialVbu)
  ProductoVectorialu3D(@D,@b,@VectorialDbu)
  ;
  If MouseButton(#PB_MouseButton_Left)
    If oldLMB.b=0:oldLMB.b=1
      dp1.f=Sqr(Pow(a0\x-mx,2)+Pow(a0\y-my,2))
      dp2.f=Sqr(Pow(b0\x-mx,2)+Pow(b0\y-my,2))
      dp3.f=Sqr(Pow(a0\x+a\x-mx,2)+Pow(a0\y+a\y-my,2))
      dp4.f=Sqr(Pow(b0\x+b\x-mx,2)+Pow(b0\y+b\y-my,2))
    EndIf
    If dp1<dp2 And dp1<dp3 And dp1<dp4
      a0\x+MouseDeltaX():a0\y+MouseDeltaY()
    ElseIf dp2<dp1 And dp2<dp3 And dp2<dp4
      b0\x+MouseDeltaX():b0\y+MouseDeltaY()
    ElseIf dp3<dp1 And dp3<dp2 And dp3<dp4
      a\x+MouseDeltaX():a\y+MouseDeltaY()
    Else:b\x+MouseDeltaX():b\y+MouseDeltaY()
    EndIf
  Else
    oldLMB.b=0
  EndIf
  StartDrawing(ScreenOutput()):DrawingMode(1)
  If VectorialVau\z=VectorialaCu\z And VectorialVau\z=VectorialVbu\z And VectorialVau\z=VectorialDbu\z:vccol.l=$56AAEE:Else:vccol.l=$af6f6f:EndIf
  DrawText(0,0,"V x a    "+StrF(VectorialVau\x)+", "+StrF(VectorialVau\y)+", "+StrF(VectorialVau\z),vccol,0)
  DrawText(0,20,"a x C    "+StrF(VectorialaCu\x)+", "+StrF(VectorialaCu\y)+", "+StrF(VectorialaCu\z),vccol,0)
  DrawText(0,40,"V x b    "+StrF(VectorialVbu\x)+", "+StrF(VectorialVbu\y)+", "+StrF(VectorialVbu\z),vccol,0)
  DrawText(0,60,"D x b    "+StrF(VectorialDbu\x)+", "+StrF(VectorialDbu\y)+", "+StrF(VectorialDbu\z),vccol,0)
  ;
  Line(a0\x,a0\y,a\x,a\y,$913FAF)
  Line(b0\x,b0\y,b\x,b\y,$C1EFDF)
  DrawText(a0\x,a0\y,"a0",$6f6f6f,0)
  DrawText(b0\x,b0\y,"b0",$6f6f6f,0)
  DrawText(a0\x+a\x,a0\y+a\y,"a0+a",$6f6f6f,0)
  DrawText(b0\x+b\x,b0\y+b\y,"b0+b",$6f6f6f,0)
  StopDrawing()
  DisplayTransparentSprite(0,mx,my)
  FlipBuffers(0):Delay(16);<--flip buffers
Until KeyboardPushed(#PB_Key_Escape)