Kaleidoscope
#4
That reminds me of Mennonite's Rotan:
Code: (Select All)
'
'rotan / 2008 mennonite
'public domain
'as of 2017:
'license: creative commons cc0 1.0 (public domain)
'http://creativecommons.org/publicdomain/zero/1.0/

Screen 12


'mods to run in SmallBASIC 2017-05-13
'mods to run in QB64 2017-05-14
Do
    For y2 = 200 To 1 Step -10
        c = c + .04
        For d = 1 To 0 Step -1
            For a = -3.14 + c To 3.14 + c Step .125 / 8
                r = 40 + Tan((a + c) * 7) * 4
                x = r * Cos(a)
                y = r * Sin(a)
                Circle (x + 320, y + 240), 4, 1
                r = 40 + Tan((a + c) * 7) * 4
                x = r * Cos(a)
                y = r * Sin(a)
                Circle (x + 320, y + 240), 2, 11 * d
            Next a
            t = Timer
            If d = 1 Then
                Do 'repeat 'from
                    If InKey$ = Chr$(27) Then 'remove $ on functions
                        End
                    End If
                Loop Until t > Timer + .125 / 4 Or t < Timer - .125 / 4
                'WAIT &H3DA, 8
            End If
        Next d
    Next
Loop

Of which, Walter did a nice mod:
Code: (Select All)
'
'rotan / 2008 mennonite
'public domain
'as of 2017:
'license: creative commons cc0 1.0 (public domain)
'http://creativecommons.org/publicdomain/zero/1.0/
'
'mods to run in SmallBASIC 2017-05-13
'mods to run in QB64 2017-05-14
'Modified By: The Joyful Programmer - Waltersmind - 05/15/17


Type Circles
    Red As Single
    Green As Single
    Blue As Single
    RedChange As Single
    GreenChange As Single
    BlueChange As Single
End Type

Dim CenterX As _Unsigned Integer
Dim CenterY As _Unsigned Integer
Dim LStep As _Float
Dim C As _Float
Dim Angle As _Float
Dim Radius As _Float
Dim DistanceFromCenter As _Float
Dim Colr1(20) As Circles
Dim Colr2(UBound(Colr1)) As Circles

Screen _NewImage(800, 600, 32)
_Title "Rotan By: MN - Modified By: The Joyful Programmer - Waltersmind"

CenterX = _Width(0) / 2
CenterY = _Height(0) / 2

LStep = .125 / 8

For i = 0 To UBound(Colr1)
    Colr1(i).Red = Rnd * 256
    Colr1(i).Green = Rnd * 256
    Colr1(i).Blue = Rnd * 256
    Colr1(i).RedChange = Rnd * 3 - 1.5
    Colr1(i).GreenChange = Rnd * 3 - 1.5
    Colr1(i).BlueChange = Rnd * 3 - 1.5
    Colr2(i).Red = Rnd * 256
    Colr2(i).Green = Rnd * 256
    Colr2(i).Blue = Rnd * 256
    Colr2(i).RedChange = Rnd * 3 - 1.5
    Colr2(i).GreenChange = Rnd * 3 - 1.5
    Colr2(i).BlueChange = Rnd * 3 - 1.5
Next


Do
    _Limit 30

    Line (0, 0)-(_Width(0) - 1, _Height(0) - 1), _RGBA(0, 0, 0, 100), BF

    For NumberOfTimes = 0 To UBound(Colr1)

        C = C + .01

        For Angle = -_Pi + C To _Pi + C Step LStep

            Radius = 40 + Tan((Angle + C) * 1.5) * 4
            x = Radius * Cos(Angle)
            y = Radius * Sin(Angle)

            DistanceFromCenter = Sqr((CenterX - (CenterX + x)) * (CenterX - (CenterX + x)) + (CenterY - (CenterY + y)) * (CenterY - (CenterY + y))) / 40 'SQR(ABS(Radius)) / 50

            For CRadius = DistanceFromCenter To DistanceFromCenter + 3
                Circle (x + CenterX, y + CenterY), CRadius, _RGB(Colr1(NumberOfTimes).Red, Colr1(NumberOfTimes).Green, Colr1(NumberOfTimes).Blue)
            Next

            For CRadius = 1 To DistanceFromCenter
                Circle (x + CenterX, y + CenterY), CRadius, _RGB(Colr2(NumberOfTimes).Red, Colr2(NumberOfTimes).Green, Colr2(NumberOfTimes).Blue)
            Next

        Next

        Colr1(NumberOfTimes).Red = (Colr1(NumberOfTimes).Red + Colr1(NumberOfTimes).RedChange) Mod 256
        Colr1(NumberOfTimes).Green = (Colr1(NumberOfTimes).Green + Colr1(NumberOfTimes).GreenChange) Mod 256
        Colr1(NumberOfTimes).Blue = (Colr1(NumberOfTimes).Blue + Colr1(NumberOfTimes).BlueChange) Mod 256

        Colr2(NumberOfTimes).Red = (Colr2(NumberOfTimes).Red + Colr2(NumberOfTimes).RedChange) Mod 256
        Colr2(NumberOfTimes).Green = (Colr2(NumberOfTimes).Green + Colr2(NumberOfTimes).GreenChange) Mod 256
        Colr2(NumberOfTimes).Blue = (Colr2(NumberOfTimes).Blue + Colr2(NumberOfTimes).BlueChange) Mod 256

    Next

    _Display

    k& = _KeyHit
    If k& = 27 Or k& = 32 Then System

Loop
b = b + ...
Reply


Messages In This Thread
Kaleidoscope - by SierraKen - 05-18-2022, 07:58 PM
RE: Kaleidoscope - by Rick3137 - 05-18-2022, 09:45 PM
RE: Kaleidoscope - by SierraKen - 05-19-2022, 12:04 AM
RE: Kaleidoscope - by bplus - 05-19-2022, 03:39 PM
RE: Kaleidoscope - by SierraKen - 05-19-2022, 06:33 PM
RE: Kaleidoscope - by bplus - 05-25-2022, 12:58 AM
RE: Kaleidoscope - by Rick3137 - 05-28-2022, 01:29 PM
RE: Kaleidoscope - by SierraKen - 05-29-2022, 12:04 AM
RE: Kaleidoscope - by Rick3137 - 05-29-2022, 04:12 PM



Users browsing this thread: 2 Guest(s)