Line intersection

Share your advanced PureBasic knowledge/code with the community.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Line intersection

Post 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
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

Re: Line intersection

Post by Arctic Fox »

Very nice work, Trond! :D
Thanks a lot for sharing this!
gnasen
Enthusiast
Enthusiast
Posts: 282
Joined: Wed Sep 24, 2008 12:21 am

Re: Line intersection

Post by gnasen »

this is a nice application of the determinant, I like it :D
pb 5.11
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Line intersection

Post by RASHAD »

@Trond
V.Good shoot
How about intersect bet. Line and Circle
So we can get the Tangent
Egypt my love
Nico
Enthusiast
Enthusiast
Posts: 274
Joined: Sun Jan 11, 2004 11:34 am
Location: France

Re: Line intersection

Post by Nico »

Very nice, bravo :D
User avatar
flaith
Enthusiast
Enthusiast
Posts: 704
Joined: Mon Apr 25, 2005 9:28 pm
Location: $300:20 58 FC 60 - Rennes
Contact:

Re: Line intersection

Post by flaith »

Like it, thanks :D
“Fear is a reaction. Courage is a decision.” - WC
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6161
Joined: Sat May 17, 2003 11:31 am
Contact:

Re: Line intersection

Post by blueznl »

Wow, this is nice!
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB)
( The path to enlightenment and the PureBasic Survival Guide right here... )
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Line intersection

Post 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)
ImageThe happiness is a road...
Not a destination
User avatar
Raybarg
User
User
Posts: 54
Joined: Mon Apr 30, 2007 7:02 am

Re: Line intersection

Post 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!
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: Line intersection

Post 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.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
mestnyi
Addict
Addict
Posts: 995
Joined: Mon Nov 25, 2013 6:41 am

Re: Line intersection

Post 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
Last edited by mestnyi on Sat Nov 05, 2022 8:11 pm, edited 1 time in total.
Kelebrindae
Enthusiast
Enthusiast
Posts: 151
Joined: Tue Apr 01, 2008 3:23 pm

Re: Line intersection

Post 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/ )
User avatar
heartbone
Addict
Addict
Posts: 1058
Joined: Fri Apr 12, 2013 1:55 pm
Location: just outside of Ferguson

Re: Line intersection

Post by heartbone »

mestnyi wrote:for linux

Code: Select all

{snip}
That is very well done mestnyi. :)
Thank you for making and sharing it.
Keep it BASIC.
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Line intersection

Post 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....!?
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
mestnyi
Addict
Addict
Posts: 995
Joined: Mon Nov 25, 2013 6:41 am

Re: Line intersection

Post 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
Post Reply