|
Post by tsh73 on Apr 14, 2018 10:11:54 GMT
In the Easter Egg thread I mentioned that So now I found a way: 'Rotating color 'tsh73, April 2018 nomainwin
desiredWidth = 600 desiredHeight = 600
gosub [ajustWindow] UpperLeftX = (DisplayWidth - WindowWidth)/2 UpperLeftY = (DisplayHeight - WindowHeight)/2
open "Colorful spirals" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down" #gr "fill darkgreen; flush" #gr "home; posxy cx cy" r=5 RR=0.85*cx
pi=acs(-1) for i=r to RR step 2*r l=2*pi*i n=l/(2*r) for a=0 to 2*pi step 2*pi/n 'c=i/RR/2 '0..1 red to red, 0..0.5 first half - light colors, up to cyan 'c=i/RR+a/(2*pi) 'single spiral 'c=i/RR+a/(2*pi)*2 'more c=i/RR+a/(2*pi)*3 'MORE!!! #gr "color ";rainbow$(c) #gr "backcolor ";rainbow$(c) x=cx+i*cos(a) y=cy+i*sin(a) #gr "place ";x;" ";y #gr "circlefilled ";r next next
#gr "flush" wait
[quit] timer 0 close #gr end
'--------------------------------------------- ' 0..1 into red-green-blue-red continuous colors function rainbow$(x) hi = int((x*6) mod 6)+ 5*(x<0) 'fixed to 0..5 f = (x*6) mod 1 + (x<0) 'frac, 0..1 q = (1-f) select case hi case 0 r = 1: g = f: b = 0 case 1 r = q: g = 1: b = 0 case 2 r = 0: g = 1: b = f case 3 r = 0: g = q: b = 1 case 4 r = f: g = 0: b = 1 case 5 r = 1: g = 0: b = q end select R = int(r*255) G = int(g*255) B = int(b*255) rainbow$= R;" ";G;" ";B end function
'------------------------------------------------- [ajustWindow] UpperLeftX = 20 UpperLeftY = 20 WindowWidth = 200 '100 seems to be too much - works different WindowHeight = 100 open "Ajusting..." for graphics_nsb_nf as #gr
#gr, "home ; down ; posxy x y" 'x, y give us width, height width = 2*x : height = 2*y close #gr
slackX = 200-width slackY = 100-height
WindowWidth = desiredWidth + slackX WindowHeight = desiredHeight + slackY
return
|
|
|
Post by B+ on Apr 14, 2018 15:14:48 GMT
Hi tsh73, here is my version: 'colorful spirals bplus 2018-04-14
'Warning DO NOT RUN IF FLASHING COLORS CAUSE EPILEPTIC SEIZURES
'Warning DO NOT RUN IF FLASHING COLORS CAUSE EPILEPTIC SEIZURES
'Warning DO NOT RUN IF FLASHING COLORS CAUSE EPILEPTIC SEIZURES
nomainwin global rrr, ggg, bbb, ccc global XMAX, YMAX, pi XMAX = 700 '< actual drawing space needed YMAX = 700 '< actual drawing space needed pi = acs(-1) WindowWidth = XMAX + 8 WindowHeight = YMAX + 32 UpperLeftX = 300 UpperLeftY = 40
open "Colorful spirals press any key for new pattern press q to quit" for graphics_nsb_nf as #gr #gr "setfocus" #gr "trapclose quit" #gr "when characterInput charIn" #gr "down" #gr "fill black; flush"
call setRGB cx = XMAX/2 : cy = YMAX/2 while 1 scan size = 1 radius = .2 angle = sangle while radius < 440 scan x = cos(angle) * radius y = sin(angle) * radius size = (radius^2*3.15)^.25 call changeRGB #gr "place ";cx + x;" ";cy + y #gr "circlefilled ";size angle = angle - .4 radius = radius + 1 wend #gr "flush" sangle = sangle + pi/18 wend wait
sub charIn h$, k$ if k$ = "q" then call quit h$ else ccc = 0 call setRGB #gr "fill black; flush" call pause 100 end if end sub
sub quit h$ close #gr end end sub
sub setRGB rrr = rnd(0)^2 : ggg = rnd(0)^2 : bbb = rnd(0)^2 end sub
sub changeRGB ccc = ccc + .5 c$ = 127 + 127 * sin(rrr * ccc);" ";127 + 127 * sin(ggg * ccc);" ";127 + 127 * sin(bbb * ccc) #gr "color ";c$ #gr "backcolor ";c$ end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
There are nearly infinite amount of color patterns that can be shown. These still shots don't do justice to program. Warning DO NOT RUN IF FLASHING COLORS CAUSE EPILEPTIC SEIZURES Append: I think it needs a memory clear or discard or something because it will crash after awhile (well once it did?). Attachments:
|
|
|
Post by tsh73 on Apr 15, 2018 7:53:47 GMT
Interesting. While it solves significantly different task, it looks good. I see it allow clearing stuff with a space bar It clearly shows that we see things not explicitly programmed. Like this We clearly see some dozens of spirals going to single center. But in the program there is ONLY ONE spiral. (EDIT lucky spacing does the trick)
|
|
|
Post by B+ on Apr 15, 2018 12:52:15 GMT
So what task did you want to do in your thread? This uncontrolled coloring method can be applied to your nearly concentric circles "spiral" and yes maybe even to the Easter Egg! Imagine all those colors moving over the egg! Append: Not easy getting spirals in concentric circles but here is something close: 'Rotating color Mod bplus 2018-04-15 'tsh73, April 2018
global rrr, ggg, bbb, ccc 'mod nomainwin
desiredWidth = 600 desiredHeight = 600
gosub [ajustWindow] UpperLeftX = (DisplayWidth - WindowWidth)/2 UpperLeftY = (DisplayHeight - WindowHeight)/2
open "Colorful concentric circles, press any key for new color pattern, press q to quit " for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "setfocus" #gr "when characterInput charIn" #gr "down" #gr "fill darkgreen; flush" #gr "home; posxy cx cy" r=5 RR=0.85*cx pi=acs(-1) call setRGB 'mod while 1 'mod whole new outer loop for moving colors scan
for i=r to RR step 2*r loopCnt = loopCnt + 1 'mod steps = 0 'mod scan l=2*pi*i n=l/(2*r) for a=0 to 2*pi step 2*pi/n steps = steps + 1 'mod ccc = loopCnt + steps 'mod scan 'c=i/RR/2 '0..1 red to red, 0..0.5 first half - light colors, up to cyan 'c=i/RR+a/(2*pi) 'single spiral 'c=i/RR+a/(2*pi)*2 'more call changeRGB 'mod x=cx+i*cos(a) y=cy+i*sin(a) #gr "place ";x;" ";y #gr "circlefilled ";r next next #gr "flush" wend wait
[quit] timer 0 close #gr end
sub charIn h$, k$ 'mod if k$ = "q" then goto [quit] else
'oh! now I know where the black center came from!!!!!!!!!!!!!!!!!!!!!!
ccc = 0 call setRGB #gr "fill black; flush" call pause 100
end if end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
sub setRGB 'mod rrr = rnd(0)^2 : ggg = rnd(0)^2 : bbb = rnd(0)^2 end sub
sub changeRGB 'mod 'ccc = ccc + .5 c$ = 127 + 127 * sin(rrr * ccc);" ";127 + 127 * sin(ggg * ccc);" ";127 + 127 * sin(bbb * ccc) #gr "color ";c$ #gr "backcolor ";c$ end sub
'------------------------------------------------- [ajustWindow] UpperLeftX = 20 UpperLeftY = 20 WindowWidth = 200 '100 seems to be too much - works different WindowHeight = 100 open "Ajusting..." for graphics_nsb_nf as #gr
#gr, "home ; down ; posxy x y" 'x, y give us width, height width = 2*x : height = 2*y close #gr
slackX = 200-width slackY = 100-height
WindowWidth = desiredWidth + slackX WindowHeight = desiredHeight + slackY
return
Attachments:
|
|
|
Post by tsh73 on Apr 15, 2018 21:21:21 GMT
I wanted smooth color change - like hue circle - going down the egg, and rotating in a process, producing swirls. So my first post would do that (if fitted on the egg that is ) After some thinking I've got general idea how to do it right (first post was really "it works somehow but I'm not sure"): 1. Let us see polar coordinates, ro and phi 2. Let us map hue to phi. We'll get straight color rays from the center 3. Now let us just shift hue with ro. It will start rotating. Nice thing is that (2) makes number and width of rays and (3) makes it rotate with any speed - and these things are pretty independent. 'another approach: start with radial bands, then rotate with r nomainwin open "Colorful spirals" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down" '#gr "fill white; flush" #gr "home; posxy cx cy" r=5 RR=130
pi=acs(-1)
nRainbows=2 'nRainbows=1 rotations =0.5 '1 mean full circle for i=r to RR step 2*r l=2*pi*i n=l/(2*r) for a=0 to 2*pi step 2*pi/n 'color depends on angle, smooth translation c=a/(2*pi)*nRainbows 'now just add rotation c=c+i/RR*rotations #gr "color ";rainbow$(c) #gr "backcolor ";rainbow$(c) x=cx+i*cos(a) y=cy+i*sin(a) #gr "place ";x;" ";y #gr "circlefilled ";r next next
#gr "flush" wait
[quit] timer 0 close #gr end
'--------------------------------------------- ' 0..1 into red-green-blue-red continuous colors function rainbow$(x) hi = int((x*6) mod 6)+ 5*(x<0) 'fixed to 0..5 f = (x*6) mod 1 + (x<0) 'frac, 0..1 q = (1-f) select case hi case 0 r = 1: g = f: b = 0 case 1 r = q: g = 1: b = 0 case 2 r = 0: g = 1: b = f case 3 r = 0: g = q: b = 1 case 4 r = f: g = 0: b = 1 case 5 r = 1: g = 0: b = q end select R = int(r*255) G = int(g*255) B = int(b*255) rainbow$= R;" ";G;" ";B end function
|
|
|
Post by B+ on Apr 15, 2018 21:34:14 GMT
I found some code for a sphere thanks to guy named figosdev at SmallBASIC forum. I managed to modify it (quite a bit without quite understanding the sphere part!) to rotate colors on sphere: So for your inspiration: 'Rotate colors on a sphere.txt for JB v2.0 bplus 2018-04-16 '2018-04-16 EDIT #1 Fix final circle drawn and add discard to clear memory
'from (extremely simplified) ' Double spiral.bas SmallBASIC 0.12.8 [B+=MGA] 2017-03-28 'from figosdev post at http://smallbasic.sourceforge.net/?q=node/1684#comment-1955 'translating fig to SmallBASIC for alittle cross pollination...
global rrr, ggg, bbb, ccc 'mod global XMAX, YMAX, pi XMAX = 600 '< actual drawing space needed YMAX = 600 '< actual drawing space needed pi = acs(-1) nomainwin WindowWidth = XMAX + 8 WindowHeight = YMAX + 32 UpperLeftX = 300 UpperLeftY = 40
open "Rotate colors on sphere press q to quit " for graphics_nsb_nf as #gr #gr "trapclose quit" #gr "setfocus" #gr "when characterInput charIn" #gr "down" #gr "fill black;flush" cx = 300 ww = 3.14159 / 2 'fix to return back to this after each run while 1 scan #gr "discard" 'fix to clear memory call setRGB w = ww 'fix for r = 490 to 300 step -.25 scan e = w - pi / 4 / (490 - 300) 'swap w, e tmp = e : e = w : w = tmp for p = -1 * pi to pi step pi / 144 scan e = int((cos(w) * 380) / 2) x = int(cos(p * 2) * e + cx) y = int(sin(p * 2) * e + r - 50) lc = lc + 1 if lc mod 90 = 0 then ccc = ccc + .2 call changeRGB #gr "place ";x;" ";y #gr "circlefilled ";12 end if next next '#gr "color white" '#gr "backcolor black" '#gr "place ";x-7;" ";y+5;";|";"B+" 'make new JB avatar #gr "flush" call pause 5000 wend wait
sub quit h$ close #gr end end sub
sub charIn h$, k$ 'mod if k$ = "q" then call quit h$ end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
sub setRGB 'mod rrr = rnd(0)^2 : ggg = rnd(0)^2 : bbb = rnd(0)^2 end sub
sub changeRGB 'mod c$ = 127 + 127 * sin(rrr * ccc);" ";127 + 127 * sin(ggg * ccc);" ";127 + 127 * sin(bbb * ccc) #gr "color ";c$ #gr "backcolor ";c$ end sub
2018-04-16 EDIT #1 a couple of fixes: add discard to clear memory and reset a new set of drawing back to ww otherwise it wonders off center. Attachments:
|
|
|
Post by tsh73 on Apr 15, 2018 22:11:57 GMT
Really like that sea-shell pattern. Just keep pressing SPACE to see more...
|
|