aUCBLogo Demos and Tests / 3dsurfaces3

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