It is currently Mon May 25, 2020 10:10 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 14 posts ] 
Author Message
 Post subject: Line intersection
PostPosted: Wed Sep 01, 2010 8:17 pm 
Offline
Always Here
Always Here

Joined: Mon Sep 22, 2003 6:45 pm
Posts: 7446
Location: Norway
Click and drag the line ends.
Code:
Structure SPoint
  x.i
  y.i
EndStructure

Structure SLine
  p.SPoint[2]
  color.i
EndStructure

Structure SIntersection
  p.SPoint
  Color.i
  Size.i
EndStructure

#W = 512
#H = 384

Global NewList Lines.SLine()
Global NewList Intersections.SIntersection()

AddElement(Lines())
Lines()\p[0]\x = 10
Lines()\p[0]\y = 10
Lines()\p[1]\x = 100
Lines()\p[1]\y = 100
Lines()\color = #Red

AddElement(Lines())
Lines()\p[0]\x = 100
Lines()\p[0]\y = 10
Lines()\p[1]\x = 200
Lines()\p[1]\y = 100
Lines()\color = #Blue

AddElement(Lines())
Lines()\p[0]\x = 300
Lines()\p[0]\y = 10
Lines()\p[1]\x = 120
Lines()\p[1]\y = 100
Lines()\color = #Green

For I = 0 To 3
  AddElement(Lines())
  Lines()\p[0]\x = Random(512)
  Lines()\p[0]\y = Random(384)
  Lines()\p[1]\x = Random(512)
  Lines()\p[1]\y = Random(384)
  Lines()\color = RGB(Random(255), Random(255), Random(255))
Next

Procedure Max(A, B)
  If A > B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure Min(A, B)
  If A < B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure PointDistance(*a.SPoint, *b.SPoint)
  xd = Abs(*a\x-*b\x)
  yd = Abs(*a\y-*b\y)
  ProcedureReturn Sqr(xd*xd + yd*yd)
EndProcedure

Procedure Repaint()
  CreateImage(0, WindowWidth(0), WindowHeight(0))
  StartDrawing(ImageOutput(0))
    Box(0, 0, WindowWidth(0), WindowHeight(0), #White)
    ForEach Lines()
      LineXY(Lines()\p[0]\x, Lines()\p[0]\y, Lines()\p[1]\x, Lines()\p[1]\y, Lines()\color)
    Next
    ForEach Intersections()
      Circle(Intersections()\p\x, Intersections()\p\y, Intersections()\Size, Intersections()\Color)
    Next
  StopDrawing()
  StartDrawing(WindowOutput(0))
    DrawImage(ImageID(0), 0, 0)
  StopDrawing()
EndProcedure

Procedure FindClosestLineEnd(*p.SPoint)
  M.d = 1000000
  For I = 0 To 1
    ForEach Lines()
      D = PointDistance(@Lines()\p[I], *p)
      If D < M
        M = D
        *r = @Lines()\p[I]
      EndIf
    Next
  Next
  ProcedureReturn *R
EndProcedure

Procedure LineIntersection(*L1.SLine, *L2.SLine, *Cross.SPoint)
  A1 = *L1\p[1]\y - *L1\p[0]\y
  B1 = *L1\p[0]\x - *L1\p[1]\x
  C1 = A1 * *L1\p[0]\x + B1 * *L1\p[0]\y
 
  A2 = *L2\p[1]\y - *L2\p[0]\y
  B2 = *L2\p[0]\x - *L2\p[1]\x
  C2 = A2 * *L2\p[0]\x + B2 * *L2\p[0]\y
 
  det.d = A1*B2 - A2*B1
  If det = 0
    ProcedureReturn 0 ; No intersection
  Else
    *cross\x = (B2*C1 - B1*C2)/det
    *Cross\y = (A1*C2 - A2*C1)/det
   
    With *L1 ; On *L1 line segment?
      If Min(\p[0]\x, \p[1]\x) <= *cross\x And Max(\p[0]\x, \p[1]\x) >= *cross\x
        If Min(\p[0]\y, \p[1]\y) <= *cross\y And Max(\p[0]\y, \p[1]\y) >= *cross\y
    EndWith
    With *L2 ; On *L2 line segment?
          If Min(\p[0]\x, \p[1]\x) <= *cross\x And Max(\p[0]\x, \p[1]\x) >= *cross\x
            If Min(\p[0]\y, \p[1]\y) <= *cross\y And Max(\p[0]\y, \p[1]\y) >= *cross\y
    EndWith
              ProcedureReturn 1
            EndIf
         EndIf
      EndIf
    EndIf
   
    ProcedureReturn 2 ; Lines intersect, but line segments do not
  EndIf
EndProcedure

Procedure UpdateIntersections()
  ClearList(Intersections())
  Protected P.SPoint
  Protected NewList LinesCopy.SLine()
 
  CopyList(Lines(), LinesCopy())
 
  ForEach LinesCopy()
    ForEach Lines()
      If ListIndex(Lines()) <> ListIndex(LinesCopy())
          i = LineIntersection(Lines(), LinesCopy(), @P)
          If i
            AddElement(Intersections())
            Intersections()\p = P
            Intersections()\Color = RGB(255, 127*(i-1), 127*(i-1))
            If i = 1
              Intersections()\Size = 3
            Else
              Intersections()\Size = 2
            EndIf
          EndIf
      EndIf
    Next
  Next
EndProcedure

OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)


Repeat
  Select WaitWindowEvent()
    Case #WM_LBUTTONDOWN
      drag = 1
      mouse.SPoint\x = WindowMouseX(0)
      mouse.SPoint\y = WindowMouseY(0)
      *dragpoint.SPoint = FindClosestLineEnd(mouse)
    Case #WM_LBUTTONUP
      drag = 0
    Case #WM_MOUSEMOVE
      If drag
        *dragpoint\x = WindowMouseX(0)
        *dragpoint\y = WindowMouseY(0)
        UpdateIntersections()
        Repaint()
      EndIf
    Case #PB_Event_Repaint
        Repaint()
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Wed Sep 01, 2010 8:20 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Dec 21, 2008 5:02 pm
Posts: 609
Location: Aarhus, Denmark
Very nice work, Trond! :D
Thanks a lot for sharing this!


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Wed Sep 01, 2010 9:38 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 24, 2008 12:21 am
Posts: 283
this is a nice application of the determinant, I like it :D

_________________
pb 5.11


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Thu Sep 02, 2010 11:34 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3599
@Trond
V.Good shoot
How about intersect bet. Line and Circle
So we can get the Tangent

_________________
Egypt my love


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Thu Sep 02, 2010 11:55 am 
Offline
Enthusiast
Enthusiast

Joined: Sun Jan 11, 2004 11:34 am
Posts: 274
Location: France
Very nice, bravo :D


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Thu Sep 02, 2010 12:50 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Apr 25, 2005 9:28 pm
Posts: 703
Location: $300:20 58 FC 60 - Rennes
Like it, thanks :D

_________________
“Fear is a reaction. Courage is a decision.” - WC


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Fri Sep 03, 2010 3:13 pm 
Offline
PureBasic Expert
PureBasic Expert
User avatar

Joined: Sat May 17, 2003 11:31 am
Posts: 6073
Wow, this is nice!

_________________
( PB5.xx Win10 x64 Asrock AB350 Pro4 Ryzen 1600X 32GB RAM Evo 840 GTX1060 )
( The path to enlightenment and the PureBasic Survival Guide right here... )


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Fri Sep 03, 2010 3:31 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4678
Location: Lyon - France
Waaaoouuhh !!!
Image
SPLENDID

It's a little bit like the vectorial picture editor :shock:
I always ask to me, how this style of software are making ???

This is a begin of answer..congratulation 8)
Especially thanks for sharing 8) 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Fri Sep 03, 2010 4:38 pm 
Offline
User
User
User avatar

Joined: Mon Apr 30, 2007 7:02 am
Posts: 54
Wow! Lovely! I love these small "linemadness" "demos" ;)

That piece of code shall be saved in my archives to avoid me growing couple of white hairs reinventing the wheel once I come to need line intersection in any application!


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Fri Sep 03, 2010 6:00 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jan 10, 2008 1:30 pm
Posts: 1271
Location: Germany, Glienicke
Code:
  det.d = A1*B2 - A2*B1
  If det = 0
    ProcedureReturn 0 ; No intersection

This is not quite right!

If two lines are parallel to each other, they may have one or infinitely many intersections:
Line1: 0,0 -> 1,0
Line2: 1,0 -> 2,0
one intersection!
Line1: 0,0 -> 2,0
Line2: 1,0 -> 3,0
infinitely intersections!

These two cases, and mainly the first step, though almost never on, nevertheless, one should not ignore it!

In my line include file I check whether the starting point is a line parallel to the other line and if so are the lengths compared to so decide whether zero, one or infinitely many intersections.

The tip of a small improvement.

_________________
ImageImage


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Sun Dec 21, 2014 11:47 am 
Offline
Addict
Addict

Joined: Mon Nov 25, 2013 6:41 am
Posts: 811
for linux
Code:
Structure SPoint
  x.i
  y.i
EndStructure

Structure SLine
  p.SPoint[2]
  color.i
EndStructure

Structure SIntersection
  p.SPoint
  Color.i
  Size.i
EndStructure

#W = 512
#H = 384

Global NewList Lines.SLine()
Global NewList Intersections.SIntersection()

AddElement(Lines())
Lines()\p[0]\x = 10
Lines()\p[0]\y = 10
Lines()\p[1]\x = 100
Lines()\p[1]\y = 100
Lines()\color = $010DFF

AddElement(Lines())
Lines()\p[0]\x = 100
Lines()\p[0]\y = 10
Lines()\p[1]\x = 200
Lines()\p[1]\y = 100
Lines()\color = $FF0D0C

AddElement(Lines())
Lines()\p[0]\x = 300
Lines()\p[0]\y = 10
Lines()\p[1]\x = 120
Lines()\p[1]\y = 100
Lines()\color = $55FD0C

For I = 0 To 3
  AddElement(Lines())
  Lines()\p[0]\x = Random(512)
  Lines()\p[0]\y = Random(384)
  Lines()\p[1]\x = Random(512)
  Lines()\p[1]\y = Random(384)
  Lines()\color = RGB(Random(255), Random(255), Random(255))
Next

Procedure Max(A, B)
  If A > B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure Min(A, B)
  If A < B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure PointDistance(*a.SPoint, *b.SPoint)
  xd = Abs(*a\x-*b\x)
  yd = Abs(*a\y-*b\y)
  ProcedureReturn Sqr(xd*xd + yd*yd)
EndProcedure

Procedure Repaint()
  CreateImage(0, WindowWidth(0), WindowHeight(0))
  StartDrawing(ImageOutput(0))
    Box(0, 0, WindowWidth(0), WindowHeight(0), $FEFDFE)
    ForEach Lines()
      LineXY(Lines()\p[0]\x, Lines()\p[0]\y, Lines()\p[1]\x, Lines()\p[1]\y, Lines()\color)
    Next
    ForEach Intersections()
      Circle(Intersections()\p\x, Intersections()\p\y, Intersections()\Size, Intersections()\Color)
    Next
  StopDrawing()
  StartDrawing(WindowOutput(0))
    DrawImage(ImageID(0), 0, 0)
  StopDrawing()
EndProcedure

Procedure FindClosestLineEnd(*p.SPoint)
  M.d = 1000000
  For I = 0 To 1
    ForEach Lines()
      D = PointDistance(@Lines()\p[I], *p)
      If D < M
        M = D
        *r = @Lines()\p[I]
      EndIf
    Next
  Next
  ProcedureReturn *R
EndProcedure

Procedure LineIntersection(*L1.SLine, *L2.SLine, *Cross.SPoint)
  A1 = *L1\p[1]\y - *L1\p[0]\y
  B1 = *L1\p[0]\x - *L1\p[1]\x
  C1 = A1 * *L1\p[0]\x + B1 * *L1\p[0]\y
 
  A2 = *L2\p[1]\y - *L2\p[0]\y
  B2 = *L2\p[0]\x - *L2\p[1]\x
  C2 = A2 * *L2\p[0]\x + B2 * *L2\p[0]\y
 
  det.d = A1*B2 - A2*B1
  If det = 0
    ProcedureReturn 0 ; No intersection
  Else
    *cross\x = (B2*C1 - B1*C2)/det
    *Cross\y = (A1*C2 - A2*C1)/det
   
    With *L1 ; On *L1 line segment?
      If Min(\p[0]\x, \p[1]\x) <= *cross\x And Max(\p[0]\x, \p[1]\x) >= *cross\x
        If Min(\p[0]\y, \p[1]\y) <= *cross\y And Max(\p[0]\y, \p[1]\y) >= *cross\y
    EndWith
    With *L2 ; On *L2 line segment?
          If Min(\p[0]\x, \p[1]\x) <= *cross\x And Max(\p[0]\x, \p[1]\x) >= *cross\x
            If Min(\p[0]\y, \p[1]\y) <= *cross\y And Max(\p[0]\y, \p[1]\y) >= *cross\y
    EndWith
              ProcedureReturn 1
            EndIf
         EndIf
      EndIf
    EndIf
   
    ProcedureReturn 2 ; Lines intersect, but line segments do not
  EndIf
EndProcedure

Procedure UpdateIntersections()
  ClearList(Intersections())
  Protected P.SPoint
  Protected NewList LinesCopy.SLine()
 
  CopyList(Lines(), LinesCopy())
 
  ForEach LinesCopy()
    ForEach Lines()
      If ListIndex(Lines()) <> ListIndex(LinesCopy())
          i = LineIntersection(Lines(), LinesCopy(), @P)
          If i
            AddElement(Intersections())
            Intersections()\p = P
            Intersections()\Color = RGB(255, 127*(i-1), 127*(i-1))
            If i = 1
              Intersections()\Size = 3
            Else
              Intersections()\Size = 2
            EndIf
          EndIf
      EndIf
    Next
  Next
EndProcedure

OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)

    CompilerIf Not Defined(PB_Event_LeftButtonDown, #PB_Constant)
      Enumeration #PB_Event_FirstCustomValue
        #PB_Event_LeftButtonDown
        #PB_Event_LeftButtonUp
        #PB_Event_RightButtonDown
        #PB_Event_RightButtonUp
        #PB_Event_MidleButtonDown
        #PB_Event_MidleButtonUp
       
        #PB_Event_MouseEnter
        #PB_Event_MouseLeave
        #PB_Event_MouseMove
       
      EndEnumeration
    CompilerEndIf
   
    Procedure MouseButtonState(Window,EnterGadget=-1)
      Static State, Gadget =-1
      Protected Click
      If IsWindow(Window)
        CompilerIf #PB_Compiler_OS = #PB_OS_Windows
          If      (GetAsyncKeyState_(#VK_LBUTTON) >> 15 & 1) :Click = #PB_Event_LeftButtonDown
          ElseIf  (GetAsyncKeyState_(#VK_RBUTTON) >> 15 & 1) :Click = #PB_Event_RightButtonDown
          ElseIf  (GetAsyncKeyState_(#VK_MBUTTON) >> 15 & 1) :Click = #PB_Event_MidleButtonDown
          EndIf 
        CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux
          Protected.l x,y,mask,*Window.GTKWindow = WindowID(Window)
          gdk_window_get_pointer_(*Window\bin\child\window, @x, @y, @mask)
          If     (mask & #GDK_BUTTON1_MASK) :Click = #PB_Event_LeftButtonDown
          ElseIf (mask & #GDK_BUTTON3_MASK) :Click = #PB_Event_RightButtonDown
          ElseIf (mask & #GDK_BUTTON2_MASK) :Click = #PB_Event_MidleButtonDown
          EndIf
        CompilerEndIf
        If Click
          If Click = #PB_Event_LeftButtonDown
            If State <> Click :State = Click :Gadget = EnterGadget
              PostEvent(#PB_Event_LeftButtonDown, Window,Gadget)
            EndIf
          EndIf
          If Click = #PB_Event_RightButtonDown
            If State <> Click :State = Click :Gadget = EnterGadget
              PostEvent(#PB_Event_RightButtonDown, Window,Gadget)
            EndIf
          EndIf
          If Click = #PB_Event_MidleButtonDown
            If State <> Click :State = Click :Gadget = EnterGadget
              PostEvent(#PB_Event_MidleButtonDown, Window,Gadget)
            EndIf
          EndIf
        Else
          If State = #PB_Event_LeftButtonDown  :State = #PB_Event_LeftButtonUp
            PostEvent(#PB_Event_LeftButtonUp, Window,Gadget)
          EndIf
          If State = #PB_Event_RightButtonDown :State = #PB_Event_RightButtonUp
            PostEvent(#PB_Event_RightButtonUp, Window,Gadget)
          EndIf
          If State = #PB_Event_MidleButtonDown :State = #PB_Event_MidleButtonUp
            PostEvent(#PB_Event_MidleButtonUp, Window,Gadget)
          EndIf
        EndIf
      EndIf
      ProcedureReturn Click
    EndProcedure
    Procedure MouseMoveState(Window =-1,EnterGadget=-1) ;Returns TRUE if cursor move
      Static MouseMoveX, MouseMoveY
      Protected MouseX,MouseY
      If IsWindow(Window)
        MouseX = WindowMouseX(Window)
        MouseY = WindowMouseY(Window)
      Else
        MouseX = DesktopMouseX()
        MouseY = DesktopMouseY()
      EndIf 
      If ((MouseX <>-1 And MouseY <>-1) And
          ((MouseMoveX <> MouseX) Or (MouseMoveY <> MouseY)))
        MouseMoveX = MouseX
        MouseMoveY = MouseY
        PostEvent(#PB_Event_MouseMove, Window,EnterGadget)
        ProcedureReturn #True
      EndIf
    EndProcedure
   
 Repeat
     
  MouseButtonState(0)
  MouseMoveState(0)
 
   Select WaitWindowEvent()
    Case #PB_Event_LeftButtonDown
      drag = 1
      mouse.SPoint\x = WindowMouseX(0)
      mouse.SPoint\y = WindowMouseY(0)
      *dragpoint.SPoint = FindClosestLineEnd(mouse)
    Case #PB_Event_LeftButtonUp
      drag = 0
    Case #PB_Event_MouseMove
      If drag
        *dragpoint\x = WindowMouseX(0)
        *dragpoint\y = WindowMouseY(0)
        UpdateIntersections()
        Repaint()
      EndIf
    Case #PB_Event_Repaint
        Repaint()
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Mon Dec 22, 2014 10:15 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue Apr 01, 2008 3:23 pm
Posts: 151
Nice and useful code, Trond! And the demo makes it easy to understand. :D

May I point out a slight optimization?
Code:
Procedure PointDistance(*a.SPoint, *b.SPoint)
  xd = Abs(*a\x-*b\x)
  yd = Abs(*a\y-*b\y)
  ProcedureReturn Sqr(xd*xd + yd*yd)
EndProcedure
Here, the "Abs()" aren't necessary, as you're multiplying each term by itself afterwards... :wink:

@RASHAD:
RASHAD wrote:
How about intersect bet. Line and Circle

Maybe this would do: http://www.purebasic.fr/english/viewtopic.php?f=16&t=44665&hilit=VEC2_collCircleToVector

(Also, for those interested in polygons collision, there's an implementation of the Separating Axis Theorem in the "DETECT_COLLISION" macro here: http://www.purebasic.fr/english/viewtopic.php?f=16&t=44665&hilit=DETECT_COLLISION . More info about SAT :http://www.sevenson.com.au/actionscript/sat/ )


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Mon Dec 22, 2014 4:55 pm 
Offline
Addict
Addict
User avatar

Joined: Fri Apr 12, 2013 1:55 pm
Posts: 1058
Location: just outside of Ferguson
mestnyi wrote:
for linux
Code:
{snip}
That is very well done mestnyi. :)
Thank you for making and sharing it.

_________________
Keep it BASIC.


Top
 Profile  
Reply with quote  
 Post subject: Re: Line intersection
PostPosted: Mon Dec 22, 2014 10:06 pm 
Offline
PureBasic Team
PureBasic Team
User avatar

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1825
Location: Germany (Saxony, Deutscheinsiedel)
I just tried the Linux code on my Mac ( OS 10.5.8 ) - it compile/runs without problems, but I can't see any action when clicking with the mouse....!?

_________________
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 14 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: DoubleDutch and 14 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye