Challenges

[bplus]

@2112 I have been messin with your star code and found some interesting mods

Code: (Select All)

handle& = _NewImage(620, 630, 32)
Screen handle&
stars = 360

' comment out with stars increased the Doyle effect is no longer seen get standard swirl
stars = 1080


Dim sr(stars + 1) As Integer 'radius of stars
Dim ss(stars + 1) As Integer 'step speed of stars
Dim sd(stars + 1) As Integer 'degrees of stars
Dim sx(stars + 1) As Single 'x position of stars
Dim sy(stars + 1) As Single 'y position of stars
Dim sxf, syf As Integer 'x,y final position of stars

Dim pi As Single
pi = 360 ' 3.14159
For i = 1 To stars


    ss(i) = 1 'step  '<<< this creates hole in the spiral swirl
    '                     and looks like rays are swirling inward not outward

    ' comment out
    ss(i) = -1 'step ' this fixes the swirl holes and now going outward


    sr(i) = i / 2 '100'radius
    sd(i) = 360 'degrees
    sx(i) = i * (360 / stars) 'x pos
    sy(i) = i * (360 / stars) 'y pos
Next i
Do
    Cls
    For i = 1 To stars 'To 1 Step -1
        If sx(i) < 360 Then sx(i) = sx(i) + ss(i) Else sx(i) = sx(i) - 360
        If sy(i) < 360 Then sy(i) = sy(i) + ss(i) Else sy(i) = sy(i) - 360

        'I swapped Sin  and Cos and doesnt seem to make a difference!!!
        sxf = Cos(pi * sx(i) / sd(i)) * (sr(i) / 1) ' COS should be assoc with x
        syf = Sin(pi * sy(i) / sd(i)) * (sr(i) / 2) - (360 - i) ' SIN should be assoc with y
        syf2 = Sin(pi * sy(i) / sd(i)) * (sr(i) / 1)

        'Line (300 + sxf, 500 + syf)-(302 + sxf, 502 + syf), _RGB(Rnd * 200, 220, 0), BF ' TREE
        ' tree is nice but I am interested in Doyle Spirals

        Circle (310 + sxf / 3, 315 + syf2 / 3), 1, _RGB(200, 200, 0), BF 'STAR
    Next i
    _Delay .01
    _Display
Loop Until InKey$ = Chr$(27)
_AutoDisplay
End

reversed direction of steps (-1) and fixed holes +1 was causing plus now the star is radiating outward.

also the doyle effect is lost when number of stars are increased to get bigger star, just turns into swirling in one direction like spiral armed galaxy.

[2112]

It's amazing what you can do with sin and cos. Here is another, looks like the universe expanding and collapsing.

Code: (Select All)

handle& = _NewImage(800, 800, 32)

Screen handle&



stars = 360



Dim sr(stars + 1) As Integer 'radius of stars

Dim ss(stars + 1) As Integer 'step speed of stars

Dim sd(stars + 1) As Integer 'degrees of stars

Dim sx(stars + 1) As Single 'x position of stars

Dim sy(stars + 1) As Single 'y position of stars

Dim sxf, syf As Integer 'x,y final position of stars



Dim pi As Single

pi = 180 ' 3.14159



For i = 1 To stars

    ss(i) = 1 'step

    sr(i) = 180 - i '100'radius

    sd(i) = 180 / i 'degrees

    sx(i) = i * (360 / stars) 'x pos

    sy(i) = i * (360 / stars) 'y pos

Next i



Do

    Cls

    For i = 1 To stars

        sx(i) = sx(i) + ss(i): If sx(i) >= 360 Then sx(i) = 360 - sx(i)

        sy(i) = sy(i) + ss(i): If sy(i) >= 360 Then sy(i) = 360 - sy(i)



        sxf = Sin(pi * sx(i) / sd(i)) * (sr(i) / 1)

        syf = Cos(pi * sy(i) / sd(i)) * (sr(i) / 1) + sx(i)



        Line (300 + sxf, 200 + syf)-(304 + sxf, 204 + syf), _RGB(Rnd * 200, 110, 0), BF

    Next i

    _Delay .01

Loop Until InKey$ = Chr$(27)

[bplus]

@2112 +1 not seen anything like that before, wild!

You've seen Bubble Universe through QBJS yet? Talk about what you can do with SIN and COS!!!

https://qbjs.org/?code=Q29uc3QgeG1heCA9I...93bigyNykK

Click link then click triangle "play" button click square when done if you've not used QBJS before.

[NakedApe]

Very cool, @2112! And adding _Display after the _Delay makes the jerkiness go away... 

[madscijr]

You've seen Bubble Universe through QBJS yet? Talk about what you can do with SIN and COS!!!

Bubble Universe is truly mindblowing

[Dav]

Cool code, @2112!  Awesome effect.  +1 from me as well.

Yes, SIN & COS are so fun to experiment with.  Here's something I was playing around with tonight. 

- Dav

Code: (Select All)

'SinCosPlay.bas

'By Dav for QB64PE, NOV/2025



Screen _NewImage(Int(_DesktopHeight * .75), Int(_DesktopHeight * .75), 32)



Do

    Cls

    For i = 0 To 360 Step .03

        r = i / 180 * _Pi

        x = (_Width / 2) + Cos(r * 3 + t) * ((_Width / 4) + Sin(r * 4 + t * 3) * (_Width / 8))

        y = (_Height / 2) + Sin(r * 2 + t) * ((_Height / 4) + Cos(r * 3 + t * 4) * (_Height / 8))

        Circle (x, y), (_Height / 50) + i Mod (_Height / 50), _RGBA(i / 2, i / 3, 255, 25)

    Next

    t = t + .1

    _Display

    _Limit 15

Loop

[bplus]

+1 @Dav whoa wow!

[bplus]

Plasma coloring works really nice with this mod!

!!! Warning: flashing swirling colors may trigger epileptic seizures !!!

Code: (Select All)

_Title "press spacebar for new color set"
' b+ mod of 2112 code 2025-11-08
' 2 Way swirls
Screen _NewImage(400, 400, 32)
_ScreenMove 320, 60
Dim Shared cN, pR, pG, pB
resetPlasma
stars = 360

Dim sr(stars + 1) As Integer 'radius of stars
Dim ss(stars + 1) As Integer 'step speed of stars
Dim sd(stars + 1) As Integer 'degrees of stars
Dim sx(stars + 1) As Single 'x position of stars
Dim sy(stars + 1) As Single 'y position of stars
Dim sc(stars + 1) As _Unsigned Long
Dim sxf, syf As Integer 'x,y final position of stars

Dim pi As Single
pi = 180 ' 3.14159

For i = 1 To stars
    ss(i) = 1 'step
    sr(i) = 180 - i '100'radius
    sd(i) = 180 / i 'degrees
    sx(i) = i * (360 / stars) 'x pos
    sy(i) = i * (360 / stars) 'y pos
    sc(i) = Plasma~&
Next i

Do
    Line (0, 0)-(400, 400), _RGB32(0, 0, 0, 40), BF
    If _KeyDown(32) Then
        resetPlasma
        For i = 1 To stars
            sc(i) = Plasma~&
        Next
    End If
    For i = 1 To stars
        sx(i) = sx(i) + ss(i): If sx(i) <= 0 Then sx(i) = 360 + sx(i)
        sy(i) = sy(i) + ss(i): If sy(i) <= 0 Then sy(i) = 360 + sy(i)

        sxf = Sin(pi * sx(i) / sd(i)) * (sr(i) / 1)
        syf = Cos(pi * sy(i) / sd(i)) * (sr(i) / 1) '+ sx(i)

        FC3 200 + sxf, 200 + syf, 2, sc(i)
    Next i
    _Display
    _Limit 60
Loop Until InKey$ = Chr$(27)

Function Plasma~& ()
    cN = cN + 1 ''Dim Shared cN, pR, pG, pB
    Plasma~& = _RGB32(127 + 127 * Sin(pR * cN), 127 + 127 * Sin(pG * cN), 127 + 127 * Sin(pB * cN))
End Function

Sub resetPlasma ()
    ''Dim Shared cN, pR, pG, pB
    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: cN = 0
End Sub

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&)
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

[Dav]

Nice mod @bplus.  Neat small plasma method you've worked out.  Here' one more SinCos pattern I was tinkering with last night.  Well, I needed something to spark my coding interest again, and I guess this did it.

- Dav

Code: (Select All)

'SinCosPlay2.bas

'Dav, NOV/2025



Screen _NewImage(Int(_DesktopHeight * 0.75), Int(_DesktopHeight * 0.75), 32)



Do

    Cls

    For a = 0 To 360 Step .3

        rad = a / 180 * _Pi

        r1 = 100 + Sin(rad * 3 + t) * 80 + Sin(rad * 5 + t * 1.2) * 50 + Sin(t * .5) * 125

        r2 = 50 + Cos(rad * 4 + t * 1.5) * 40 + Cos(rad * 6 + t * 1.3) * 30 + Sin(t * .5) * 75

        r3 = 70 + Sin(rad * 2 + t * .8) * 60 + Sin(rad * 7 + t * 1.4) * 40 + Sin(t * .5) * 50

        For s = 0 To 8

            sa = rad + s * (_Pi / 4.5)

            x1 = _Width / 2 + Cos(sa) * r1

            y1 = _Height / 2 + Sin(sa) * r1

            x2 = _Width / 2 + Cos(sa + .17) * r2

            y2 = _Height / 2 + Sin(sa + .17) * r2

            x3 = _Width / 2 + Cos(sa + .35) * r3

            y3 = _Height / 2 + Sin(sa + .35) * r3

            r = 128 + 127 * Sin(t + s)

            g = 128 + 127 * Sin(t + s + _Pi / 4)

            b = 128 + 127 * Sin(t + s + _Pi / 2)

            Line (x1, y1)-(x2, y2), _RGBA(r, g, b, 25)

            Line (x1, y1)-(x3, y3), _RGBA(r, g, b, 25)

        Next

    Next

    t = t + .1

    _Display

    _Limit 15

Loop

[bplus]

+1 @Dav another nice surprise!


Here is my code for 2nd snapshot of so called "Doyle" spiral.

Code: (Select All)

_Title "Doyle Spirals 2" ' as B+ ported from John T at LB 2025-11-04
Screen _NewImage(700, 700, 32)
_ScreenMove 300, 0
Color , _RGB32(128)
Cls
xc = 350: yc = 350

For angle = 0 To 359 Step 5
    radius = .1
    While radius < 340
        If angle Mod 10 = 0 Then
            x = radius * Cos(_D2R(angle)) ' Calculate X position
            y = radius * Sin(_D2R(angle)) ' Calculate Y position
            clr~& = _RGB32(55 + radius * 200 / 340, 0, 0)
        Else
            x = (radius * 1.05 * Cos(_D2R(angle))) ' Calculate X position
            y = (radius * 1.05 * Sin(_D2R(angle))) ' Calculate Y position
            clr~& = _RGB32(0, 0, 255 - radius * 240 / 340)
        End If
        FC3 xc + x, yc + y, Int(radius * .052) - 2, clr~&
        radius = radius * 1.1
    Wend
Next

angle = 0
restart:
radius = .1
clr~& = _RGB32(255, 255, 0)
While radius < 340
    r = Int(radius * .052) - 5
    If r < 1 Then r = 1
    x = radius * Cos(_D2R(angle)) ' Calculate X position
    y = radius * Sin(_D2R(angle)) ' Calculate Y position
    FC3 xc + x, yc + y, r, clr~&
    x = (radius * 1.05 * Cos(_D2R(angle + 5))) ' Calculate X position
    y = (radius * 1.05 * Sin(_D2R(angle + 5))) ' Calculate Y position
    FC3 xc + x, yc + y, r, clr~&
    angle = angle + 10
    radius = radius * 1.1
Wend
l = l + 1
angle = 0
angle = angle + l * 60
If l < 6 Then GoTo restart


angle = 0: l = 0
restart2:
radius = .1
clr~& = _RGB32(0, 255, 192)
While radius < 340
    r = Int(radius * .052) - 8
    If r < 1 Then r = 1
    x = radius * Cos(_D2R(angle)) ' Calculate X position
    y = radius * Sin(_D2R(angle)) ' Calculate Y position
    FC3 xc + x, yc + y, r, clr~&
    x = (radius * 1.05 * Cos(_D2R(angle - 5))) ' Calculate X position
    y = (radius * 1.05 * Sin(_D2R(angle - 5))) ' Calculate Y position
    FC3 xc + x, yc + y, r, clr~&
    angle = angle - 10
    radius = radius * 1.1
Wend
l = l + 1
angle = 0
angle = angle - l * 60
If l < 6 Then GoTo restart2
Sleep

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&)
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

Turns out this might not exactly fit the definition of Doyle spirals which is math model of plant growth discovered (or is it invented with math its hard to say) in ealy 1900's. It is circle packing 6 tangent circles around a center and infinitely expanding outward with logarithmic sequence of circle centers. I can not prove perfectly tangent nor perfectly logarithmic but I can say it looks pretty cool anyway! IMHO

I am offerring up code I had started this Challenge with because I think we've come up with more interesting Challenge - 

What can you do with Sin and Cos?

Quite a bit! Suddenly I am reminded once again of Mennonites "SineCube" another great example from QB Samples I mentioned recently in another post.