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

[Pete]

If I want to see stars, I just take a quick 30-minute trip to Hollywood. If I want to see more stars, I just whistle at one of the sexy actresses, on Hollywood Blvd, while my wife is in the car.

Pete

[bplus]

If I want to see stars, I just take a quick 30-minute trip to Hollywood. If I want to see more stars, I just whistle at one of the sexy actresses, on Hollywood Blvd, while my wife is in the car.

Pete

I had to think a sec about the wife part!

[Pete]

Yeah. I wish I did, before I whistled.

Pete

[Pete]

Well stars in rotating snowflakes? That's what it looks like to me. Honestly, if someone would have told me 15 years ago that this would be 100 lines of code, I think I would have been very skeptical, _maptriangle and a few other qb64 keywords later and there we have it. Nice job!

Pete

[bplus]

Here is a little mod expansion on the Star Flake theme:

Code: (Select All)

_Title "Recurring Star Power 2" ' 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 = 3 To 7
    a = 0
    ra = _Pi(2) / n
    While a < _Pi(2) / n
        Cls
        levels = 10 - n
        RecurringCircles cx, cy, cr, n, a, levels
        a = a + inc
        _Display
    Wend
    Cls
    RecurringCircles cx, cy, cr, n, 0, levels
    _Display
    _Delay 2
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

   

[Pete]

I just got a call from snowflake General Mark Milley. He wants 4 for each shoulder, and a cry closet to store them in.

Pete

[Kernelpanic]

That's great! I should really take a look at the graphics options under Basic. But I have to start from absolutely zero.

How much is two and two? Hm, . . . Yeah, . . . three?  

[Pete]

Everyone in North Korea knows two plus two equals bigger two.

I've done a few graphics programs. It's not too difficult to learn, but it doesn't feel as intuitive to do printing in graphics.

Pete

[SierraKen]

Awesome stuff! You could make the background white and the stars red and turn it into cards.