Overlapping Circles

[SierraKen]

Here is a much better version I just figured out today. It goes in a full 3D circle (front to back and back to front again, etc.) overlapping both circles as it was before. People can make 3D orbits with this, etc. I'll keep the older one up there in case people want to make it that way. The funny thing is, this one has much less code which I am proud of.

Code: (Select All)

Screen _NewImage(800, 600, 32)
r = 100
c = _RGB32(0, 0, 0)
t2 = 180
r2 = 100
Do
    For t = 90 To 180 Step .25
        _Limit 20
        x = (Sin(t) * 180) + 400
        y = (Cos(t) * 180) / _Pi + 300
        r = (Cos(t) * 90) / _Pi / 2 + 50
        fillCircle x, y, r, c
        Circle (x, y), r + 2, _RGB32(0, 255, 0)
        t2 = t2 - .25
        If t2 < 90 Then t2 = 180
        x2 = (Sin(t2) * 180) + 400
        y2 = (Cos(t2) * 180) / _Pi + 300
        r2 = (Cos(t2) * 90) / _Pi / 2 + 50
        fillCircle x2, y2, r2, c
        Circle (x2, y2), r2 + 2, _RGB32(255, 0, 0)
        _Delay .01
        _Display
        Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 30), BF
    Next t
Loop
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    Dim Radius As Integer, RadiusError As Integer
    Dim X As Integer, Y As Integer
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub