Line Segment Circle Intersection

BasicCoder2
Posts: 3585
Joined: Jan 01, 2009 7:03
Location: Australia

Line Segment Circle Intersection

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-intersectionscreenres 640,480,32function 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 functiondim shared as double x1,y1,x2,y2,cx,cy,crx1 = 150y1 = 200x2 = 400y2 = 60cx = 320cy = 240cr = 50sub 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)    screenunlockend subupdate()dim as integer mx,mydo    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: 1135
Joined: May 27, 2005 7:15
Location: FRANCE

Re: Line Segment Circle Intersection

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: 3585
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Line Segment Circle Intersection

@SARG,

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

Re: Line Segment Circle Intersection

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-intersectionscreenres 640,480,32function 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 functiondim shared as double x1,y1,x2,y2,cx,cy,crx1 = 150y1 = 200x2 = 400y2 = 60cx = 320cy = 240cr = 50sub 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)    screenunlockend subdim as string keydim as integer ascKeyupdate()dim as integer mx,mydo    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: 3585
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Line Segment Circle Intersection

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

Re: Line Segment Circle Intersection

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,crx1 = 150y1 = 200x2 = 400y2 = 60cx = 320cy = 240cr = 50dim as integer mx,my,ddim as integer ox,oydo     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,1loop until len(inkey)'drawline(L)sleep           `
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

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,y2end type#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)dim as points p(1 to 10)screen 19,32do    for z as integer=1 to 10    p(z)=type<points>(rnd*799,rnd*599,rnd*799,rnd*599)next zdim as integer max,min var b1=rnd>.5for 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 xnext ysleep 500loop until inkey=chr(27)sleep `
BasicCoder2
Posts: 3585
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Line Segment Circle Intersection

@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: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Line Segment Circle Intersection

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,32Type V2    As Single x,y,dx,dy    As Integer radius    As ulong c 'colourEnd TypeType line3d    As Single v1x,v1y,v2x,v2yEnd 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=LEnd FunctionSub 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 n1End SubSub 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 zEnd Sub'unused hereSub drawline(L As line3d)    Line(L.v1x,L.v1y)-(L.v2x,L.v2y),Rgb(0,0,0)End SubDim As V2 B(1 To 4) 'four ballsb(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).xNext nFor n As Integer=1 To 15    Read Tmp(n).yNext nFor 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 shapelinesegments(14).v1x=linesegments(13).v2xlinesegments(14).v1y=linesegments(13).v2ylinesegments(14).v2x=linesegments(1).v1xlinesegments(14).v2y=linesegments(1).v1y'screen edgeRedim 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 sleeptimeEnd Function'background imageDim As Any Ptr im=imagecreate(800,600)Dim As Integer max,minFor 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 xNext yGet(0,0)-(799,599),imDim As Integer fpsDo    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),1Loop Until Len(Inkey)imagedestroy(im)'the line segmentsX_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: 391
Joined: Feb 01, 2007 16:54
Location: usa

Re: Line Segment Circle Intersection

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

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

Re: Line Segment Circle Intersection

Thanks for testing integer.