AM PM proximity??? Just put AM or PM right dead center of the clock!
Here is what I meant:
true tangent circles not a necessity but it was a fun challenge to see what percent radius for 12 circles around a Big Radius circle.
Here is what I meant:
Code: (Select All)
_Title "12 Tangent Circles Problem and Clock" ' b+ 2026-02-22
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
_PrintMode _KeepBackground
xc = _Width / 2: yc = _Height / 2: p2 = _Pi(1 / 2): BigR = 120
r12 = .33 * BigR ' start smaller
n = 12
Cls
Print "N ="; n
a = _Pi(2) / n
Dim iix1, iiy1, iix2, iiy2
tryAgain:
Cls
Circle (xc, yc), BigR
Circle (xc, yc), BigR + r12
For ang = 0 To _Pi(2) + 2 * a Step a
x = xc + (r12 + BigR) * Cos(ang - p2)
y = yc + (r12 + BigR) * Sin(ang - p2)
Circle (x, y), r12
If ang > 0 And ang <= a + .001 Then ' r12 too small
intersect2Circles x, y, r12, lastx, lasty, r12, iix1, iiy1, iix2, iiy2
If iix1 = iix2 And iix1 = 0 Then
Print "There is no intersection in this case, ...zzz, press any"
Sleep
Cls
r12 = r12 + .5
GoTo tryAgain
'Else ' Good finish drawing to exit loop and print r12
End If
End If
lastx = x: lasty = y
Next
Print "radius of 12 circles is"; r12
Print "percent of large radius is"; r12 / BigR * 100
'Print iix1, iiy1
'Print iix2, iiy2
Print "zzz... press any"
Sleep
' now make clock
Do Until _KeyDown(27)
Cls
Dim cx(14), cy(14)
i = 0
For ang = 0 To _Pi(2) + 2 * a Step a
cx(i) = xc + (r12 + BigR) * Cos(ang - p2)
cy(i) = yc + (r12 + BigR) * Sin(ang - p2)
i = i + 1
Next
't$ = "12:00:00" ' test alignments
t$ = Time$
h = Val(Mid$(t$, 1, 2))
If h > 12 Then
h = h - 12
ap$ = "PM"
Else
ap$ = "AM"
End If
h$ = _Trim$(Str$(h))
ha = _D2R(h * 360 / 12)
hx = xc + (r12 + BigR) * Cos(ha - p2)
hy = yc + (r12 + BigR) * Sin(ha - p2)
m$ = Mid$(t$, 4, 2)
ma = _D2R(Val(m$) * 360 / 60)
mx = xc + (r12 * 2.5 + BigR) * Cos(ma - p2)
my = yc + (r12 * 2.5 + BigR) * Sin(ma - p2)
s$ = Mid$(t$, 7, 2)
sa = _D2R(Val(s$) * 360 / 60)
sx = xc + (r12 * 3.4 + BigR) * Cos(sa - p2)
sy = yc + (r12 * 3.4 + BigR) * Sin(sa - p2)
FatLine xc, yc, hx, hy, 10, &HFFFFFFFF
FatLine xc, yc, mx, my, 5, &HFFFFFFFF
FatLine xc, yc, sx, sy, 2, &HFFFFFFFF
FC3 xc, yc, BigR - 50, &HFFFFFFFF
FC3 xc, yc, BigR - 55, &HFFFF0000
Text xc - 46, yc - 44, 96, &HFFFFFFFF, ap$
For i = 0 To 11
FC3 cx(i), cy(i), r12, _RGB32(255)
FC3 cx(i), cy(i), r12 - 5, _RGB32(0, 0, (i / 12 * 128 + 128))
If i = 0 Then si$ = "12" Else si$ = _Trim$(Str$(i))
xoff = (Len(si$) * 24) / 2
Text cx(i) - xoff, cy(i) - 22, 48, _RGB32(0, 0, i / 12 * 128), si$
Next
xoff = (Len(_Trim$(Str$(h))) * 24) / 2
Text hx - xoff, hy - 22, 48, &HFFFFFFFF, h$
FC3 mx, my, r12 * .5, &HFFFFFFFF
FC3 mx, my, r12 * .5 - 3, &HFF0000AA
xoff = (Len(m$) * 8) / 2 - 2
_PrintString (mx - xoff, my - 8), m$
FC3 sx, sy, r12 * .4, &HFFFFFFFF
FC3 sx, sy, r12 * .4 - 2, &HFF000088
xoff = (Len(s$) * 6) / 2 - 1
Text sx - xoff, sy - 6, 12, &HFFFFFFFF, s$
_Display
_Limit 30
Loop
Function distance (x1, y1, x2, y2)
distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
End Function
Sub intersect2Circles (x1, y1, r1, x2, y2, r2, ix1, iy1, ix2, iy2)
' needs Function distance (x1, y1, x2, y2) unless use _Hypot
'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
Dim d, a, h, Px, pY
d = distance(x1, y1, x2, y2) 'distance between two origins
If r1 + r2 < d Then
'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
Exit Sub
End If
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
Exit Sub
'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
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
End Sub
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&)
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
Dim fg As _Unsigned Long, bg As _Unsigned Long, cur&, i&
fg = _DefaultColor: bg = _BackgroundColor: cur& = _Dest
i& = _NewImage(8 * Len(txt$), 16, 32)
_Dest i&: Color K, _RGBA32(0, 0, 0, 0): _PrintString (0, 0), txt$
_PutImage (x, y)-Step(Len(txt$) * textHeight / 2, textHeight), i&, cur&
Color fg, bg: _FreeImage i&: _Dest cur&
End Sub
Sub FatLine (x, y, x2, y2, wide As Integer, c As _Unsigned Long)
' this sub needs fcirc
Dim dx, dy, dist, r
dx = x2 - x
dy = y2 - y
dist = _Hypot(dx, dy)
r = Int(wide / 2)
If dist Then ' bullet proof
dx = dx / dist
dy = dy / dist
If r = 0 Then
Line (x, y)-(x2, y2), c
Else
Dim i As Long
While i <= dist
FC3 x + i * dx, y + i * dy, r, c
i = i + 1
Wend
End If
Else
If r = 0 Then ' bullet proof
PSet (x, y), c
Else
FC3 x, y, r, c
End If
End If
End Subtrue tangent circles not a necessity but it was a fun challenge to see what percent radius for 12 circles around a Big Radius circle.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever