|
Post by tsh73 on Jan 25, 2020 17:16:14 GMT
Looks kind of cool. Just tried make it look stripey and 3d.
'shell-like thing 'tsh73 Jan 2020 nomainwin global R, G, B pi=acs(-1)
open "the shell?" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down; home; posxy cx cy" cx=cx+20 cy=cy+20
#gr "size 2" 'for a = 0.001 to 18 step 0.01 a = 1 c=0 while a <18 scan r=a*10 a=a+1/r c=c+1/r/rnd(0) x=cx+a*10*cos(a) y=cy+a*10*sin(a) a0=a-2*pi x0=cx+a0*10*cos(a0) y0=cy+a0*10*sin(a0) 'print x, y #gr "set ";x;" ";y '#gr "color ";rainbow$(c) '#gr "line ";x;" ";y;" ";x0;" ";y0 dummy$=rainbow$(c) call colline x, y, x0, y0 'next wend #gr "flush"
wait
[quit] close #gr end
sub colline x, y, x0, y0 'uses global R G B from rainbow$ ' #gr "color ";R;" ";G;" ";B ' #gr "line ";x;" ";y;" ";x0;" ";y0 ': to darken edges of line, to make it look round n=30 #gr "place ";x0;" ";y0 for i = 1 to n x1=x0+(x-x0)/n*i y1=y0+(y-y0)/n*i ' 0->0, n/2->1, n->0 a=1-((n/2-i+1/2)/(n/2))^2 #gr "color ";int(a*R);" ";int(a*G);" ";int(a*B) #gr "goto ";x1;" ";y1 next end sub
'--------------------------------------------- ' 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 tenochtitlanuk on Jan 25, 2020 17:23:19 GMT
Like! Modern-day nautilus- or, as a fossil, an ammonite!
|
|
|
Post by tsh73 on Jan 25, 2020 17:49:35 GMT
I fixed code in first post (increased shades from 10 to 30) Here's result How I think it better grow wider as it unwinds...
|
|
|
Post by tsh73 on Jan 25, 2020 18:07:31 GMT
Ok, grow wider 'shell-like thing 'tsh73 Jan 2020 nomainwin global R, G, B pi=acs(-1)
open "the shell?" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down; home; posxy cx cy" cx=cx+20 cy=cy+20
#gr "size 2" 'for a = 0.001 to 18 step 0.01 a = 1 c=0 rr=2.5 while a <18 scan r=a*10 a=a+1/r c=c+1/r/rnd(0) r1=a^1.5*rr x=cx+r1*cos(a) y=cy+r1*sin(a) a0=a-2*pi r2=1 if a0>0 then r2=a0^1.5*rr x0=cx+r2*cos(a0) y0=cy+r2*sin(a0) 'print x, y #gr "set ";x;" ";y '#gr "color ";rainbow$(c) '#gr "line ";x;" ";y;" ";x0;" ";y0 dummy$=rainbow$(c) call colline x, y, x0, y0 'next wend #gr "flush"
wait
[quit] close #gr end
sub colline x, y, x0, y0 'uses global R G B from rainbow$ ' #gr "color ";R;" ";G;" ";B ' #gr "line ";x;" ";y;" ";x0;" ";y0 ': to darken edges of line, to make it look round n=30 #gr "place ";x0;" ";y0 for i = 1 to n x1=x0+(x-x0)/n*i y1=y0+(y-y0)/n*i ' 0->0, n/2->1, n->0 a=1-((n/2-i+1/2)/(n/2))^2 #gr "color ";int(a*R);" ";int(a*G);" ";int(a*B) #gr "goto ";x1;" ";y1 next end sub
'--------------------------------------------- ' 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 Jan 26, 2020 1:07:35 GMT
Oh I like wider, here is shell of another color: 'shell-like thing 'tsh73 Jan 2020 mod b+ a shell of another color nomainwin global R, G, B,PN pi=acs(-1)
open "shell of another color" for graphics_nsb_nf as #gr #gr "trapclose [quit]" #gr "down; home; posxy cx cy" cx=cx+20 cy=cy+20 #gr "size 2" while 1 scan R = RND(0)^2 : G= RND(0)^2 : B = RND(0)^2 a = 1 c=0 rr=2.5 while a <18 scan r=a*10 a=a+1/r c=c+1/r/rnd(0) r1=a^1.5*rr x=cx+r1*cos(a) y=cy+r1*sin(a) a0=a-2*pi r2=1 if a0>0 then r2=a0^1.5*rr x0=cx+r2*cos(a0) y0=cy+r2*sin(a0) #gr "set ";x;" ";y PN = PN + .5 call colline x, y, x0, y0 wend #gr "flush" call pause 2000 wend
wait
[quit] close #gr end
sub colline x, y, x0, y0 'uses global R G B from rainbow$ ' #gr "color ";R;" ";G;" ";B ' #gr "line ";x;" ";y;" ";x0;" ";y0 ': to darken edges of line, to make it look round n=30 #gr "place ";x0;" ";y0 for i = 1 to n x1=x0+(x-x0)/n*i y1=y0+(y-y0)/n*i ' 0->0, n/2->1, n->0 a=1-((n/2-i+1/2)/(n/2))^2 #gr "color ";a*int(127 + 127 * sin(R*PN));" ";a*int(127 + 127 * sin(G*PN));" ";a*int(127 + 127*sin(B* PN)) #gr "goto ";x1;" ";y1 next end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
|
|
|
Post by tsh73 on Jan 26, 2020 10:04:55 GMT
Thanks B+ your colors looks better Though you just leaved it running, so there is a lot pictures to pick from But after while I see that it's too regular - all stripes of the same size I tried changing PN = PN + .5 to PN=PN+10/r/rnd(0) , and it looks less regular, but almost as parrot-like like mine
|
|
|
Post by B+ on Jan 26, 2020 17:03:54 GMT
Yes! I noticed that too! WTH??? RND strikes again???
Man! have I got a story with your code tsh73. I tried to translate it to QB64 and it just wouldn't work the same, I think it's pen size? All I know is it was "liney" with interference patterns galore, even when I used filled circles to draw the lines like using a wide radius pen. BTW, I discovered your code left a junkyard of unused variables and code lines. I bet it would be much shorter if you cleaned it up some.
Anyway, for the QB64 version I ended up starting from scratch and it turned out to be a very different way to go about things except for what I call your "shader" formula. Man that is a gem and I plan on applying anywhere I need a 3D pipe look.
Anyway since you worked on this code you might appreciate most seeing how my approach went of all who might be looking in, so here it is translated back to JB,
'shell 2 of another color.txt b+2020-01-26 a rewrite of code 'inspired by "shell-like thing" by tsh73 Jan 2020 at JB
WindowWidth = 600 + 8 : WindowHeight = 600 + 32 nomainwin pi=acs(-1) open "shell of another color too" for graphics_nsb_nf as #gr #gr "trapclose quit" #gr "down; home; posxy cx cy" cx = 300 : cy = 300 #gr "size 4" #gr "fill Black" DIM x(1600), y(1600) FOR a = 0 TO pi * 8 STEP pi * 2 / 400 ' load x, y arrays x(i) = cx + ra * COS(a) : y(i) = cy + ra * SIN(a) dr = dr + 1 / 4800 ra = ra + dr i = i + 1 NEXT WHILE 1 R = RND(0)^2: G = RND(0)^2: B = RND(0)^2: PN = 0 FOR i = 0 TO 399 ' cheat to fill hole cost 13 extra lines scan dx = x(i + 400) - x(i): dy = y(i + 400) - y(i) dist = SQR(dx * dx + dy * dy) dx = dx / dist: dy = dy / dist PN = PN + .5 FOR j = 0 TO dist scan a = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2 : if a < 0 then a = 0 #gr "color ";int(a * (127 + 127 * sin(R*PN)));" ";int(a * (127 + 127 * sin(G*PN)));" ";int(a * (127 + 127*sin(B* PN))) #gr "set ";cx + j * dx;" ";cy + j * dy NEXT NEXT PN = PN - 200 FOR i = 0 TO 1199 scan dx = x(i + 400) - x(i): dy = y(i + 400) - y(i) dist = SQR(dx * dx + dy * dy) dx = dx / dist: dy = dy / dist PN = PN + .5 FOR j = 0 TO dist scan a = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2 : if a < 0 then a = 0 #gr "color ";int(a * (127 + 127 * sin(R*PN)));" ";int(a * (127 + 127 * sin(G*PN)));" ";int(a * (127 + 127*sin(B* PN))) #gr "set ";x(i) + j * dx;" ";y(i) + j * dy NEXT NEXT call pause 2000 WEND wait sub quit H$ close #gr : end end sub sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
and Yes again what's with RND??? that the color patterns start running in a small range of color sets that should be way more variable?
Maybe try the casco method on this line:
R = RND(0)^2: G = RND(0)^2: B = RND(0)^2: PN = 0
|
|
|
Post by tsh73 on Jan 26, 2020 17:59:02 GMT
BTW, I discovered your code left a junkyard of unused variables and code lines. Huh? It can't be that bad. I just reviewed last program - it looks like all (!) variables are used. Just recalled old line from DragonLance, Google happen to found it for me:
|
|
|
Post by tsh73 on Jan 26, 2020 18:36:11 GMT
Your code is different but I understand it. I think My code was evolutionally written. "So we have Archimedes spiral withing FOR loop from 0 to 15... wait, 18 looks better" "so previous point ought to be at a-2*pi" "connect them with colored line, I had that rainbow$ function..." "make it look 3d? 10 segments? 30 looks better" "so there is no point in using same small step in center and farther apart - let's change to WHILE" "so I thing it should grow. Try to use something like a^1.1... have to make initial radius smaller... fiddle fiddle - ends up a^1.5, initial rr is 2.5" P.S. My kid just said: "Oh! someone fixed colors! I told you!" EDIT another line "Cool. I could stare on this forever"
|
|
|
Post by B+ on Jan 26, 2020 18:52:58 GMT
Hi tsh73 Opps, sorry, it was I who didn't need c stuff (face goes red). OK no 2 dragons, just one tiny mosquito, I am not seeing need for the set x, y in main loop (he says, grasping at straws). Maybe the old commented out code added to junkyard likeness? maybe a little? Now that I agree your code is nearly perfect maybe you can take a look and see what happens when that first FOR block in my code main loop is not run. I could not figure how to get rid of that hole except with that block.
|
|
|
Post by tsh73 on Jan 26, 2020 19:43:54 GMT
Huh we just did that, you commented it so provoking I have no idea yet, may be I'll look at it again later
|
|
|
Post by B+ on Jan 27, 2020 16:05:03 GMT
OK I figured out a way to remove the extra 14 lines of code to fill the 1/4 hole in center and save a little time along the way!
'shell 2 of another color.txt b+2020-01-26 a rewrite of code 'inspired by "shell-like thing" by tsh73 Jan 2020 at JB ' 2020-01-27 remove extra FOR block (14 lines of code) and extend i back to fill .25 hole WindowWidth = 600 + 8 : WindowHeight = 600 + 32 nomainwin pi=acs(-1) open "shell of another color too" for graphics_nsb_nf as #gr #gr "trapclose quit" #gr "down; home; posxy cx cy" cx = 300 : cy = 300 #gr "size 4" #gr "fill Black" DIM x(1600), y(1600) FOR a = 0 TO pi * 8 STEP pi * 2 / 400 ' load x, y arrays x(i) = cx + ra * COS(a) : y(i) = cy + ra * SIN(a) dr = dr + 1 / 4800 : ra = ra + dr : i = i + 1 NEXT WHILE 1 R = RND(0)^2: G = RND(0)^2: B = RND(0)^2: PN = 0 FOR i = -100 TO 1199 scan IF i < 0 THEN dx = x(i + 800) - x(i + 400): dy = y(i + 800) - y(i + 400) ELSE dx = x(i + 400) - x(i): dy = y(i + 400) - y(i) dist = SQR(dx * dx + dy * dy) dx = dx / dist: dy = dy / dist PN = PN + .5 FOR j = 0 TO dist scan a = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2 : if a < 0 then a = 0 #gr "color ";int(a * (127 + 127 * sin(R*PN)));" ";int(a * (127 + 127 * sin(G*PN)));" ";int(a * (127 + 127*sin(B* PN))) if i < 0 then #gr "set ";cx + j * dx;" ";cy + j * dy else #gr "set ";x(i) + j * dx;" ";y(i) + j * dy NEXT NEXT call pause 2000 WEND wait sub quit H$ close #gr : end end sub sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
|
|
|
Post by tsh73 on Jan 27, 2020 20:23:57 GMT
Lol that was my initial attempt, when I used FOR loop Just start negative
But - it ges the job done
|
|
|
Post by B+ on Jan 27, 2020 20:54:52 GMT
I am obsessed, maybe it's the eye candy, here is a bigger and better version that automatically solves the hole problem without hack, plus the colors seem to change better between drawings, maybe it's just RND(0) luck! 'shell of another color 3 .txt b+2020-01-26 a rewrite of code 'inspired by "shell-like thing" by tsh73 Jan 2020 at JB ' 2020-01-27 remove extra FOR block (14 lines of code) and extend i back to fill .25 hole ' 2020-01-27 made shell expand bigger faster, fixed color setting, this fixed hole problem WindowWidth = 660 + 8 : WindowHeight = 660 + 32 nomainwin pi=acs(-1) open "shell of another color 3" for graphics_nsb_nf as #gr #gr "trapclose quit" #gr "down; home; posxy cx cy" #gr "fill Black" cx = 340 : cy = 390 DIM x(1600), y(1600) FOR a = 0 TO pi * 8 STEP pi * 2 / 400 ' load x, y arrays x(i) = cx + ra * COS(a) : y(i) = cy + ra * SIN(a) dr = dr + 1 / 1700 : ra = ra + dr^2 : i = i + 1 NEXT WHILE 1 R = RND(0)^2: G = RND(0)^2: B = RND(0)^2: PN = 0 #gr "size 2" FOR i = 0 TO 1139 scan dx = x(i + 400) - x(i): dy = y(i + 400) - y(i) dist = SQR(dx * dx + dy * dy) : dx = dx / dist: dy = dy / dist : PN = PN + .73 if i > 460 then #gr "size 3" if i > 560 then #gr "size 4" if i > 940 then #gr "size 5" if i > 1040 then #gr "size 7" FOR j = 0 TO dist scan a = 1 - ((dist / 2 - j + 1 / 2) / (dist / 2)) ^ 2 : if a < 0 then a = 0 #gr "color ";int(a * (127 + 127 * sin(R*PN)));" ";int(a * (127 + 127 * sin(G*PN)));" ";int(a * (127 + 127*sin(B* PN))) #gr "set ";x(i) + j * dx;" ";y(i) + j * dy NEXT NEXT call pause 2000 WEND wait sub quit H$ close #gr : end end sub sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
Attachments:
|
|
|
Post by B+ on Jan 27, 2020 21:02:23 GMT
Hey doesn't this look like evolution?
|
|