_TITLE "The Intersection of Two Circles" 'trans from SmallBASIC 2019-07-03 B+ 'dang there is a case where one circle is inside the other
DIM xx1
, yy1
, rr1
, xx2
, yy2
, rr2
, iix1
, iiy1
, iix2
, iiy2
, keyh
AS LONG, xr1
, yr1
, xr2
, yr2
, ttl$
, d
, a1to1
, a2to1
, a1to2
, a2to2
DIM a1Start
, a1End
, a2Start
, a2End
ttl$ = "Testing 2 Circle Intersect"
'test code for intersect
' 1st circle
mBox "Click screen for first circle origin, then click again for it's radius", ttl$
getClick xx1, yy1, keyh
getClick xr1, yr1, keyh
rr1 = distance(xr1, yr1, xx1, yy1)
' 2nd circle
mBox "Click screen for 2nd circle origin, then click again for it's radius", ttl$
getClick xx2, yy2, keyh
getClick xr2, yr2, keyh
rr2 = distance(xr2, yr2, xx2, yy2)
intersect2Circles xx1, yy1, rr1, xx2, yy2, rr2, iix1, iiy1, iix2, iiy2
BEEP: mBox
"There is no intersection in this case.", ttl$
LINE (iix1
, iiy1
)-(iix2
, iiy2
), yel
mBox "Here is a line through the intersection points, next we will show the 'eye lens' of two connecting arcs.", ttl$
'now the whole point of this exercise is get information for drawing an arcs
' we need to translate a point on a circle to it's radian measure in the circle at distance of radius of course
'let's try to draw the eye shape of two arcs coming together at the intersect
minorArc xx1, yy1, rr1, rAngle(xx1, yy1, iix1, iiy1), rAngle(xx1, yy1, iix2, iiy2), red
minorArc xx2, yy2, rr2, rAngle(xx2, yy2, iix1, iiy1), rAngle(xx2, yy2, iix2, iiy2), blu
'given a circles origin, radius and point on the circumference return the arc measure of that point
FUNCTION rAngle
(coX
, coY
, circumX
, circumY
) rAngle
= _ATAN2(circumY
- coY
, circumX
- coX
)
'given two arc angles I want the one that draws the smaller arc drawn
'which has smaller arc meansure
IF ra2
- ra1
< _PI THEN raStart
= ra1: raStop
= ra2
ELSE raStart
= ra2: raStop
= ra1
IF ra1
- ra2
< _PI THEN raStart
= ra2: raStop
= ra1
ELSE raStart
= ra1: raStop
= ra2
arc x, y, r, raStart, raStop, c
SUB intersect2Circles
(x1
, y1
, r1
, x2
, y2
, r2
, ix1
, iy1
, ix2
, iy2
) 'x1, y1 origin of circle 1 with radius r1
'x2, y2 origin of circle 2 with radius r2
'ix1, iy1 is the first point of intersect
'ix2, iy2 is the 2nd point of intersect
'if ix1 = ix2 = iy1 = iy2 = 0 then no points returned
d = distance(x1, y1, x2, y2) 'distance between two origins
'PRINT "The circles are too far apart to intersect.": END
'some signal ??? if ix1 = ix2 = iy1 = iy2 = 0 then no points returned
ix1 = 0: ix2 = 0: iy1 = 0: iy2 = 0
IF (d
< r1
AND r2
+ d
< r1
) OR (d
< r2
AND r1
+ d
< r2
) THEN 'one circle is inside the other = no intersect ix1 = 0: ix2 = 0: iy1 = 0: iy2 = 0
'IF ABS(r1 - r2) > 3 THEN
' PRINT "No intersect, same center (or nearly so) and different radii (or seemingly so).": END
'ELSE
' PRINT "Infinite intersect, the circles are the same (or nearly so).": END
'END IF
'results
a = (r1 ^ 2 - r2 ^ 2 + d ^ 2) / (2 * d)
Px = x1 + a * (x2 - x1) / d
pY = y1 + a * (y2 - y1) / d
h = (r1 ^ 2 - a ^ 2) ^ .5
ix1
= INT(Px
- h
* (y2
- y1
) / d
) iy1
= INT(pY
+ h
* (x2
- x1
) / d
) 'circle x1,y1,2,1 filled
'PRINT: PRINT "Intersect pt1: "; x1; ", "; y1
ix2
= INT(Px
+ h
* (y2
- y1
) / d
) iy2
= INT(pY
- h
* (x2
- x1
) / d
) 'circle x2,y2,2,1 filled
'PRINT: PRINT "Intersect pt2: "; x2; ", "; y2
'line x1,y1,x2,y2
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
arc x
, y
, r
, raStart
, _PI(2), c
arc x, y, r, 0, raStop, c
' modified to easier way suggested by Steve
'Why was the line method not good? I forgot.
al
= _PI * r
* r
* (raStop
- raStart
) / _PI(2)
distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
'2019-03-02 added more clearing for mb at start
mx = -1: my = -1: kh = 0
'IF mb THEN
'title$ limit is 55 chars, all lines are 58 chars max
' 2019-03-02 fix clearing of key and mb, maybe
'first screen dimensions items to restore at exit
'2019-03-02 add this to clear old mb or keypress
DBLU = &HFF000066
LBLU = &HFFB0A0FF
BLK = &HFF000000
WHT = &HFFFFFFFF
'screen snapshot
'setup t$() to store strings with ti as index, linit 58 chars per line max, b$ is for build
REDIM t$
(0): ti
= 0: limit
= 58: b$
= "" 'are there any new line signals, CR, LF or both? take CRLF or LFCR as one break but dbl LF or CR means blank line
tail$ = "": ff = 0
FOR j
= LEN(b$
) TO 1 STEP -1 'backup until find a space, save the tail end for next line ff = 1 'found space flag
tail$ = d$ + tail$ 'the tail grows!
b$ = b$ + c$ 'just keep building the line
t$(ti) = b$
bxH = ti + 3: bxW = limit + 2
'draw message box
'now for the action
'convert to pixels the top left corner of box at moment
bxW = bxW * 8: bxH = bxH * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
'now allow user to move it around or just read it
IF mx
>= tlx
AND mx
<= tlx
+ bxW
AND my
>= tly
AND my
<= tly
+ 16 THEN 'mouse down on title bar grabx = mx - tlx: graby = my - tly
IF mx
- grabx
>= 0 AND mx
- grabx
<= sw
- bxW
AND my
- graby
>= 0 AND my
- graby
<= sh
- bxH
THEN 'attempt to speed up with less updates
IF ((lastx
- (mx
- grabx
)) ^ 2 + (lasty
- (my
- graby
)) ^ 2) ^ .5 > 10 THEN tlx = mx - grabx: tly = my - graby
lastx = tlx: lasty = tly
'put things back
