PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Line intersection

https://www.purebasic.fr/english/viewtopic.php?t=43460

Page 1 of 2

Line intersection

Posted: Wed Sep 01, 2010 8:17 pm
by Trond
Click and drag the line ends.

Code: Select all

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

Re: Line intersection

Posted: Wed Sep 01, 2010 8:20 pm
by Arctic Fox
Very nice work, Trond! :D
Thanks a lot for sharing this!

Re: Line intersection

Posted: Wed Sep 01, 2010 9:38 pm
by gnasen
this is a nice application of the determinant, I like it :D

Re: Line intersection

Posted: Thu Sep 02, 2010 11:34 am
by RASHAD
@Trond
V.Good shoot
How about intersect bet. Line and Circle
So we can get the Tangent

Re: Line intersection

Posted: Thu Sep 02, 2010 11:55 am
by Nico
Very nice, bravo :D

Re: Line intersection

Posted: Thu Sep 02, 2010 12:50 pm
by flaith
Like it, thanks :D

Re: Line intersection

Posted: Fri Sep 03, 2010 3:13 pm
by blueznl
Wow, this is nice!

Re: Line intersection

Posted: Fri Sep 03, 2010 3:31 pm
by Kwai chang caine
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)

Re: Line intersection

Posted: Fri Sep 03, 2010 4:38 pm
by Raybarg
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!

Re: Line intersection

Posted: Fri Sep 03, 2010 6:00 pm
by STARGÅTE

Code: Select all

  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.

Re: Line intersection

Posted: Sun Dec 21, 2014 11:47 am
by mestnyi
for all os

Code: Select all

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_MiddleButtonDown
        #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_MiddleButtonDown
          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_MiddleButtonDown
          EndIf
        CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
          Protected mask = CocoaMessage(0, 0, "NSEvent pressedMouseButtons")
          If mask & 1 << 0     : Click = #PB_Event_LeftButtonDown
          ElseIf mask & 1 << 1 : Click = #PB_Event_RightButtonDown
          ElseIf mask & 1 << 2 : Click = #PB_Event_MiddleButtonDown
          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_MiddleButtonDown
            If State <> Click :State = Click :Gadget = EnterGadget
              PostEvent(#PB_Event_MiddleButtonDown, 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_MiddleButtonDown :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

Re: Line intersection

Posted: Mon Dec 22, 2014 10:15 am
by Kelebrindae
Nice and useful code, Trond! And the demo makes it easy to understand. :D

May I point out a slight optimization?

Code: Select all

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/viewtop ... leToVector

(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/viewtop ... _COLLISION . More info about SAT :http://www.sevenson.com.au/actionscript/sat/ )

Re: Line intersection

Posted: Mon Dec 22, 2014 4:55 pm
by heartbone
mestnyi wrote:for linux

Code: Select all

{snip}
That is very well done mestnyi. :)
Thank you for making and sharing it.

Re: Line intersection

Posted: Mon Dec 22, 2014 10:06 pm
by Andre
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....!?

Re: Line intersection

Posted: Sat Nov 05, 2022 8:13 pm
by mestnyi
since we now have a canvas. :)

Code: Select all

; https://www.purebasic.fr/english/viewtopic.php?t=43460
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(gadget)
  CreateImage(0, GadgetWidth(gadget), GadgetHeight(gadget))
  
  StartDrawing(ImageOutput(0))
  Box(0, 0, GadgetWidth(gadget), GadgetHeight(gadget), #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(CanvasOutput(gadget))
  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)
CanvasGadget(0, 0,0,#W, #H)

Repeat
  
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventType()
        Case #PB_EventType_LeftButtonDown
          drag = 1
          mouse.SPoint\x = GetGadgetAttribute(EventGadget(), #PB_Canvas_MouseX )
          mouse.SPoint\y = GetGadgetAttribute(EventGadget(), #PB_Canvas_MouseY )
          *dragpoint.SPoint = FindClosestLineEnd(mouse)
          
        Case #PB_EventType_LeftButtonUp
          drag = 0
          
        Case #PB_EventType_MouseMove
          If drag
            *dragpoint\x = GetGadgetAttribute(EventGadget(), #PB_Canvas_MouseX )
            *dragpoint\y = GetGadgetAttribute(EventGadget(), #PB_Canvas_MouseY )
            UpdateIntersections()
            Repaint(EventGadget())
          EndIf
      EndSelect
      
    Case #PB_Event_Repaint
      Repaint(0)
      
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited