|
Torus
Mar 11, 2024 13:52:00 GMT
Post by Rod on Mar 11, 2024 13:52:00 GMT
How do we draw a proper torus? Not like this, any code about?
nomainwin
WindowWidth = 600 WindowHeight = 700 graphicbox #1.gb 45,20,500,500
open "Lissajous" for window as #1 #1, "trapclose [quit]" #1.gb "down ; fill 0 64 0" #1.gb "flush one" #1.gb "color 0 182 0"
vol1=100 vol2=100 vol3=20 phase1=0 phase2=0 phase3=0 midX=250 midY=250 rad=57.29577951
timer 100, [drawit] wait
[drawit] start=0 #1.gb "discard ; redraw one" for n= 0 to 359 x=midX-(vol1*sin(phase1/rad)) y=midY-(vol2*cos(phase2/rad)) if start=1 then #1.gb "line ";oldX;" ";oldY;" ";x;" ";y #1.gb "set ";x-(vol3*sin(phase3/rad));" ";y-(vol3*cos(phase3/rad)) else start=1 #1.gb "set ";x;" ";y end if oldX=x oldY=y phase1=phase1+1 if phase1>359 then phase1=phase1-359 phase2=phase2+1 if phase2>359 then phase2=phase2-360 phase3=phase3+24 if phase3>359 then phase3=phase3-360
next wait
[quit] timer 0 close #1 end
|
|
|
Torus
Mar 11, 2024 15:03:02 GMT
Post by tsh73 on Mar 11, 2024 15:03:02 GMT
I see 4 ways of doing this. All require more work to actually get something. 1) There was Microsoft QBASIC code demo Here it is at QB64 site qb64.com/samples/torus-demo/2) Like one could draw "faked" 3d sphere (using (x,y) coordinates to calculate brighness), probably something like this could be done with a thorus 3) There was 3d engine posted here what draw mirror sphere Spheres was combined to produce mirror egg I guess they could be combined to produce thorus 4) LB could use OPEN GL You still create stuff from shapes (triangles or quads), but it will do 3d (hide surfaces) for you. Search for "donut" on LB forum brought me some Bluatigro code - I did not run it, may be to draws donuts? + more 5) funny thing I just rememebered. Once I posted 3d easter egg and hiding surfaces was obtained by 1) drawing balls (: like big dots) instead of triangles 2) drawing it back to front 6) I did some 3d spinning donut (translation from Python). It was in text mode, but it got a math. Cannot find but it was posted on JB and LB. What exactly do you want?
|
|
|
Torus
Mar 11, 2024 15:32:10 GMT
Post by plus on Mar 11, 2024 15:32:10 GMT
How to play the Game of Life on a torus:
Simply use mod width for x and mod y for height when counting neighbor cells.
Sorry, it draws not a donut but the topology is correct.
b = b + ...
|
|
|
Torus
Mar 11, 2024 18:16:55 GMT
Rod likes this
Post by tsh73 on Mar 11, 2024 18:16:55 GMT
So, along with (3) Takes pretty long (egg had 50 spheres, but for thorus I had to increase that number) Based off a program titled rayTrace b+ mod tsh73 egg and applied more brute force ;) 'https://retrobasic.allbasic.info/index.php?topic=721.0 'converting to JB. Tsh73 Feb 2022
desiredWidth = 320 desiredHeight = 200 'desiredWidth = 640 'desiredHeight = 480 gosub [ajustWindow] UpperLeftX = 1 UpperLeftY = 1
open "rayTrace b+/tsh73 donut" for graphics_nsb as #gr #gr, "trapclose [quit]" #gr, "home ; down ; posxy x y" #gr, "fill white" 'x, y give us width, height scrw = 2*x : scrh = 2*y
' 10 PAPER 0: INK 15: CLS: dim palette$(255) gosub [initQBcolors] for i = 0 to 15: palette$(i)=qb$(i):next ' palette 16,255,255,255: palette$(16)="255 255 255" ' palette 32,0,192,255: palette$(32)="0 192 255" ' palette 255,0,0,192: palette$(255)="0 0 192" ' rainbow 16 to 32: call rainbow 16, 32 ' rainbow 32 to 255 call rainbow 32, 255
read spheres spheres=250 DIM c(spheres,3),r(spheres),q(spheres),cl(4) w=scrw/2:h=scrh/2:s=0 cl(1)=6:cl(2)=1 cl(3)=cl(1)+8:cl(4)=cl(2)+8 pi = acs(-1) FOR k=1 TO spheres 'READ c1,c2,c3,r 'left. 0.25 .right, -height, depth, r a=2*pi*(k-1)/spheres c1=0.25+0.3*cos(a) c2=0-(0.5+0.3*sin(a)) c3=1.5 r=0.15 c(k,1)=c1:c(k,2)=c2:c(k,3)=c3 r(k)=r:q(k)=r*r print c1,c2,c3,r NEXT k data 2 data 0.25,-0.20,1.5,0.15 data 0.25,-0.8,1.5,0.15
t0=time$("ms") 'main loop start '#gr "size 2" FOR i=1 TO scrh 'step 2 print , i FOR j=0 TO scrw-1 'step 2 SCAN 'so we could break it x=0.3:y=-0.5:z=0:ba=3 dx=j-w:dy=h-i:dz=(scrh/480)*600 dd=dx*dx+dy*dy+dz*dz [recurs] n=0-(y>=0 OR dy<=0) IF n=0 THEN s=0-y/dy FOR k=1 TO spheres px=c(k,1)-x:py=c(k,2)-y:pz=c(k,3)-z pp=px*px+py*py+pz*pz sc=px*dx+py*dy+pz*dz IF sc<=0 THEN GOTO [continueK] bb=sc*sc/dd aa=q(k)-pp+bb IF aa<=0 THEN GOTO [continueK] sc=(SQR (bb)-SQR (aa))/SQR (dd) IF sc<s OR n<0 THEN n=k:s=sc [continueK] NEXT k
IF n<0 THEN 'plot ink 16+(dy*dy/dd)*240;j,scrh-i c = int(16+(dy*dy/dd)*240) '#gr "color ";c;" ";c;" ";c if lastCol<>c then 'prevent extra color switching - JB speed-up #gr "color ";palette$(c) lastCol=c end if #gr "set ";j;" ";scrh-i goto [continueJ] end if dx=dx*s:dy=dy*s:dz=dz*s:dd=dd*s*s x=x+dx:y=y+dy:z=z+dz IF n<>0 THEN nx=x-c(n,1):ny=y-c(n,2):nz=z-c(n,3) nn=nx*nx+ny*ny+nz*nz l=2*(dx*nx+dy*ny+dz*nz)/nn dx=dx-nx*l:dy=dy-ny*l:dz=dz-nz*l GOTO [recurs] 'really only GOTO end if FOR k=1 TO spheres u=c(k,1)-x v=c(k,3)-z IF u*u+v*v<=q(k) THEN ba=1 exit for end if NEXT k 'IF (x-INT (x)>.5)=(z-INT (z)>.5) THEN 'needs "int to lower" vs "int to 0" 'IF (x-(int(x)-(x<>int(x))*(x<0))>.5)=(z-(int(z)-(z<>int(z))*(z<0))>.5) THEN 'IF (x mod 1 +(x<0)>.5)=(z mod 1 +(z<0)>.5) THEN IF ((x+z) mod 1 +((x+z)<0)>.5)=((x-z) mod 1 +((x-z)<0)>.5) THEN ' tsh73 fix so diagonal checkers ik=cl(ba) else ik=cl(ba+1) end if 'plot ink ik;j,scrh-i '#gr "color ";ik;" ";ik;" ";ik if lastCol<>ik then 'prevent extra color switching #gr "color ";palette$(ik) lastCol=ik end if #gr "set ";j;" ";scrh-i [continueJ] NEXT j NEXT i ' 210 print at 0,0;transparent 1;ink 0;"Time: ";(msecs-t)/1000;" secs": ' pause 0:
#gr, "flush" print "Time: ";(time$("ms")-t0)/1000;" secs" wait
'==================== [quit] close #gr end
[ajustWindow] ' this code demonstrates ajusting window height, width to get desired drawing space (like, 400x300) WindowWidth = 200 '100 seems to be too much - works different WindowHeight = 100 open "Ajusting..." for graphics_nsb as #gr ' graphics ' graphics_nsb ' graphics_nsb_nf #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
[initQBcolors] dim qb$(15) 'thanks Andy Amaya qb$( 0) = " 0 0 0" 'black qb$( 1) = " 0 0 128" 'blue qb$( 2) = " 8 128 8" 'green qb$( 3) = " 0 128 128" 'cyan qb$( 4) = "128 0 0" 'red qb$( 5) = "128 0 128" 'magenta qb$( 6) = "128 64 32" 'brown qb$( 7) = "168 168 168" 'white qb$( 8) = "128 128 128" 'grey qb$( 9) = " 84 84 252" 'light blue qb$(10) = " 42 252 42" 'light green qb$(11) = " 0 220 220" 'light cyan qb$(12) = "255 0 0" 'light red qb$(13) = "255 84 255" 'light magenta qb$(14) = "255 255 0" 'yellow qb$(15) = "255 255 255" 'bright white return
sub rainbow startIdx, stopIdx r0=val(word$(palette$(startIdx),1)) r1=val(word$(palette$(stopIdx),1)) g0=val(word$(palette$(startIdx),2)) g1=val(word$(palette$(stopIdx),2)) b0=val(word$(palette$(startIdx),3)) b1=val(word$(palette$(stopIdx),3)) for i = startIdx+1 to stopIdx-1 a=1-(stopIdx-i)/(stopIdx-startIdx) 'startIdx..stopIdx -> 0..1 R=int(r0*(1-a) + r1*a) G=int(g0*(1-a) + g1*a) B=int(b0*(1-a) + b1*a) palette$(i)=R;" ";G;" ";B next end sub
|
|
|
Torus
Mar 11, 2024 18:52:29 GMT
Post by tsh73 on Mar 11, 2024 18:52:29 GMT
2x. It is obvious that 250 spheres are not quite enough - radial lines on a thorus are visible at this size. (really long - just run it and went away) [/url]
|
|