Circular Pattern Using Triangles

[SierraKen]

I've seen this before, probably from B+, but I wanted to see if I could do it from a fresh start. After a few attempts I figured it out! I used radians on the circle and also saved the points in memory so I could then go to a DO/LOOP to use them how I wish.  After many triangles it starts over again with a random color again.

Code: (Select All)

'Circular Pattern Using Triangles by SierraKen
'October 11, 2022
'
'Thanks to B+ and others for the inspiration to make my own.

Dim x(1000), y(1000)
Screen _NewImage(800, 600, 32)
_Title "Circular Pattern Using Triangles by SierraKen - Esc to quit"
For t = 0 To 1000 Step 1 / 3
    x(t) = (Sin(t) * 180) + 400
    y(t) = (Cos(t) * 180) + 300
    Circle (x(t), y(t)), 2, _RGB32(0, 255, 0)
Next t
Randomize Timer
c1 = (Rnd * 155) + 100: c2 = (Rnd * 155) + 100: c3 = (Rnd * 155) + 100
Do
    _Limit 20
    'This uses radians in the circle. I used a radian chart online to get each formula with _PI
    Line (x(7 * (_Pi / 6) + a), y(7 * (_Pi / 6) + a))-(x(11 * (_Pi / 6) + a), y((11 * _Pi / 6) + a)), _RGB32(c1, c2, c3)
    Line (x(11 * (_Pi / 6) + a), y(11 * (_Pi / 6) + a))-(x((_Pi / 2) + a), y((_Pi / 2) + a)), _RGB32(c1, c2, c3)
    Line (x((_Pi / 2) + a), y((_Pi / 2) + a))-(x(7 * (_Pi / 6) + a), y(7 * (_Pi / 6) + a)), _RGB32(c1, c2, c3)
    a = a + 1 / 3
    If a > 300 Then
        a = 0
        Cls
        For tt = 0 To 2000 Step 1 / 3
            xx = (Sin(tt) * 180) + 400
            yy = (Cos(tt) * 180) + 300
            Circle (xx, yy), 2, _RGB32(0, 255, 0)
        Next tt
        c1 = (Rnd * 155) + 100: c2 = (Rnd * 155) + 100: c3 = (Rnd * 155) + 100
    End If
Loop Until InKey$ = Chr$(27)

[bplus]

Did you know I could make Sierpinski Triangles from Circles:

Code: (Select All)

_Title "Sierpinski Circled by bplus"
'2018-07-23 update some code tweaks learned when translating this to other BASIC flavors
'for new ORG avatar?
Const xmax = 740
Const ymax = 740
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 5
Dim Shared cx, cy, cr, ra, inc
cx = xmax / 2: cy = ymax / 2: cr = ymax / 6: inc = _Pi(1 / 360)
Color _RGBA(100, 255, 100, 40), _RGB32(0, 0, 0)
For n = 3 To 8
    a = 0
    ra = _Pi(2) / n
    While a < ra
        Cls
        levels = 12 - n
        RecurringCircles cx, cy, cr, n, a, levels
        a = a + inc
        _Display
        _Limit 10
    Wend
    Cls
    RecurringCircles cx, cy, cr, n, 0, levels
    _Display
    _Limit 5
Next
Sub RecurringCircles (x, y, r, n, rao, level)
    fcirc x, y, r
    If level > 0 Then
        For i = 0 To n - 1
            x1 = x + 1.5 * r * Cos(i * ra + rao + _Pi(-.5))
            y1 = y + 1.5 * r * Sin(i * ra + rao + _Pi(-.5))
            RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
        Next
    End If
End Sub

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , 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), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

[SierraKen]

That's beautiful B+! Very good for Christmas!