Overlapping Circles

[SierraKen]

I've never made something like this before so I figured I would try it out using the fillcircle sub as pitch black and a colored circle around each of the 2 circles. It might be useful on something someday. I should point out that the 3D rotation orbit isn't a circle, it's more like a 3D square. I couldn't figure out the equation for a 3D orbit on the Z axis, so I just winged it. 

Edit: There's a full-circle 3D one on a post below on this thread that I figured out. But I am keeping this one in case anyone wants to use this type.

Code: (Select All)

Screen _NewImage(800, 600, 32)
Dim c As Long, c2 As Long

cx = 600: cy = 300: r = 98: c = _RGB32(0, 0, 0)
dir = 1
cx2 = 200: cy2 = 300: r2 = 98: c2 = _RGB32(0, 0, 0)
dir2 = 2
r = 100
r2 = 100
firstoverlap:
Do
    a$ = InKey$
    If a$ = Chr$(27) Then End
    If dir = 1 And dir2 = 2 Then GoTo secondoverlap:
    For t = 0 To 360
        x = (Sin(t) * (r + 2)) + cx
        y = (Cos(t) * (r + 2)) + cy
        Circle (x, y), 2, _RGB32(0, 255, 0)
        fillCircle cx, cy, r, c
    Next t
    If dir = 1 And cx < 400 Then r = r - 1
    If dir = 1 And cx > 399 Then r = r + 1
    If dir = 2 And cx < 400 Then r = r + 1
    If dir = 2 And cx > 399 Then r = r - 1
    If r < 50 Then r = 50
    If r > 150 Then r = 150
    If dir = 1 Then cx = cx + 10
    If dir = 2 Then cx = cx - 10
    If cx > 600 Then dir = 2
    If cx < 200 Then dir = 1
    For t = 0 To 360
        x = (Sin(t) * (r2 + 2)) + cx2
        y = (Cos(t) * (r2 + 2)) + cy2
        Circle (x, y), 2, _RGB32(255, 0, 0)
        fillCircle cx2, cy2, r2, c2
    Next t
    If dir2 = 1 And cx2 < 400 Then r2 = r2 + 1
    If dir2 = 1 And cx2 > 399 Then r2 = r2 - 1
    If dir2 = 2 And cx2 < 400 Then r2 = r2 - 1
    If dir2 = 2 And cx2 > 399 Then r2 = r2 + 1
    If r2 < 50 Then r2 = 50
    If r2 > 150 Then r2 = 150
    If dir2 = 1 Then cx2 = cx2 + 10
    If dir2 = 2 Then cx2 = cx2 - 10
    If cx2 > 600 Then dir2 = 2
    If cx2 < 200 Then dir2 = 1
    Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 50), BF
    _Display
Loop
secondoverlap:
Do
    a$ = InKey$
    If a$ = Chr$(27) Then End
    If dir = 2 And dir2 = 1 Then GoTo firstoverlap:
    For t = 0 To 360
        x = (Sin(t) * (r2 + 2)) + cx2
        y = (Cos(t) * (r2 + 2)) + cy2
        Circle (x, y), 2, _RGB32(255, 0, 0)
        fillCircle cx2, cy2, r2, c2
    Next t
    If dir2 = 1 And cx2 < 400 Then r2 = r2 - 1
    If dir2 = 1 And cx2 > 399 Then r2 = r2 + 1
    If dir2 = 2 And cx2 < 400 Then r2 = r2 + 1
    If dir2 = 2 And cx2 > 399 Then r2 = r2 - 1
    If r2 < 50 Then r2 = 50
    If r2 > 150 Then r2 = 150
    If dir2 = 1 Then cx2 = cx2 + 10
    If dir2 = 2 Then cx2 = cx2 - 10
    If cx2 > 600 Then dir2 = 2
    If cx2 < 200 Then dir2 = 1
    For t = 0 To 360
        x = (Sin(t) * (r + 2)) + cx
        y = (Cos(t) * (r + 2)) + cy
        Circle (x, y), 2, _RGB32(0, 255, 0)
        fillCircle cx, cy, r, c
    Next t
    If dir = 1 And cx < 400 Then r = r + 1
    If dir = 1 And cx > 399 Then r = r - 1
    If dir = 2 And cx < 400 Then r = r - 1
    If dir = 2 And cx > 399 Then r = r + 1
    If r < 50 Then r = 50
    If r > 150 Then r = 150
    If dir = 1 Then cx = cx + 10
    If dir = 2 Then cx = cx - 10
    If cx > 600 Then dir = 2
    If cx < 200 Then dir = 1
    Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 50), BF
    _Display
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

[bplus]

It does look like they are going in circles, pretty neat.

[SierraKen]

Thanks B+.

[James D Jarvis]

I fiddled with adding a modifier to CY and CY2 and that made the paths look a little more elliptical, but really it looks fine without it.

[SierraKen]

Thanks James! Yeah people can make different things with it I think.

[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

[OldMoses]

Thanks for doing these. They look pretty cool and inspired me to try my hand at something vaguely similar.

Code: (Select All)

SCREEN _NEWIMAGE(1024, 512, 32)
DIM orb(1) AS LONG
a% = 0
b% = -1
r% = 200 '                                                      orbital radius

orb(0) = _NEWIMAGE(100, 100, 32) '                              create the circles
orb(1) = _NEWIMAGE(100, 100, 32)
FOR x% = 0 TO 1
    _DEST orb(x%)
    CLS
    _CLEARCOLOR &HF000000
    IF x% MOD 2 = 0 THEN c& = &HFFFF0000 ELSE c& = &HFF0000FF
    FCirc 49, 49, 49, c&
NEXT x%
_DEST 0

DO
    CLS
    ang% = ang% + 1
    IF ang% > 359 THEN ang% = 0
    IF ang% = 90 OR ang% = 270 THEN SWAP a%, b% '               flip display order when orthogonal to view
    sw% = 10 * COS(_D2R(ang%)) '                                swell factor
    ps% = r% * SIN(_D2R(ang%)) '                                orbital radius position
    IF a% THEN '                                                set display order
        _PUTIMAGE (281, 206), orb(0)
        Image_Resize 285 + ps% + sw%, 206 + sw%, 385 + ps% - sw%, 306 - sw%, orb(1), 0, "c", "c"
    ELSE
        Image_Resize 285 + ps% + sw%, 206 + sw%, 385 + ps% - sw%, 306 - sw%, orb(1), 0, "c", "c"
        _PUTIMAGE (281, 206), orb(0)
    END IF
    _LIMIT 100
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)

END

SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG)
    DIM AS INTEGER R, RError, X, Y
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    LINE (CX - X, CY)-(CX + X, CY), C, BF '                     draw equatorial line
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw line above equator
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw line below equator
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF '         draw line north latitudes
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF '         draw line south latitudes
    WEND
END SUB 'FCirc

SUB Image_Resize (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
    DIM AS INTEGER xs, ys, xp, yp, xl, yl
    xp = xpos: yp = ypos: xl = xlim: yl = ylim '                isolate sent parameters from any changes
    DIM AS SINGLE rt, xrt, yrt
    xrt = (xl - xp) / _WIDTH(i) '                               width of area divided by width of image
    yrt = (yl - yp) / _HEIGHT(i) '                              height of area divided by height of image
    rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) '              pick the smaller of the two ratios to fit area
    xs = _WIDTH(i) * rt '                                       final image size ratio in x
    ys = _HEIGHT(i) * rt '                                      final image size ratio in y
    xp = -xp * (xj = "l") - (_SHR(xl - xp, 1) + xp - _SHR(xs, 1)) * (xj = "c") - (xl - xs) * (xj = "r")
    xl = xp + xs
    yp = -yp * (yj = "u") - (_SHR(yl - yp, 1) + yp - _SHR(ys, 1)) * (yj = "c") - (yl - ys) * (yj = "d")
    yl = yp + ys
    _PUTIMAGE (xp, yp)-(xl, yl), i, d
END SUB 'Image_Resize

[SierraKen]

That's pretty wild OldMoses! 

Here is my orbital Earth:

Code: (Select All)

Screen _NewImage(800, 600, 32)
t = 1800
x = 400: y = 300: r = 50
Do
    _Limit 20
    t = t - .25
    If t < 90 Then t = 1800
    x2 = (Sin(t) * 360) + 400
    y2 = (Cos(t) * 180) / _Pi / 1.5 + 300
    r2 = (Cos(t) * 180) / _Pi / 1.5 + 50
    If y2 < 300 Then
        'Earth
        For s = .25 To r2 Step .25
            cc = cc + .25
            Circle (x2, y2), s, _RGB32(cc, cc, 100 + cc)
        Next s
        cc = 0
    End If
    'Sun
    For sun = .25 To 35 Step .25
        cc2 = cc2 + 1
        Circle (x, y), sun, _RGB32(200 + cc2, 200 + cc2, 64 + cc2)
    Next sun
    cc2 = 0
    If y2 > 300 Then
        'Earth
        For s = .25 To r2 Step .25
            cc3 = cc3 + .25
            Circle (x2, y2), s, _RGB32(cc3, cc3, 100 + cc3)
        Next s
        cc3 = 0
    End If
    _Delay .05
    _Display
    Cls
Loop Until InKey$ = Chr$(27)

[SierraKen]

Here is a much slower Earth:

Code: (Select All)

Screen _NewImage(800, 600, 32)
t = 1800
x = 400: y = 300: r = 50
Do
    _Limit 20
    If t < 90 Then t = 1800
    x2 = (Sin(t) * 360) + 400
    y2 = (Cos(t) * 180) / _Pi / 1.5 + 300
    r2 = (Cos(t) * 180) / _Pi / 1.5 + 50
    t = t - .025
    If y2 < 300 Then
        'Earth
        For S = .25 To r2 Step .25
            cc = cc + .25
            Circle (x2, y2), S, _RGB32(cc, cc, 100 + cc)
        Next S
        cc = 0
    End If
    'Sun
    For sun = .25 To 35 Step .25
        cc2 = cc2 + 1
        Circle (x, y), sun, _RGB32(200 + cc2, 200 + cc2, 64 + cc2)
    Next sun
    cc2 = 0
    If y2 > 300 Then
        'Earth
        For S = .25 To r2 Step .25
            cc3 = cc3 + .25
            Circle (x2, y2), S, _RGB32(cc3, cc3, 100 + cc3)
        Next S
        cc3 = 0
    End If
    _Delay .05
    _Display
    Cls
Loop Until InKey$ = Chr$(27)

[SierraKen]

Here is a funny one with the Moon orbiting the Earth and both of them orbiting the Sun. It's funny because it's not proportional, but I think it's neat. 

Code deleted, try the next one on Page 2, it is much better thanks.