aUCBLogo Demos and Tests / 3dtest
be 3dtest
singleshot=Name? "framenr
if not singleshot [framenr=0]
perspective cs ht setUpdateGraph false
disableCylinderLines
setPenSize [0 0]
setLabelAlign 0 0 setlabelsize [30 30]
pr [ESC stops, + and - chooses demo, * and / changes speed]
Demos=
[ [Squares]
[pu setxyz 100 0 100 pd Squares]
[Squares2]
[Squares3]
[Cube wait 1]
[pu rt 90 fd 100 lt 90 fd 100 pd Cube wait 1]
[Wall_of_Cubes]
[Wall_of_Cubes1]
[Cube_of_Cubes]
[Cube_of_Cubes1]
[Cubes]
[Decorated_Cube]
[Circl 80 ]
[Circles ]
[Torous]
[Snail2 70]
[ppp]
[shape]
[shape1]
[wireSphere 120]
[Sphere3 120 waitms 1]
[cylinder]
[Moebius_Band 40]
[Paraboloid1]
[Paraboloid2]
[Hyperboloid]
[tyre]
[deformed_tyre]
[sq]
[Earth_and_Moon]
]
catch "3dtest_stop
[ (play Demos singleshot framenr)
]
end
;pause
be play Demos [singleshot false][FrameNr 0]
local [nDemos i nphi phi a_Demo c eye]
nDemos=count Demos
ifelse singleshot [i=FrameNr+1][i=1]
r=500
phi=30
;pause
dphi=1
ddphi=dphi/4
theta=30
dtheta=5
eye=array 3
a_Demo=Demos.i
j0 first a_Demo
run a_Demo
tfps=timefine
forever
[ phi=phi+dphi
eye.1=r*(cos theta)*sin phi
eye.2=r* sin theta
eye.3=r*(cos theta)*cos phi
setEye eye {0 0 0}{0 1 0}
redraw
if singleshot [break]
if key?
[ c=readChar
di=false
ifelse c==char 255
[ c=readCharExt
if c==WXK_PRIOR [r=r/1.1]
if c==WXK_NEXT [r=r*1.1]
if c==WXK_RIGHT [dphi=dphi+ddphi]
if c==WXK_LEFT [dphi=dphi-ddphi]
if c==WXK_UP [theta=theta+dtheta]
if c==WXK_DOWN [theta=theta-dtheta]
if c==WXK_NUMPAD_ADD [if i < nDemos [i=i+1 di=true]]
if c==WXK_NUMPAD_SUBTRACT [if i > 1 [i=i-1 di=true]]
][
if c==char 27 [stop]
if c=="+ [if i < nDemos [i=i+1 di=true]]
if c=="- [if i > 1 [i=i-1 di=true]]
if c=="* [dphi=dphi+0.5]
if c=="/ [dphi=dphi-0.5]
]
if di
[ a_Demo=Demos.i
j0 first a_Demo
pu setpos [0 -290] seth 90 setpc 0
label list "fps (Int 10*repcount/(timefine-tfps))/10
home pd
run a_Demo
]
]
gc
]
be j0 s
cs pu
setxyz 0 250 0 seth 90 label [3D Demos]
setxyz 0 -250 0 seth 90 label s
home axes
end
be j1
local [c]
setpc 1+random 6
c=readchar
if c==char 27 [throw "3dtest_stop]
end
be Circl r
pu fd r rt 90 pd
Circl1 r lt 90 pu bk r pd
end
be Circl1 r
local [n]
n=int r*pi/2
repeat n
[ pd fd r*2*pi/n rt 360/n
]
end
be Circles
repeat 18
[ Circl1 15 pu fd 30 up 20
]
end
be Cube
repeat 4
[ Square fd 50 up 90
]
end
be Cube_of_Cubes
for [i 0 50 50]
[ for [j 0 50 50]
[ for[k 0 50 50]
[ pu setxyz i j k pd
Cube
]
]
]
end
be Cube_of_Cubes1
for [i 50 100 50]
[ for [j 50 100 50]
[ for[k 50 100 50]
[ pu setxyz i j k pd
Cube
]
]
]
end
be Cubes
repeat 7
[ Cube pu fd 110 down 360/7 pd
]
end
be cylinder
pu for [s 0 360 24][for [h 0 180 20][setCylinderPos 100 s h pd]pu]
pu for [h 0 180 20][for [s 0 360 24][setCylinderPos 100 s h pd]pu]
end
be setCylinderPos1 :r :s :h
setxyz 100+:r*cos :s :h 150+:r* sin :s
end
be Decorated_Cube
repeat 4
[ setpc repcount
sq fd 115 up 90
]
rightRoll -90 down 90 fd 115 down 90 rt 90 sq
fd 115 down 90 fd 115 down 90 sq
end
be deformed_tyre
for [h 0 180 15][for [fi 0 360 15][setCylinderPos fun3 :h :fi :fi :h/3 pd]pu]
for [fi 0 360 15][for [h 0 180 15][setCylinderPos fun3 :h :fi :fi :h/3 pd]pu]
end
be Earth_and_Moon
sphere4 100 0 sphere4 25 250
end
be fun :h
op 80000*(sin :h/7)/(:h+600)
end
be fun1 :r
op 10*:r*:r*:r- 3*:r*:r+ 3*:r
end
be fun2 :h
op 40*(2.7+sin :h)
end
be fun3 :h :fi
op 40*(2.2+ (1+sin :h)*(0.5+cos :fi))
end
be Hyperboloid
pu
for [h_ 10 180 20]
[ for [s 0 360 24]
[ setCylinderPos 4500/(h_+20) s h_ pd
]
pu
]
pu
for [s 0 360 24]
[ for [h_ 10 180 20]
[ setCylinderPos 4500/(h_+20) s h_ pd
]
pu
]
end
be Moebius_Band a
for [r -a a 10]
[ for [fi 0 360 10]
[ setCylinderPos 140+r*cos fi/2 fi r*sin fi/2 pd
]
pu
]
for [fi 0 360 10]
[ for [r -a a 10]
[ setCylinderPos 140+r*cos fi/2 fi r*sin fi/2 pd
]
pu
]
end
be Paraboloid1
pu for [s 0 360 24][for [h 0 180 20][setCylinderPos 10*sqrt h s h pd]pu]
pu for [h 0 180 20][for [s 0 360 24][setCylinderPos 10*sqrt h s h pd]pu]
end
be Paraboloid2
pu for [s 0 360 24][for [h 0 180 20][setCylinderPos h*h/200 s h pd]pu]
pu for [h 0 180 20][for [s 0 360 20][setCylinderPos h*h/200 s h pd]pu]
end
be ppp
pu for [h -100 1800 90][for [s 0 360 24][setCylinderPos 80+fun :h :s -100+ :h/6 pd]pu]
pu for [s 0 360 24][for [h -100 1800 90][setCylinderPos 80+fun :h :s -100+ :h/6 pd]pu]
end
be shape
pu for [r -100 100 20][for [s 0 360 24][setCylinderPos 30+0.00001*fun1 :r :s :r pd]pu]
pu for [s 0 360 24][for [r -100 100 20][setCylinderPos 30+0.00001*fun1 :r :s :r pd]pu]
end
be shape1
pu for [r -100 100 20][for [s 0 360 24][setCylinderPos1 30+0.00001*fun1 :r :s :r pd]pu]
pu for [s 0 360 24][for [r -100 100 20][setCylinderPos1 30+0.00001*fun1 :r :s :r pd]pu]
end
be Snail2 a
for [u 0.01 180 15]
[ for [v 0 360 15]
[ setSpherePos (v+a)/2*sin u v u pd
]
pu
]
for [v 0 360 15]
[ for [u 0.01 180 15]
[ setSpherePos (v+a)/2*sin u v u pd
]
pu
]
end
be wireSphere r
pu
for [s 0 360 24]
[ for [t 0 180 15]
[ setSpherePos r s t pd
]
pu
]
pu
for [t 0 180 15]
[ for [s 0 360 24]
[ setSpherePos r s t pd
]
pu
]
end
be Sphere3 r
pu
for [s 48 360 24]
[ for [t 45 180 16]
[ setSpherePos r s t pd
]
pu
]
pu
for [t 45 180 16]
[ for [s 48 360 24]
[ setSpherePos r s t pd
]
pu
]
end
be sphere4 :r :o
pu
for [s 0 360 20]
[ for [t 0 180 15]
[ setxyz :o+ :r*(cos :s)*sin :t :r*cos :t :r*(sin :s)*sin :t pd
]
pu
]
pu
for [t 0 180 15]
[ for [s 0 360 20]
[ setxyz :o+ :r*(cos :s)*sin :t :r*cos :t :r*(sin :s)*sin :t pd
]
pu
]
end
be sq
repeat 4
[ fd 115 rt 90
]
fd 24
Star 90
bk 24
end
be sq1
repeat 4
[ fd 115 rt 90
]
end
be Square
repeat 4
[ fd 50 rt 90
]
end
be Squares
repeat 12
[ Square fd 50 down 30
]
end
be Squares2
repeat 8
[ Square rightRoll 40
]
end
be Squares3
repeat 8
[ Square down 40
]
end
be Star l
if l > 3
[ repeat 5
[ fd l/4
Star l/3
fd l/2
rt 72
]
]
end
be Torous
repeat 18
[ Circl1 50 rightRoll 20
]
end
be tyre
for [h 0 180 15][for [fi 0 360 15][setCylinderPos fun2 :h :fi :h/3 pd]pu]
for [fi 0 360 15][for [h 0 180 15][setCylinderPos fun2 :h :fi :h/3 pd]pu]
end
be Wall_of_Cubes
for [i -100 100 50]
[ for [j -100 100 50]
[ pu setxyz 0 i j pd
Cube
]
]
end
be Wall_of_Cubes1
for [i 0 150 50]
[ for [j 0 150 50]
[ pu setxyz 50 i j pd
Cube
]
]
end
end