I realize I'm necroposting, but in my searching for anything line to circle tangent intersection I found this example by dodicat. Unfortunately the demonstration was a mathematical approximation for projecting shadows from circles. It looks good except when the distance between the circle and the mouse point are close.dodicat wrote:Include circles
I reworked the function for accuracy at the cost of speed. It now uses atan2, cos, and sin. I'm not even sure if this is the correct solution since I was looking for it myself. I don't mean to cause any disturbance in the forums by posting this. I mean to post for posterity and to encourage alternate solutions.
Code: Select all
Screen 20,32
Dim As Integer xres,yres
Screeninfo xres,yres
Type pt
As Integer x,y
Ca As Single 'angle to mouse(radians)
#define v Type<pt>
End Type
#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
#define dist(a,b) sqr((a.x-b.x)*(a.x-b.x) + (a.y-b.y)*(a.y-b.y))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Type box
As pt p(0 To 4)
col As Ulong
inc As Integer
Declare Constructor
Declare Constructor(As pt,As pt,As Ulong)
End Type
Type Circle
As pt ctr
As Integer r
As Ulong col
As Integer inc
End Type
Constructor box:End Constructor
Constructor box(p1 As pt,p3 As pt,c As Ulong)
col=c
p(1)=p1:p(3)=p3
p(2).x=p(3).x:p(2).y=p(1).y
p(4).x=p(1).x:p(4).y=p(1).y+p(3).y-p(2).y
'p(0) is the box centroid
p(0).x=(p(1).x+p(2).x)\2
p(0).y=(p(2).y+p(3).y)\2
End Constructor
Function shortline(fp As pt,p As pt,length As Integer) As pt
Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
Return v(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function
Function compare (a1 As Single,a2 As Single)As Long
Dim As Single pi=4*Atn(1)
If Abs(a1)>pi/2 Or Abs(a2)>pi/2 Then
If Sgn(a1)<>Sgn(a2) Then Return a2<a1
End If
Return a1<a2
End Function
Sub Circle_sort(p() As pt,c As pt)
For p1 As Long = 1 To 3
For p2 As Long = p1 + 1 To 4
Var w= compare(p(p1).Ca,p(p2).Ca)
If w Then Swap p(p1),p(p2)
Next p2
Next p1
End Sub
Sub barebox(bx1 As box,msg As Integer=0)
If msg=0 Then
Line (bx1.p(1).x,bx1.p(1).y)-(bx1.p(3).x,bx1.p(3).y),Rgb(0,0,Bx1.inc),b
Else
Line (bx1.p(1).x,bx1.p(1).y)-(bx1.p(3).x,bx1.p(3).y),bx1.col,bf
End If
End Sub
Sub barecircle(C As Circle,msg As Integer=0)
If msg=0 Then
Circle(C.ctr.x,C.ctr.y),C.r,Rgb(0,C.inc,0)
Else
Circle(C.ctr.x,C.ctr.y),C.r,C.col,,,,f
End If
End Sub
Sub GetBoxShadow(Byval b1 As box,c As pt)
Dim As box b=b1
Dim As Integer i=b.inc
Dim As Single pi=4*Atn(1),z
For n As Long=1 To 4
z= (Atan2((c.y-b.p(n).y),(c.x-b.p(n).x)))
b.p(n).ca=z
Next n
circle_sort(b.p(),c)
Var S1=shortline(b.p(1),c,-1100)
Line(s1.x,s1.y)-(b.p(1).x,b.p(1).y),Rgb(0,0,i)
Var S2=shortline(b.p(4),c,-1100)
Line(s2.x,s2.y)-(b.p(4).x,b.p(4).y),Rgb(0,0,i)
Dim As pt ctr= v((s1.x+s2.x)\2,(s1.y+s2.y)\2)
Var lngth=dist(b.p(0),b.p(1))
Var s3=shortline(b.p(0),ctr,lngth*1.2)
barebox(b1)
Paint(s3.x,s3.y),Rgb(0,0,0),Rgb(0,0,i)
End Sub
Sub GetCircleShadow(C As Circle,p As pt)
Var dx=(C.ctr.x-p.x),dy=(C.ctr.y-p.y)
Swap dx,dy
dx=-dx
dx=C.ctr.x+dx:dy=C.ctr.y+dy
Var s1=shortline(C.ctr,v(dx,dy),C.r)
Var s2=shortline(s1,p,-1100)
Var t1=s2
Line(s1.x,s1.y)-(s2.x,s2.y),Rgb(0,C.inc,0)
s1=shortline(C.ctr,v(dx,dy),-C.r)
s2=shortline(s1,p,-1100)
Var t2=s2
Line(s1.x,s1.y)-(s2.x,s2.y),Rgb(0,C.inc,0)
Var M=v((t1.x+t2.x)\2,(t1.y+t2.y)\2)
Var p2=shortline(C.ctr,M,1.1*C.r)
barecircle(C)
Paint(p2.x,p2.y),Rgb(0,0,0),Rgb(0,C.inc,0)
End Sub
Sub GetCircleShadow2(C As Circle,p As pt) ' ############################################## new method ###
dim as single pi = 3.14159265
dim as single pi_half = 1.570796
' delta and distance between circle center and mouse
dim as long _dx = p.x - c.ctr.x
dim as long _dy = p.y - c.ctr.y
dim as long _z = sqr( ( _dx * _dx ) + ( _dy * _dy ) )
' here is the angle of the circle center to the mouse
dim as single _a = atan2( _dy, _dx )
' here is the angle change relative to the mouse distance
dim as single _at = ( pi_half - ( pi_half / ( sqr( _z - c.r ) ) ) )
' tangent point 1
dim as single _tx1 = c.ctr.x + ( ( c.r ) * cos( _a + _at ) )
dim as single _ty1 = c.ctr.y + ( ( c.r ) * sin( _a + _at ) )
' tangent point 2
dim as single _tx2 = c.ctr.x + ( c.r * cos( _a - _at ) )
dim as single _ty2 = c.ctr.y + ( c.r * sin( _a - _at ) )
' below is due to not using your shortline() function for no
' reason other than i was too lazy
dim as long _dx1 = p.x - _tx1
dim as long _dy1 = p.y - _ty1
dim as long _dv1 = _dy1 / _dx1
dim as long _dz1 = sqr( ( _dx1 * _dx1 ) + ( _dy1 * _dy1 ) )
dim as long _dx2 = p.x - _tx2
dim as long _dy2 = p.y - _ty2
dim as long _dv2 = _dy2 / _dx2
dim as long _dz2 = sqr( ( _dx2 * _dx2 ) + ( _dy2 * _dy2 ) )
' project the shadow sides from the circle tangent points
Line( _tx1,_ty1)-( _tx1 + ( -1100 * _dx1 / _dz1 ), _ty1 + ( -1100 * _dy1 / _dz1 ) ), rgb(0,c.inc,0)
Line( _tx2,_ty2)-( _tx2 + ( -1100 * _dx2 / _dz2 ), _ty2 + ( -1100 * _dy2 / _dz2 ) ), rgb(0,c.inc,0)
' fill in the circle to allow paint() to fill in the shadow space
barecircle(C)
' here the paint() point is calculated to be just beyond the
' circle radius using the angle of the mouse to the circle
_tx1 = c.ctr.x + ( ( c.r + 1 ) * cos( _a + pi ) )
_ty1 = c.ctr.y + ( ( c.r + 1 ) * sin( _a + pi ) )
' paint() the shadow space
paint( _tx1, _ty1 ), rgb( 0, 0, 0 ), rgb( 0, c.inc, 0 )
End Sub
Function inbox(b As box,mx As Integer,my As Integer) As Long
var bw=abs(b.p(1).x-b.p(2).x)/30
var bh=abs(b.p(1).y-b.p(4).y)/30
Return mx>=b.p(1).x-bw And mx<=b.p(3).x+bw And my>=b.p(1).y-bh And my<=b.p(3).y+bh
End Function
Function InCircle(b As Circle,mx As Integer,my As Integer) As Integer
Return (b.ctr.x-mx)*(b.ctr.x-mx) +(b.ctr.y-my)*(b.ctr.y-my) < b.r*b.r
End Function
Sub setupfloor(xres As Integer,yres As Integer,floor As Any Ptr)
Dim As Long counter
Dim As Ulong col
For y As Long=-10 To yres+10 Step 100
For x As Long=-10 To xres+10 Step 100
counter+=1
If counter Mod 2 Then col=Rgb(255,255,255) Else col=Rgb(0,100,200)
Line floor,(x,y)-(x+100,y+100),col,bf
Next x
Next y
End Sub
Function checkboxseperation(b() As box,tst As pt,n As Integer,dx As Integer,dy As Integer) As Integer
For z As Integer=1 To n
If dist(b(z).p(0),tst) < (dx+dy) Then Return 0
Next z
Return -1
End Function
Sub setupboxes(b() As box,xres As Integer,yres As Integer)
Redim b(0)
Redim b(1 To IntRange(5,20))
Var m=map(5,20,Ubound(b),150,30)'fewer boxes then make them bigger
For n As Integer=1 To Ubound(b)
Dim As Integer xx,yy,dx,dy
Do
dx=Intrange(30,m):dy=intrange(30,m)
xx=IntRange(xres/15,xres-xres/15-dx):yy=Intrange(yres/15,yres-yres/15-dy)
Loop Until checkboxseperation(b(),v(xx,yy),n-1,dx,dy)
b(n)=Type<box>(v(xx,yy),v(xx+dx,yy+dy),Rgb(Rnd*255,Rnd*255,Rnd*255))
b(n).inc=n
Next n
End Sub
Function checkcircleseperation(b() As Circle,tst As pt,n As Integer,r As Integer) As Integer
For z As Integer=1 To n
If dist(b(z).ctr,tst) < (2*r) Then Return 0
Next z
Return -1
End Function
Sub setupCircles(b() As Circle,xres As Integer,yres As Integer)
Redim b(0)
Redim b(1 To IntRange(5,10))
Var m=map(5,10,Ubound(b),50,20)'fewer circles then make them bigger
For n As Integer=1 To Ubound(b)
Dim As Integer xx,yy,dx,dy
Dim As Integer rad
Do
rad=Intrange(30,m)
xx=IntRange(xres/15,xres-xres/15-dx):yy=Intrange(yres/15,yres-yres/15-dy)
Loop Until checkcircleseperation(b(),v(xx,yy),n-1,rad)
b(n)=Type<Circle>(v(xx,yy),rad,Rgb(Rnd*255,Rnd*255,Rnd*255))
b(n).inc=n
Next n
End Sub
'==========================================================
Redim As Circle circles()
setupCircles(circles(),xres,yres)
Redim As box b()
setupboxes(b(),xres,yres)
Dim As Any Ptr floor=Imagecreate(xres,yres)
setupfloor(xres,yres,floor)
Dim As Circle blankc
Dim As box blankb
Dim As Integer mx,my,mb,flag
Do
Getmouse mx,my,,mb
If mb=1 And flag=0 Then flag=1:setupboxes(b(),xres,yres):setupcircles(circles(),xres,yres)
Screenlock
Cls
Put(0,0),floor,Alpha,255
For n1 As Integer=Lbound(b) To Ubound(b)
If inbox(b(n1),mx,my) =0 Then GetBoxShadow(b(n1),v(mx,my))
Next n1
For n1 As Integer=Lbound(circles) To Ubound(circles)
'If inCircle(circles(n1),mx,my) =0 Then GetCircleShadow(circles(n1),v(mx,my)) '### old method ###
If inCircle(circles(n1),mx,my) =0 Then GetCircleShadow2(circles(n1),v(mx,my)) '### new method ###
Next n1
Put(0,0),floor,Alpha,100
Draw String (5,5),"Click Mouse",0
For n As Integer=1 To Ubound(b)
barebox(b(n),1)
Next n
For n As Integer=1 To Ubound(circles)
barecircle(circles(n),1)
Next n
Screenunlock
Sleep 15,1
flag=mb
Loop Until Len(Inkey)
Imagedestroy floor