+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Kaleidoscope (/showthread.php?tid=432)
Kaleidoscope - SierraKen - 05-18-2022
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)RE: Kaleidoscope - Rick3137 - 05-18-2022
Nice work, Ken
This works fine with my Windows11.
RE: Kaleidoscope - SierraKen - 05-19-2022
(05-18-2022, 09:45 PM)Rick3137 Wrote: Nice work, Ken
This works fine with my Windows11.
Thanks Rick
. Am glad it does.
RE: Kaleidoscope - bplus - 05-19-2022
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
LoopOf 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
LoopRE: Kaleidoscope - SierraKen - 05-19-2022
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.
RE: Kaleidoscope - bplus - 05-25-2022
I took the Challenge of "Kaleidoscope" to Proggies. Came out pretty nice if I say so myself.
RE: Kaleidoscope - Rick3137 - 05-28-2022
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 SubRE: Kaleidoscope - SierraKen - 05-29-2022
That's really cool artwork Rick! I don't know much about _PaletteColor but it looks interesting.
RE: Kaleidoscope - Rick3137 - 05-29-2022
(05-29-2022, 12:04 AM)SierraKen Wrote: 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.