be 3dsurfaces3 singleshot=Name? "framenr perspective cs ht setupdategraph false setLabelAlign 0 0 setlabelsize [14 28] pr [ESC stops, + and - chooses demo, arrow keys change view and speed] ifelse singleshot [ (play singleshot framenr) ][ play ] end be play [singleshot false][framenr 0] ;Demos local [nDemos play_r i p nphi phi dphi ddphi theta dtheta c eye center upvector] nDemos=18 i=1 play_r=500 phi=30 dphi=1 ddphi=dphi/4 theta=30 dtheta=5 eye=array 3 eye.2=200 center={0 0 0} upvector={0 1 0} setPC rgba 0 0 1 1 j axes if singleshot [i=framenr+1] run word "shape :i ;a_Demo forever [ phi=phi+dphi eye.1=play_r*(cos theta)*sin phi eye.2=play_r* sin theta eye.3=play_r*(cos theta)*cos phi setEye eye center upvector redraw if singleshot [break] dispatchMessages if key? [ oi=i ch=readChar ifelse ch>=char 255 [ ch=readCharExt if ch==WXK_PRIOR [play_r=play_r/1.1] if ch==WXK_NEXT [play_r=play_r*1.1] if ch==WXK_RIGHT [dphi=dphi+ddphi] if ch==WXK_LEFT [dphi=dphi-ddphi] if ch==WXK_UP [theta=theta+dtheta] if ch==WXK_DOWN [theta=theta-dtheta] if ch==WXK_NUMPAD_ADD [if i < nDemos [i=i+1]] if ch==WXK_NUMPAD_SUBTRACT [if i > 1 [i=i-1]] ][ if ch==char 27 [stop] if ch=="+ [if i < nDemos [i=i+1]] if ch=="- [if i > 1 [i=i-1]] ] if oi != i [ j axes run word "shape :i ;a_Demo ] ] gc ] be j cs pu setxyz 0 205 0 seth 90 label se [3D surfaces Perspective] :i home end be aux n=count play::p pt=first play::p r=last pt h=first pt play::p=bf play::p end be cyl1 r s :h setxyz :h r*cos s r*sin s end be fun :r op 0.0001*r*r*r-0.00003*r*r+0.00003*r end be fun1 :r op (cos r/3)/22*(r+0.01) end be fun2 :r op (cos r/3)/22*(r+0.01) end be fun3 :h op 80000*(sin :h/4)/(:h+600) end be fun4 :r op (cos r/2)/70*(r+0.0001) end be fun5 :h op 80000*(sin :h/7)/(:h+600) end be fun6 :h op 60000*(cos :h/5)/(:h+950) end be table1 play::p= [ [17 1][16 1][15 1][14 1.1][13.5 .5][12.7 .5][12 1][11 1][10 1.5] [10 2.5][9 3][6.5 4][4.5 5.][4.5 7][3.1 7][2.7 7.4][2 8][1 8][0 9] [-.5 10][-1 10.5][-2. 11][-3 11] ] end be table2 play::p= [ [12.5 1][11.5 1][11 1.3][10.5 1][9.5 2.5][8.5 2.5][8 2.5][6 3] [5 4][4.5 5][4 5.3][3.5 6][3.3 6][3.2 7][3 8][2.8 9][2.8 10] [2.5 10][2.5 9.5][2 9.5][1.4 10][.5 10] ] end be table3 play::p= [ [16 1][15 1][13 4][11 4][10 3][9 3][8 4][7 4][6 6][5 6][4 6] [3 6][0 8][-1 8] ] end be table4 play::p= [ [2 0][3 3][4 5][4.5 6][5 8][5 11.5][3 12.5][2 13][3 16][3 16.5] ] end be table5 play::p= [ [0 2][3 3][5 4][6 4.5][8 5][11.5 5][12.5 3][13 2][16 3][16.5 3] ] end be shape1 pd SurfaceStart for [r -120 100 11] [ setPC HSB r 1 1 for [s 0 360 9] [ cyl1 r+130 s fun :r ] SurfaceColumn ] SurfaceEnd end be shape2 pd SurfaceStart for [r -100 100 25] [ setPC HSB r 1 1 for [s 0 360 15] [ cyl1 30+fun :r s r ] SurfaceColumn ] SurfaceEnd end be shape3 pd SurfaceStart for [r 0 1000 100] [ setPC HSB r/10 1 1 for [s 0 360 20] [ cyl1 r/6 s fun1 :r ] SurfaceColumn ] SurfaceEnd end be shape4 pd SurfaceStart for [r 0 1300 100] [ setPC HSB r/10 1 1 for [s 0 360 20] [ cyl1 :r/6 :s fun2 :r ] SurfaceColumn ] SurfaceEnd end be shape5 pd SurfaceStart for [h 0 1800 100] [ setPC HSB h/10 1 1 for [s 0 360 20] [ cyl1 fun3 :h :s -180+ :h/4 ] SurfaceColumn ] SurfaceEnd end be shape6 pd SurfaceStart for [h -100 1800 100] [ setPC HSB h/10 1 1 for [s 0 360 20] [ cyl1 80+fun3 :h :s -100+ :h/6 ] SurfaceColumn ] SurfaceEnd end be shape7 pd SurfaceStart for [r 0 1800 100] [ setPC HSB r/10 1 1 for [s 0 360 15] [ cyl1 :r*0.1 :s fun4 :r ] SurfaceColumn ] SurfaceEnd end be shape8 pd SurfaceStart for [r 0 1800 100] [ setPC HSB r/10 1 1 for [s 0 360 15] [ cyl1 (:r*0.1)-200 :s fun4 :r ] SurfaceColumn ] SurfaceEnd end be shape9 pd SurfaceStart for [h 0 1800 100] [ setPC HSB h/10 1 1 for [s 0 360 15] [ cyl1 fun5 :h :s -180+ :h/4 ] SurfaceColumn ] SurfaceEnd end be shape10 pd SurfaceStart for [h -100 1800 100] [ setPC HSB h/10 1 1 for [s 0 360 20] [ cyl1 80+fun5 :h :s -100+ :h/6 ] SurfaceColumn ] SurfaceEnd end be shape11 pd SurfaceStart for [h 0 1800 100] [ setPC HSB h/10 1 1 for [s 0 360 15] [ cyl1 fun6 :h :s -200+ :h/4 ] SurfaceColumn ] SurfaceEnd end be shape12 pd SurfaceStart for [h -100 1800 100] [ setPC HSB h/10 1 1 for [s 0 360 15] [ cyl1 80+fun6 :h :s -100+ :h/6 ] SurfaceColumn ] SurfaceEnd end be shape13 pd SurfaceStart for [h -120 0 20] [ setPC HSB h 1 1 for [s 0 360 20] [ cyl1 100-:h*:h/100 :s :h ] SurfaceColumn ] SurfaceEnd SurfaceStart for [h 0 60 20] [ setPC HSB h 1 1 for [s 0 360 20] [ cyl1 100-:h :s :h ] SurfaceColumn ] SurfaceEnd SurfaceStart for [h 60 160 20] [ setPC HSB h 1 1 for [s 0 360 20] [ cyl1 40 :s :h ] SurfaceColumn ] SurfaceEnd end be shape14 table1 n=count p pd SurfaceStart repeat n [ aux setPC HSB # 1 1 for [s 0 360 15] [ cyl1 aux::r*12 :s aux::h*12 ] SurfaceColumn ] SurfaceEnd end be shape15 table2 n=count p pd SurfaceStart repeat n [ aux setPC HSB # 1 1 for [s 0 360 15] [ cyl1 aux::r*12 :s aux::h*12 ] SurfaceColumn ] SurfaceEnd end be shape16 table3 n=count p pd SurfaceStart repeat n [ aux setPC HSB # 1 1 for [s 0 360 15] [ cyl1 aux::r*12 :s aux::h*12 ] SurfaceColumn ] SurfaceEnd end be shape17 table4 n=count p pd SurfaceStart repeat n [ aux setPC HSB # 1 1 for [s 0 360 15] [ cyl1 aux::r*12 :s aux::h*12 ] SurfaceColumn ] SurfaceEnd end be shape18 table5 n=count p pd SurfaceStart repeat n [ aux setPC HSB # 1 1 for [s 0 360 15] [ cyl1 aux::r*12 :s aux::h*12 ] SurfaceColumn ] SurfaceEnd end end