aUCBLogo Demos and Tests / 3dsurfaces2

be 3dsurfaces2
   singleshot=Name? "framenr
   perspective cs ht setupdategraph false
   setLabelAlign 0 0 setlabelsize [14 28]
   setPenSize [0 0]
   pr [ESC stops, + and - chooses demo, arrow keys change view]
   if not singleshot [framenr=0]
   (play singleshot framenr)
end

be play [singleshot false][FrameNr 0] ;Demos
   local [nDemos i play_r phi dphi theta dtheta c eye center upvector]
   nDemos=18
   i=1
   play_r=500
   phi=30
   dphi=3
   ddphi=dphi/4
   theta=30
   dtheta=5
   eye=array 3
   eye.2=200
   center={0 0 0}
   upvector={0 1 0}
   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
      j
      axes
      if singleshot [i=FrameNr+1]
      run word "shape :i ;a_Demo
      updateGraph
      if singleshot [break]
      if key?
      [   c=rc
         if c==char 27 [stop]
         if c=="+ [if i < nDemos [i=i+1]]
         if c=="- [if i >   1    [i=i-1]]
         if c==char 255
         [   c=readCharExt
            if c==WXK_PRIOR [play_r=play_r/1.1]
            if c==WXK_NEXT  [play_r=play_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]]
            if c==WXK_NUMPAD_SUBTRACT [if i >   1    [i=i-1]]
         ]
      ]
      gc
   ]

   be j
      cs pu
      setxyz 0  205 0 seth 90  label se [3D surfaces Perspective] play::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 shape1
        pu for[r -120 100 22][for[s 0 360 15][cyl1 :r+130 :s fun :r pd]pu]
        pu for[s 0 360 15][for[r -120 100 22][cyl1 :r+130 :s fun :r pd]pu]
   end

   be shape2
        pu for[r -100 100 25][for[s 0 360 15][cyl1 30+fun :r :s :r pd]pu]
        pu for[s 0 360 15][for[r -100 100 25][cyl1 30+fun :r :s :r pd]pu]
   end

   be shape3
        pu for[r 0 1000 100][for[s 0 360 20][cyl1 :r/6 :s fun1 :r pd]pu]
        pu for[s 0 360 20][for[r 0 1000 100][cyl1 :r/6 :s fun1 :r pd]pu]
   end

   be shape4
        pu for[r 0 1300 100][for[s 0 360 20][cyl1 :r/6 :s fun2 :r pd]pu]
        pu for[s 0 360 20][for[r 0 1300 100][cyl1 :r/6 :s fun2 :r pd]pu]
   end

   be shape5
        pu for[h 0 1800 100][for[s 0 360 20][cyl1 fun3 :h :s -180+ :h/4 pd]pu]
        pu for[s 0 360 20][for[h 0 1800 100][cyl1 fun3 :h :s -180+ :h/4 pd]pu]
   end

   be shape6
        pu for[h -100 1800 100][for[s 0 360 20][cyl1 80+fun3 :h :s -100+ :h/6  pd]pu]
        pu for[s 0 360 20][for[h -100 1800 100][cyl1 80+fun3 :h :s -100+ :h/6  pd]pu]
   end

   be shape7
        pu for[r 0 1800 100][for[s 0 360 15][cyl1 :r*0.1 :s fun4 :r pd]pu]
        pu for[s 0 360 15][for[r 0 1800 100][cyl1 :r*0.1 :s fun4 :r pd]pu]
   end

   be shape8
        pu for[r 0 1800 100][for[s 0 360 15][cyl1 (:r*0.1)-200 :s fun4 :r pd]pu]
        pu for[s 0 360 15][for[r 0 1800 100][cyl1 (:r*0.1)-200 :s fun4 :r pd]pu]
   end

   be shape9
      pu for[h 0 1800 100][for[s 0 360 15][cyl1 fun5 :h :s -180+ :h/4 pd]pu]
      pu for[s 0 360 15][for[h 0 1800 100][cyl1 fun5 :h :s -180+ :h/4 pd]pu]
   end

   be shape10
      pu for[h -100 1800 100][for[s 0 360 20][cyl1 80+fun5 :h :s -100+ :h/6  pd]pu]
      pu for[s 0 360 20][for[h -100 1800 100][cyl1 80+fun5 :h :s -100+ :h/6  pd]pu]
   end

   be shape11
      pu for[h 0 1800 100][for[s 0 360 15][cyl1 fun6 :h :s -200+ :h/4 pd]pu]
      pu for[s 0 360 15][for[h 0 1800 100][cyl1 fun6 :h :s -200+ :h/4 pd]pu]
   end

   be shape12
      pu for[h -100 1800 100][for[s 0 360 15][cyl1 80+fun6 :h :s -100+ :h/6  pd]pu]
      pu for[s 0 360 15][for[h -100 1800 100][cyl1 80+fun6 :h :s -100+ :h/6  pd]pu]
   end

   be shape13
      pu for [h -120 0 20][for [s 0 360 20][cyl1 100-:h*:h/100 :s :h pd]pu]
      pu for [s 0 360 20][for [h -120 0 20][cyl1 100-:h*:h/100 :s :h pd]pu]
      pu for [h 0 60 20][for [s 0 360 20][cyl1 100-:h :s :h pd]pu]
      pu for [s 0 360 20][for [h 0 60 20][cyl1 100-:h :s :h pd]pu]
      pu for [h 60 160 20][for [s 0 360 20][cyl1 40 :s :h pd]pu]
      pu for [s 0 360 20][for [h 60 160 20][cyl1 40 :s :h pd]pu]
   end

   be shape14
      table1 make "n count play::p
      pu repeat :n [aux for [s 0 360 15][cyl1 aux::r*12 :s aux::h*12 pd]pu]
      for [s 0 360 15][table1 repeat :n[aux cyl1 aux::r*12 :s aux::h*12 pd]pu]
   end

   be shape15
      table2 make "n count play::p
      pu repeat :n[aux for [s 0 360 15][cyl1 aux::r*12 :s aux::h*12 pd]pu]
      for [s 0 360 15][table2 repeat :n[aux cyl1 aux::r*12 :s aux::h*12 pd]pu]
   end

   be shape16
      table3 make "n count play::p
      pu repeat :n[aux for [s 0 360 15][cyl1 aux::r*12 :s aux::h*12 pd]pu]
      for [s 0 360 15][table3 repeat :n[aux cyl1 aux::r*12 :s aux::h*12 pd]pu]
   end

   be shape17
      table4 make "n count play::p
      pu repeat :n[aux for [s 0 360 15][cyl1 aux::r*12 :s aux::h*12 pd]pu]
      for [s 0 360 15][table4 repeat :n[aux cyl1 aux::r*12 :s aux::h*12 pd]pu]
   end

   be shape18
      table5 make "n count play::p
      pu repeat :n[aux for [s 0 360 15][cyl1 aux::r*12 :s aux::h*12 pd]pu]
      for [s 0 360 15][table5 repeat :n[aux cyl1 aux::r*12 :s aux::h*12 pd]pu]
   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
end