# PureBasic Forum

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

 All times are UTC + 1 hour

 Page 1 of 1 [ 14 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Line intersectionPosted: Wed Sep 01, 2010 8:17 pm
 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()

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

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

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

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

 Post subject: Re: Line intersectionPosted: Wed Sep 01, 2010 8:20 pm
 Enthusiast

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

Top

 Post subject: Re: Line intersectionPosted: Wed Sep 01, 2010 9:38 pm
 Enthusiast

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

_________________
pb 5.11

Top

 Post subject: Re: Line intersectionPosted: Thu Sep 02, 2010 11:34 am
 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

 Post subject: Re: Line intersectionPosted: Thu Sep 02, 2010 11:55 am
 Enthusiast

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

Top

 Post subject: Re: Line intersectionPosted: Thu Sep 02, 2010 12:50 pm
 Enthusiast

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

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

Top

 Post subject: Re: Line intersectionPosted: Fri Sep 03, 2010 3:13 pm
 PureBasic Expert

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

 Post subject: Re: Line intersectionPosted: Fri Sep 03, 2010 3:31 pm

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

SPLENDID

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

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

_________________
Not a destination

Top

 Post subject: Re: Line intersectionPosted: Fri Sep 03, 2010 4:38 pm
 User

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

 Post subject: Re: Line intersectionPosted: Fri Sep 03, 2010 6:00 pm

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.

_________________

Top

 Post subject: Re: Line intersectionPosted: Sun Dec 21, 2014 11:47 am

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()

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

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

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

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

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
EndIf
CompilerEndIf
If Click
If Click = #PB_Event_LeftButtonDown
EndIf
EndIf
If Click = #PB_Event_RightButtonDown
EndIf
EndIf
If Click = #PB_Event_MidleButtonDown
EndIf
EndIf
Else
If State = #PB_Event_LeftButtonDown  :State = #PB_Event_LeftButtonUp
EndIf
If State = #PB_Event_RightButtonDown :State = #PB_Event_RightButtonUp
EndIf
If State = #PB_Event_MidleButtonDown :State = #PB_Event_MidleButtonUp
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
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

 Post subject: Re: Line intersectionPosted: Mon Dec 22, 2014 10:15 am
 Enthusiast

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

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...

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

 Post subject: Re: Line intersectionPosted: Mon Dec 22, 2014 4:55 pm

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

 Post subject: Re: Line intersectionPosted: Mon Dec 22, 2014 10:06 pm
 PureBasic Team

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

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 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 forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite