Line Segment Circle Intersection

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
BasicCoder2
Posts: 3403
Joined: Jan 01, 2009 7:03

Line Segment Circle Intersection

Postby BasicCoder2 » Jun 19, 2015 6:12

This was an algorithm written by Sameer at,
http://stackoverflow.com/questions/6091 ... tersection
but has since been edited to work correctly.

Use the mouse to move the circle.

This is the latest edit using dodicat's suggestions below.

Code: Select all

'http://stackoverflow.com/questions/6091728/line-segment-circle-intersection
screenres 640,480,32

function circleLineIntersect(x1 as double, y1 as double, x2 as double, y2 as double, cx as double, cy as double, cr as double) as integer
    dim as double dx,dy,a,b,c,bb4ac
    dx = x2 - x1
    dy = y2 - y1
    a = dx * dx + dy * dy
    b = 2 * (dx * (x1 - cx) + dy * (y1 - cy))
    c = cx * cx + cy * cy
    c += x1 * x1 + y1 * y1
    c -= 2 * (cx * x1 + cy * y1)
    c -= cr * cr
    bb4ac = (b * b - 4 * a * c)
    if(bb4ac<0) then
        return 0    ' No collision
    Else
        var L1=((cx-x1)*(cx-x1)+(cy-y1)*(cy-y1))
        var L2=((cx-x2)*(cx-x2)+(cy-y2)*(cy-y2))
        var a1=a+L1
        var a2=a+L2
        var f1=a1>L2,f2=a2>L1
        if f1 xor f2 then 'extra condition
            if L1>cr*cr andalso L2>cr*cr then return 0
        end if
        return 1    ' Collision
    end if
   
end function

dim shared as double x1,y1,x2,y2,cx,cy,cr

x1 = 150
y1 = 200
x2 = 400
y2 = 60
cx = 320
cy = 240
cr = 50

sub update()
    screenlock
    cls
    line (x1,y1)-(x2,y2),rgb(255,255,255)
    circle (cx,cy),cr,rgb(255,255,255)
    print circleLineIntersect(x1,y1,x2,y2,cx,cy,cr)
    screenunlock
end sub

update()
dim as integer mx,my
do
    getmouse mx,my
    cx=mx
    cy=my
    update()
    sleep 2
       
loop until multikey(&H01)

sleep
Last edited by BasicCoder2 on Jun 19, 2015 19:54, edited 4 times in total.
SARG
Posts: 909
Joined: May 27, 2005 7:15
Location: FRANCE

Re: Line Segment Circle Intersection

Postby SARG » Jun 19, 2015 10:40

Hi,

When the circle doesn't touch the line but is in its extensions collisions are detected : not right.
You have to add a test for a correct behaviour (just collision with the segment) :

Code: Select all

    if(bb4ac<0) then
        return 0    ' No collision
    Else
       
       If ( (cx-x1)*(cx-x1)+(cy-y1)*(cy-y1) )>cr*cr AndAlso ( (cx-x2)*(cx-x2)+(cy-y2)*(cy-y2) )> cr*cr Then Return 0 ' too far from segment
        return 1    ' Collision
    end if
BasicCoder2
Posts: 3403
Joined: Jan 01, 2009 7:03

Re: Line Segment Circle Intersection

Postby BasicCoder2 » Jun 19, 2015 11:03

@SARG,

Thank you for the correction I have used it to fix up the code in the first post.
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

Postby dodicat » Jun 19, 2015 16:16

The correction is only part way there.
Another condition needs to be met:
(Just move the mouse to save time)

Code: Select all

'http://stackoverflow.com/questions/6091728/line-segment-circle-intersection
screenres 640,480,32

function circleLineIntersect(x1 as double, y1 as double, x2 as double, y2 as double, cx as double, cy as double, cr as double) as integer
    dim as double dx,dy,a,b,c,bb4ac
    dx = x2 - x1
    dy = y2 - y1
    a = dx * dx + dy * dy
    b = 2 * (dx * (x1 - cx) + dy * (y1 - cy))
    c = cx * cx + cy * cy
    c += x1 * x1 + y1 * y1
    c -= 2 * (cx * x1 + cy * y1)
    c -= cr * cr
    bb4ac = (b * b - 4 * a * c)
    if(bb4ac<0) then
        return 0    ' No collision
    Else
        var L1=((cx-x1)*(cx-x1)+(cy-y1)*(cy-y1)),L2=((cx-x2)*(cx-x2)+(cy-y2)*(cy-y2))
        var a1=a+L1
        var a2=a+L2
        var f1=a1>L2,f2=a2>L1
        if f1 xor f2 then 'extra condition
       if L1>cr*cr andalso L2>cr*cr then return 0
       '' If ( (cx-x1)*(cx-x1)+(cy-y1)*(cy-y1) )>cr*cr AndAlso ( (cx-x2)*(cx-x2)+(cy-y2)*(cy-y2) )> cr*cr Then Return 0 ' too far from segment
        end if
        return 1    ' Collision
    end if
   
end function

dim shared as double x1,y1,x2,y2,cx,cy,cr

x1 = 150
y1 = 200
x2 = 400
y2 = 60
cx = 320
cy = 240
cr = 50

sub update()
    screenlock
    cls
    line (x1,y1)-(x2,y2),rgb(255,255,255)
    circle (cx,cy),cr,rgb(255,255,255)
    print circleLineIntersect(x1,y1,x2,y2,cx,cy,cr)
    screenunlock
end sub


dim as string key
dim as integer ascKey
update()
dim as integer mx,my
do
    getmouse mx,my
    cx=mx
    cy=my
       ' key = inkey
        'if key<>"" and len(key)>1 then
           ' ascKey = asc(right(key,1))
           ' IF ascKey=75 AND cx > 0   THEN cx = cx - 1
           ' IF ascKey=77 AND cx < 640 THEN cx = cx + 1
            'IF ascKey=72 AND cy > 0   THEN cy = cy - 1
            'IF ascKey=80 AND cy < 480 THEN cy = cy + 1
            update()
       ' end if

        sleep 2
       
loop until multikey(&H01)


sleep

 
BasicCoder2
Posts: 3403
Joined: Jan 01, 2009 7:03

Re: Line Segment Circle Intersection

Postby BasicCoder2 » Jun 19, 2015 19:51

@dodicat,
Thanks. I have changed the code accordingly in the first post.
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

Postby dodicat » Jun 19, 2015 20:08

Did a fresh segment distance.
The Hit is registered as before, but the function now returns the closest distance from the mouse to the segment and the perpendicular intercept.

Code: Select all


function segdist(lx1 as integer, _
                 ly1 as integer, _
                 lx2 as integer, _
                 ly2 as integer, _
                 px as integer,_
                 py as integer, _
                 byref ox as integer,_
                 byref oy as integer) as integer
                 
             Dim As single M1,M2,C1,C2,B
             B=(Lx2-Lx1):if B=0 then B=1e-20
             M2=(Ly2-Ly1)/B:if M2=0 then M2=1e-20
             M1=-1/M2
             C1=py-M1*px
             C2=(Ly1*Lx2-Lx1*Ly2)/B
    var L1=((px-lx1)*(px-lx1)+(py-ly1)*(py-ly1)),L2=((px-lx2)*(px-lx2)+(py-ly2)*(py-ly2))
    var a=((lx1-lx2)*(lx1-lx2) + (ly1-ly2)*(ly1-ly2))
        var a1=a+L1
        var a2=a+L2
        var f1=a1>L2,f2=a2>L1
         if f1 xor f2 then
    var d1=((px-Lx1)*(px-Lx1)+(py-Ly1)*(py-Ly1))
    var d2=((px-Lx2)*(px-Lx2)+(py-Ly2)*(py-Ly2))
    if d1<d2 then Ox=Lx1:Oy=Ly1 : return sqr(d1) else  Ox=Lx2:Oy=Ly2:return sqr(d2)
    end if
    Ox=(C2-C1)/(M1-M2)
    Oy=(M1*C2-M2*C1)/(M1-M2)
    Return sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
      end function
     
      screen 19
     
      dim  as double x1,y1,x2,y2,cx,cy,cr

x1 = 150
y1 = 200
x2 = 400
y2 = 60
cx = 320
cy = 240
cr = 50
dim as integer mx,my,d
dim as integer ox,oy

do
     getmouse mx,my
      d= segDist(x1,y1,x2,y2,mx,my,ox,oy)
    screenlock
    cls
   locate 2,2
   print "Segment distance "; d
    line(x1,y1)-(x2,y2)
   
    circle(ox,oy),3,,,,,f
    circle(mx,my),cr
    line(mx,my)-(ox,oy)
    print "Hit ";
    if d<cr then print 1 else print 0
    screenunlock
    sleep 1,1
loop until len(inkey)

'drawline(L)
sleep
           
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

Postby dodicat » Jun 19, 2015 23:49

Bullets?

Code: Select all


function segdist(lx1 as integer, _
                 ly1 as integer, _
                 lx2 as integer, _
                 ly2 as integer, _
                 px as integer,_
                 py as integer, _
                 byref ox as integer=0,_
                 byref oy as integer=0) as integer
                 
             Dim As single M1,M2,C1,C2,B
             B=(Lx2-Lx1):if B=0 then B=1e-20
             M2=(Ly2-Ly1)/B:if M2=0 then M2=1e-20
             M1=-1/M2
             C1=py-M1*px
             C2=(Ly1*Lx2-Lx1*Ly2)/B
    var L1=((px-lx1)*(px-lx1)+(py-ly1)*(py-ly1)),L2=((px-lx2)*(px-lx2)+(py-ly2)*(py-ly2))
    var a=((lx1-lx2)*(lx1-lx2) + (ly1-ly2)*(ly1-ly2))
        var a1=a+L1
        var a2=a+L2
        var f1=a1>L2,f2=a2>L1
         if f1 xor f2 then
    var d1=((px-Lx1)*(px-Lx1)+(py-Ly1)*(py-Ly1))
    var d2=((px-Lx2)*(px-Lx2)+(py-Ly2)*(py-Ly2))
    if d1<d2 then Ox=Lx1:Oy=Ly1 : return sqr(d1) else  Ox=Lx2:Oy=Ly2:return sqr(d2)
    end if
    Ox=(C2-C1)/(M1-M2)
    Oy=(M1*C2-M2*C1)/(M1-M2)
    Return sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
  end function
 
type points
    as integer x1,y1,x2,y2
end type

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)


dim as points p(1 to 10)
screen 19,32

do
   
for z as integer=1 to 10
    p(z)=type<points>(rnd*799,rnd*599,rnd*799,rnd*599)
next z

dim as integer max,min
 var b1=rnd>.5
for y as integer=0 to 599
    for x as integer=0 to 799
         min=1000:max=-1000
        for n as integer=1 to 10
           var d=segdist(p(n).x1,p(n).y1,p(n).x2,p(n).y2,x,y)
            if max<d then max=d
            if min>d then min=d
        next n
        max=max/2
        var r=map(0,max,min,0,255),g=map(0,max,r,255,0),b=map(0,max,g,0,255)
        if b1 then swap r,b
        pset (x,y),rgb(abs(r),abs(g),abs(b))
    next x
next y
sleep 500
loop until inkey=chr(27)
sleep
 
BasicCoder2
Posts: 3403
Joined: Jan 01, 2009 7:03

Re: Line Segment Circle Intersection

Postby BasicCoder2 » Jun 20, 2015 22:56

@dodicat,
I would classify that as one of your computer generated art programs.
I thought it was going to be balls bouncing off the line.
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

Postby dodicat » Jun 21, 2015 1:08

I've got rid of the operators, included the velocities in V2 (dx,dy), used the 2d segment distance (as posted above), in fact the whole thing is now 2D only, which suffices I think.
Same shape as in the other thread.
Included ball/ball rebounds.

Code: Select all

 
Screen 19,32
Type V2
    As Single x,y,dx,dy
    As Integer radius
    As ulong c 'colour
End Type

Type line3d
    As Single v1x,v1y,v2x,v2y
End Type

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)

Function segment_distance(lx1 As Single, _
                         ly1 As Single, _
                         lx2 As Single, _
                         ly2 As Single, _
                         px As Single,_
                         py As Single, _
                      Byref ox As Single=0,_
                      Byref oy As Single=0) As Single
                 
             Dim As Single M1,M2,C1,C2,B
             B=(Lx2-Lx1):If B=0 Then B=1e-20
             M2=(Ly2-Ly1)/B:If M2=0 Then M2=1e-20
             M1=-1/M2
             C1=py-M1*px
             C2=(Ly1*Lx2-Lx1*Ly2)/B
    var L1=((px-lx1)*(px-lx1)+(py-ly1)*(py-ly1)),L2=((px-lx2)*(px-lx2)+(py-ly2)*(py-ly2))
    var a=((lx1-lx2)*(lx1-lx2) + (ly1-ly2)*(ly1-ly2))
        var a1=a+L1
        var a2=a+L2
        var f1=a1>L2,f2=a2>L1
         If f1 Xor f2 Then
    var d1=((px-Lx1)*(px-Lx1)+(py-Ly1)*(py-Ly1))
    var d2=((px-Lx2)*(px-Lx2)+(py-Ly2)*(py-Ly2))
    If d1<d2 Then Ox=Lx1:Oy=Ly1 : Return Sqr(d1) Else  Ox=Lx2:Oy=Ly2:Return Sqr(d2)
    End If
    Ox=(C2-C1)/(M1-M2)
    Oy=(M1*C2-M2*C1)/(M1-M2)
    Return Sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
  End Function

'optimize detection to save cpu.
Function DetectBallCollisions(Byref _that As V2,_this As V2) As Single
    Dim As Single xdiff = _this.x-_that.x
    Dim As Single ydiff = _this.y-_that.y
    If Abs(xdiff) > _this.radius*2 Then Return 0
    If Abs(ydiff) > _this.radius*2 Then Return 0
    var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=_this.radius*2 Then Function=L
End Function

Sub Check_BallCollisions(points() As V2)
    For n1 As Integer =Lbound(points) To Ubound(points)-1
        For n2 As Integer =n1+1 To Ubound(points)
            var L=DetectBallCollisions(points(n1),points(n2))
            If L Then
                Var impulsex=(points(n1).x-points(n2).x)/L
                Var impulsey=(points(n1).y-points(n2).y)/L
                'In case of overlap circles, reset to non overlap positions
                points(n1).x=points(n2).x+(points(n1).radius*2)*impulsex
                points(n1).y=points(n2).y+(points(n1).radius*2)*impulsey
                Var impactx=points(n1).dx-points(n2).dx
                Var impacty=points(n1).dy-points(n2).dy
                Var dot=impactx*impulsex+impacty*impulsey
                points(n1).dx-=dot*impulsex
                points(n1).dy-=dot*impulsey
                points(n2).dx+=dot*impulsex
                points(n2).dy+=dot*impulsey
            End If
        Next n2
    Next n1
End Sub

Sub check_ball_to_line_collisions(LN() As Line3d, ball() As V2)
    For z As Integer=Lbound(ball) To Ubound(ball)
        For z2 As Integer=Lbound(Ln) To Ubound(Ln)
            Dim As V2 closepoint
            Var seperation=segment_distance(Ln(z2).v1x,Ln(z2).v1y,Ln(z2).v2x,Ln(z2).v2y,ball(z).x,ball(z).y,closepoint.x,closepoint.y)
            If seperation<=ball(z).radius Then
                Var impactx=-ball(z).dx
                Var impacty=-ball(z).dy
                Var impulsex=(closepoint.x-ball(z).x)/seperation
                Var impulsey=(closepoint.y-ball(z).y)/seperation
                ball(z).x=closepoint.x-ball(z).radius*impulsex
                ball(z).y=closepoint.y-ball(z).radius*impulsey
                Var dv=impactx*impulsex+impacty*impulsey
                ball(z).dx+= 2*dv*impulsex
                ball(z).dy+= 2*dv*impulsey
            End If
        Next z2
    Next z
End Sub
'unused here
Sub drawline(L As line3d)
    Line(L.v1x,L.v1y)-(L.v2x,L.v2y),Rgb(0,0,0)
End Sub

Dim As V2 B(1 To 4) 'four balls
b(1)=Type<V2>(100,200,3,-3,20,Rgb(200,0,0))
b(2)=Type<V2>(100,250,-3,3,20,Rgb(0,100,200))
b(3)=Type<V2>(200,250,-3,-3,20,Rgb(0,100,0))
b(4)=Type<V2>(400,300,1,-1,5,Rgb(0,0,0))
Dim As V2 Tmp(1 To 15)
Redim As line3d linesegments(1 To 14)

For n As Integer=1 To 15
    Read Tmp(n).x
Next n

For n As Integer=1 To 15
    Read Tmp(n).y
Next n

For n As Integer=1 To 13
    linesegments(n)=Type<line3d>(Tmp(n).x,Tmp(n).y,Tmp(n+1).x,Tmp(n+1).y)
Next n
'joins to enclose the shape
linesegments(14).v1x=linesegments(13).v2x
linesegments(14).v1y=linesegments(13).v2y
linesegments(14).v2x=linesegments(1).v1x
linesegments(14).v2y=linesegments(1).v1y

'screen edge
Redim Preserve linesegments(Lbound(linesegments) To Ubound(linesegments)+4)
linesegments(15)=Type<line3d>(0,0,799-20,20)
linesegments(16)=Type<line3d>(799-20,20,799,599-20)
linesegments(17)=Type<line3d>(799,599,20,599-20)
linesegments(18)=Type<line3d>(20,599-20,0,0)

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
'background image
Dim As Any Ptr im=imagecreate(800,600)
Dim As Integer max,min
For y As Integer=0 To 599
    For x As Integer=0 To 799
         min=10000:max=0
        For n As Integer=1 To 18
           var d=segment_distance(Linesegments(n).v1x,Linesegments(n).v1y,Linesegments(n).v2x,Linesegments(n).v2y,x,y)
            If max<d Then max=d
            If min>d Then min=d
        Next n
        max=max/3
        var r=map(0,max,min,0,255),g=map(0,max,r,255,0),b=map(0,max,g,00,255)
        If r=0 Then g=100:b=0:r=255
        Pset (x,y),Rgb(r,g,b)
    Next x
Next y
Get(0,0)-(799,599),im

Dim As Integer fps

Do
    check_ball_to_line_collisions(Linesegments(),b())
    Check_BallCollisions(b())
    'move balls
    For z As Integer=1 To 4
    b(z).x+=b(z).dx
    b(z).y+=b(z).dy
    Next z
    Screenlock
    Cls
    Put(0,0),im,Pset
    Draw String(20,20),"FPS = " &fps
    'draw balls
    For z As Integer=1 To 4
      Circle(b(z).x,b(z).y),b(z).radius,b(z).c,,,,f 
      Next z
    Screenunlock
    Sleep regulate(70,fps),1
Loop Until Len(Inkey)
imagedestroy(im)
'the line segments
X_values:

Data _
247, 409, 420, 458, 654, 569, 599, 468, 470, 408, 323, 352, 210, 398, 247

Y_values:

Data _
132, 189, 78, 215, 78, 263, 417, 295, 443, 314, 451, 297, 342, 234, 132

 
integer
Posts: 380
Joined: Feb 01, 2007 16:54
Location: usa

Re: Line Segment Circle Intersection

Postby integer » Jun 21, 2015 12:24

dodicat wrote:...
Included ball/ball rebounds.

That is well done!
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

Postby dodicat » Jun 22, 2015 23:22

Thanks for testing integer.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: Google [Bot] and 1 guest