Overlapping Circles

[SierraKen]

Wow now they actually look like marbles in space! Thanks B+! I added a starfield around them but that's all I can do for now. I wouldn't know where to start on the crescents, etc. because of the way the Sun always changes angles as well as the Earth. So anyway, here is one with a starfield and the fixed orbs, thanks again. Feel free to add anything you wish to it guys. 

Code: (Select All)

'3D Earth Orbit and Moon by SierraKen
'Made on July 6, 2022.
Dim starx(1000), stary(1000)
Dim dx(1000), dy(1000)
Dim sz(1000)
Dim speed(1000)
Dim cx As Integer, cy As Integer, ra As Integer, cl As _Unsigned Long

_Title "3D Earth Orbit and Moon by SierraKen"
Screen _NewImage(800, 600, 32)
t = 1800
x = 400: y = 300: r = 50
t2 = 1800
cc4 = 100
cc5 = 100
Do
    _Limit 20
    'Starfield
    fillCircle cx, cy, 5, cl
    If sp < .0005 Then sp = .0005
    If sp > .1 Then sp = .1
    warp = (sp * 100) + 1
    If warp > 10 Then warp = 10
    warp = Int(warp)
    stars = Int(Rnd * 100) + 1
    If stars > 25 Then
        ss = ss + 1
        If ss > 950 Then ss = 1
        'Set starting position.
        startx = Rnd * 490
        starty = Rnd * 390
        st = Int(Rnd * 360)
        xx = (Sin(st) * startx) + 400
        yy = (Cos(st) * starty) + 300
        starx(s) = xx
        stary(s) = yy
        'Set direction to move.
        dx(s) = ((xx - 400) / 30)
        dy(s) = ((yy - 300) / 30)
        'Set size.
        sz(s) = Rnd
        'Set speed
        speed(s) = .1
    End If
    If yy > 640 Then yy = 0
    For tt = 1 To 950
        speed(tt) = speed(tt) * (1.05 + sp)
        stary(tt) = stary(tt) + dy(tt) * speed(tt)
        starx(tt) = starx(tt) + dx(tt) * speed(tt)
        cx = starx(tt): cy = stary(tt)
        ra = sz(tt) + .5
        cl = _RGB32(255, 255, 255)
        fillCircle cx, cy, ra, cl
        'skip:
    Next tt

    If t < 90 Then t = 1800
    If t2 < 90 Then t2 = 1800
    x2 = (Sin(t) * 360) + 400
    y2 = (Cos(t) * 180) / _Pi / 1.5 + 300
    r2 = (Cos(t) * 180) / _Pi / 1.5 + 50
    x3 = (Sin(t2) * r2 * (y3 / y2) * _Pi) + x2
    y3 = (Cos(t2) * 120) / _Pi / 1.5 + y2
    r3 = (Cos(t2) * 20) / _Pi / 1.5 + r2 / 5
    t = t - .025
    t2 = t2 - .3
    If y2 < 293.75 Then
        'Earth
        For s = .25 To r2 Step .25
            cc = cc + .5
            Circle (x2, y2), s, _RGB32(100 - cc, 100 - cc, 200 - cc)
        Next s
        cc = 0
        'Moon
        cc4 = 200
        For s = .25 To r3 Step .25
            cc4 = cc4 - 2
            Circle (x3, y3), s, _RGB32(cc4, cc4, cc4)
        Next s
        cc4 = 0
    End If
    'Sun
    For sun = .25 To 35 Step .25
        cc2 = cc2 + 1
        Circle (x, y), sun, _RGB32(255 - cc2, 255 - cc2, 128 - cc2)
    Next sun
    cc2 = 0
    If y2 >= 293.75 Then
        'Earth
        For s = .25 To r2 Step .25
            cc3 = cc3 + .5
            Circle (x2, y2), s, _RGB32(100 - cc3, 100 - cc3, 200 - cc3)
        Next s
        cc3 = 0
        'Moon
        cc5 = 200
        For s = .25 To r3 Step .25
            cc5 = cc5 - 2
            Circle (x3, y3), s, _RGB32(cc5, cc5, cc5)
        Next s
        cc5 = 0
        If y3 < y2 Then
            'Earth
            For s = .25 To r2 Step .25
                cc3 = cc3 + .5
                Circle (x2, y2), s, _RGB32(100 - cc3, 100 - cc3, 200 - cc3)
            Next s
            cc3 = 0
        End If
    End If
    _Delay .05
    _Display
    Cls
Loop Until InKey$ = Chr$(27)

'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