Kaleidoscope

[SierraKen]

Possibly the simplest kaleidoscope we have all seen, but I think it came out pretty neat. I was experimenting with circles and came across this. The longer you watch it, the cooler it looks in my opinion. What do you all think? 24 lines of code. lol 

Code: (Select All)

'Kaleidoscope by SierraKen
'May 18, 2022
Screen _NewImage(800, 800, 32)
_Title "Kaleidoscope by SierraKen"
Randomize Timer
cc = 1
Do
    _Limit 25
    If c <> 0 Then cc = c
    c = Rnd * 360
    If c < cc Then
        s = -.25
    Else
        s = .25
    End If
    cl1 = Int(Rnd * 200) + 1
    cl2 = Int(Rnd * 200) + 1
    cl3 = Int(Rnd * 200) + 1
    For t = cc To c Step s
        x = (Sin(t) * t) + 400
        y = (Cos(t) * t) + 400
        Circle (x, y), 2, _RGB32(cl1, cl2, cl3)
    Next t
Loop Until InKey$ = Chr$(27)

[Rick3137]

Nice work, Ken

This works fine with my Windows11.

[SierraKen]

Nice work, Ken

This works fine with my Windows11.

Thanks Rick . Am glad it does.

[bplus]

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

[SierraKen]

Awesome B+. Reminds me of RotoZoom, which I tried with this but I didn't want to wear out my computer on every loop with FREEIMAGE and COPYIMAGE.

[bplus]

I took the Challenge of "Kaleidoscope" to Proggies. Came out pretty nice if I say so myself.

[Rick3137]

You all, got me inspired.

 I like computer art. I don't have to be a professional programmer to do it.

Code: (Select All)

Screen _NewImage(1400, 850, 256)
_ScreenMove -10, -40


_Title "Use This As A Template....  No CopyRight "
setupcolors
centerx = 600
centery = 400
offset1 = 150
clr1 = 1: clr2 = 3: clr3 = 6

For t = 1 To 100 Step .1
    clr1 = clr1 + 1
    If clr1 > 23 Then clr1 = 1

    x = (Sin(t) * t) + centerx
    y = (Cos(t) * t) + centery
    Circle (x, y), 10, clr1

Next
_Display

For t = 1 To 400 Step .1
    clr2 = clr2 + 1
    If clr2 > 23 Then clr2 = 2
    x = (Sin(t) * t) + centerx
    y = (Cos(t) * t) + centery
    Circle (x, y), 10, clr2

Next
_Display

For t = 1 To 100 Step .1
    clr3 = clr3 + 1
    If clr3 > 23 Then clr3 = 6
    x = (Sin(t) * t) + centerx - offset1
    y = (Cos(t) * t) + centery + offset1
    Circle (x, y), 10, clr3

    x = (Sin(t) * t) + centerx + offset1
    y = (Cos(t) * t) + centery - offset1
    Circle (x, y), 10, clr3

    x = (Sin(t) * t) + centerx - offset1
    y = (Cos(t) * t) + centery - offset1
    Circle (x, y), 10, clr3

    x = (Sin(t) * t) + centerx + offset1
    y = (Cos(t) * t) + centery + offset1
    Circle (x, y), 10, clr3


Next
_Display

Do

Loop Until InKey$ = Chr$(27)

Sub setupcolors ()

    _PaletteColor 0, _RGB32(0, 0, 0) ' black
    _PaletteColor 1, _RGB32(255, 0, 0) ' red.
    _PaletteColor 2, _RGB32(0, 255, 0) ' green
    _PaletteColor 3, _RGB32(0, 0, 150) ' dark blue
    _PaletteColor 4, _RGB32(50, 180, 0) ' yellow green
    _PaletteColor 5, _RGB32(255, 255, 0) ' yellow
    _PaletteColor 6, _RGB32(0, 150, 150) ' blue green
    _PaletteColor 7, _RGB32(255, 0, 255) ' violet
    _PaletteColor 8, _RGB32(0, 150, 230) '   greenish blue
    _PaletteColor 9, _RGB32(0, 150, 100) '     bluish green
    _PaletteColor 10, _RGB32(200, 200, 255) '   bluish white
    _PaletteColor 11, _RGB32(0, 0, 80) 'very dark blue
    _PaletteColor 12, _RGB32(255, 255, 255) '   white
    _PaletteColor 13, _RGB32(0, 0, 255) ' blue
    _PaletteColor 14, _RGB32(0, 0, 180) ' blue2
    _PaletteColor 15, _RGB32(0, 0, 90) ' blue3
    _PaletteColor 16, _RGB32(180, 0, 0) ' red2
    _PaletteColor 17, _RGB32(90, 0, 0) ' red3
    _PaletteColor 18, _RGB32(0, 180, 0) ' green2
    _PaletteColor 19, _RGB32(0, 90, 0) ' green3
    _PaletteColor 20, _RGB32(180, 0, 180) ' violet2
    _PaletteColor 21, _RGB32(90, 0, 90) ' violet3
    _PaletteColor 22, _RGB32(0, 180, 180) ' bluegreen2
    _PaletteColor 23, _RGB32(0, 90, 90) ' bluegreen3


End Sub

[SierraKen]

That's really cool artwork Rick! I don't know much about _PaletteColor but it looks interesting.

[Rick3137]

That's really cool artwork Rick! I don't know much about _PaletteColor but it looks interesting.

    Thanks Ken, I hope to do some more of those.

    If you want to do a quick mod of my code, I don't mind. It's just a mental exercise to me.