Recurring Star Power

[bplus]

Code: (Select All)

_Title "Recurring Star Power" ' b+ 2022-10-12
_Title "Recurring Star Power" ' b+ 2022-10-12
Const xmax = 700
Const ymax = 700
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 / 5.5: inc = _Pi(1 / 360)
Color _RGBA(100, 255, 100, 40), _RGB32(0, 0, 0)
For n = 5 To 5
    a = 0
    ra = _Pi(2) / n
    While 1
        Cls
        levels = 5 '12 - n
        RecurringCircles cx, cy, cr, n, a, levels
        a = a + inc
        _Display
    Wend
    Sleep
    Cls
    RecurringCircles cx, cy, cr, n, 0, levels
    _Display
    _Limit 5
Next

Sub RecurringCircles (x, y, r, n, rao, level)
    star x, y, .4 * r, r, 5, _R2D(_Pi / 10), &HFFFFFF00 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    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 * .45, n, 2 * rao, level - 1
        Next
    End If
End Sub

Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
    ' x, y are same as for circle,
    ' rInner is center circle radius
    ' rOuter is the outer most point of star
    ' nPoints is the number of points,
    ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
    ' this is to allow us to spin the polygon of n sides
    Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long

    pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset)
    x1 = x + rInner * Cos(radAngleOffset)
    y1 = y + rInner * Sin(radAngleOffset)
    For i = 0 To nPoints - 1
        x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
        y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
        x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
        y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
        ftri x1, y1, x2, y2, x3, y3, K
        'triangles leaked
        Line (x1, y1)-(x2, y2), K
        Line (x2, y2)-(x3, y3), K
        Line (x3, y3)-(x1, y1), K
        x1 = x3: y1 = y3
    Next
    Paint (x, y), K, K
End Sub

Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

Complete with the occasional twinkle!

EDIT: remove extra sub