aUCBLogo Demos and Tests / 3dsurfaces

; 3dsurfaces by MHelhefny

be 3dsurfaces
   singleshot=Name? "framenr
   catch "stopping
   [   cS
;      perspective
      orthographic
      hT setPenSize [0 0] axis
      setLabelSize [20 20]
      demos=
      {   [j1 curve1][j2 shape1][j3 shape1][j4 shape1]
         [j1 curve2][j2 shape2][j3 shape2][j4 shape2]
         [j1 curve3][j2 shape3][j3 shape3][j4 shape3]
         [j1 curve4][j2 shape4][j3 shape4][j4 shape4]
         [j1 curve5][j2 shape5][j3 shape5][j4 shape5]
         [j1 curve6][j2 shape6][j3 shape6][j4 shape6]
         [j1 curve7][j2 shape7][j3 shape7][j4 shape7]
         [j1 curve8][j2 shape8][j3 shape8][j4 shape8]
         [j1 curve9][j2 shape9][j3 shape9][j4 shape9]
         [j1 curve10][j2 shape10][j3 shape10][j4 shape10]
         [j1 curve11][j2 shape11][j3 shape11][j4 shape11]
         [j1 curve12][j2 shape12][j3 shape12][j4 shape12]
         [j1 cS rt 30 uP 30 rightRoll 35 shape1 j]
         [j shape2][j shape3][j shape4][j shape5]
         [j shape6][j shape7][j shape8][j shape9]
         [j shape10][j shape11][j shape12 myWait 60]
         [dd1 1][dd2 1][dd3 1][dd4 1]
         [dd1 2][dd2 2][dd3 2][dd4 2]
         [dd1 3][dd2 3][dd3 3][dd4 3]
         [dd1 4][dd2 4][dd3 4][dd4 4]
         [dd1 5][dd2 5][dd3 5][dd4 5]
      }
      ifElse singleshot
      [   run demos.(framenr+1)
      ][   repeat count demos [run demos.repCount]
      ]
   ]

   be mywait n
      updateGraph
      if not singleshot
      [   if KeyP
         [   ignore readChar
            throw "stopping
         ]
         wait n
      ]
   end

   be j
      myWait 60 cS PU setXY -150 200 Label "perspective_from_another_view_point
   end

   be j1
      myWait 60 cS axis
      setEye {0 0 500}{0 0 0}{0 1 0}
   end

   be j2
      myWait 60 cS PU setXY -150 200 setH 90 Label "isometric
      setEye {400 400 600}{0 0 0}{0 1 0}
   end

   be j3
      myWait 60 cS PU setXY -150 200 setH 90 Label "elivation
      setEye {0 0 500}{0 0 0}{0 1 0}
   end

   be j4
      myWait 60 cS PU setXY -150 200 setH 90 Label "plan
      setEye {0 500 0}{0 0 0}{0 0 1}
   end

   be j5 :w
      PU setXY -150 200 Label :w myWait 60 cS
   end

   be aux
      pt=first 3dsurfaces::p
      r=last :pt
      h=first :pt
      3dsurfaces::p=bF 3dsurfaces::p
   end

   be axis
      PD setXY 200 0 setXY -200 0 PU setXY 0 200 PD setXY 0 -170
   end

   be curve :n
      PU repeat :n [aux setXY aux::r*9 :aux::h*9 PD]
   end

   be curve1
      PU for [r -120 120 15][setXY :r+130 fun :r PD]PU
   end

   be curve2
      PU for [r -120 120 15][setXY 30+fun :r :r PD]PU
   end

   be curve3
      PU for [r 0 1000 40][setXY :r/6 fun1 :r PD]PU
   end

   be curve4
      PU for [r 0 1300 40][setXY :r/6 fun2 :r PD]PU
   end

   be curve5
      PU for [h 0 1800 50][setXY fun3 :h -180+:h/4 PD]
   end

   be curve6
      PU for [h -100 1800 50][setXY 80+fun3 :h -100+ :h/6 PD]
   end

   be curve7
      PU  for [r 0 1800 50][setXY :r*0.1 fun4 :r PD]
   end

   be curve8
      PU  for [r 0 1800 50][setXY (:r*0.1)-200 fun4 :r PD]
   end

   be curve9
      PU for [h 0 1800 50][setXY fun5 :h -180+ :h/4 PD]
   end

   be curve10
      PU for [h -100 1800 50][setXY 80+fun5 :h -100+ :h/6 PD]
   end

   be curve11
      PU for [h 0 1800 50][setXY fun6 :h -200+ :h/4 PD]
   end

   be curve12
      PU for [h -100 1800 50][setXY 80+fun6 :h -100+ :h/6 PD]PU
   end

   be dd1 :kk
      j5 "plan
      cS hT run Word "Table :kk
      3dsurfaces::n=count 3dsurfaces::p
      axis
      curve :n
   end

   be dd2 :kk
      j5 "curve
      rightRoll -135 run Word "Table :kk shape :kk
   end

   be dd3 :kk
      j5 "isometric
      rightRoll -135 uP 35 run Word "Table :kk shape :kk
   end

   be dd4 :kk
      uP 90 j5 "elivation  run Word "Table :kk shape :kk
   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 shape :kk
      PU repeat :n [aux for [s 0 360 20][setCylinderPos aux::r*12 :s aux::h*12 PD]PU]
      for [s 0 360 20]
      [   run Word "Table :kk
         repeat :n
         [   aux
            setCylinderPos aux::r*12 :s aux::h*12
            PD
         ]
         PU
      ]
   end

   be shape1
      PU for[r -120 100 15][for[s 0 360 20][setCylinderPos :r+130 :s fun :r PD]PU]
      PU for[s 0 360 20][for[r -120 100 15][setCylinderPos :r+130 :s fun :r PD]PU]
   end

   be shape10
      PU for[h -100 1800 50][for[s 0 360 20][setCylinderPos 80+fun5 :h :s -100+ :h/6  PD]PU]
      PU for[s 0 360 20][for[h -100 1800 50][setCylinderPos 80+fun5 :h :s -100+ :h/6  PD]PU]
   end

   be shape11
      PU for[h 0 1800 60][for[s 0 360 20][setCylinderPos fun6 :h :s -200+ :h/4 PD]PU]
      PU for[s 0 360 20][for[h 0 1800 60][setCylinderPos fun6 :h :s -200+ :h/4 PD]PU]
   end

   be shape12
      PU for[h -100 1800 50][for[s 0 360 20][setCylinderPos 80+fun6 :h :s -100+ :h/6  PD]PU]
      PU for[s 0 360 20][for[h -100 1800 50][setCylinderPos 80+fun6 :h :s -100+ :h/6  PD]PU]
   end

   be shape2
      PU for[r -100 100 15][for[s 0 360 20][setCylinderPos 30+fun :r :s :r PD]PU]
      PU for[s 0 360 20][for[r -100 100 15][setCylinderPos 30+fun :r :s :r PD]PU]
   end

   be shape3
      PU for[r 0 1000 40][for[s 0 360 20][setCylinderPos :r/6 :s fun1 :r PD]PU]
      PU for[s 0 360 20][for[r 0 1000 40][setCylinderPos :r/6 :s fun1 :r PD]PU]
   end

   be shape4
      PU for[r 0 1300 40][for[s 0 360 20][setCylinderPos :r/6 :s fun2 :r PD]PU]
      PU for[s 0 360 20][for[r 0 1300 40][setCylinderPos :r/6 :s fun2 :r PD]PU]
   end

   be shape5
      PU for[h 0 1800 50][for[s 0 360 20][setCylinderPos fun3 :h :s -180+ :h/4 PD]PU]
      PU for[s 0 360 20][for[h 0 1800 50][setCylinderPos fun3 :h :s -180+ :h/4 PD]PU]
   end

   be shape6
      PU for[h -100 1800 50][for[s 0 360 20][setCylinderPos 80+fun3 :h :s -100+ :h/6  PD]PU]
      PU for[s 0 360 20][for[h -100 1800 50][setCylinderPos 80+fun3 :h :s -100+ :h/6  PD]PU]
   end

   be shape7
      PU for[r 0 1800 50][for[s 0 360 20][setCylinderPos :r*0.1 :s fun4 :r PD]PU]
      PU for[s 0 360 20][for[r 0 1800 50][setCylinderPos :r*0.1 :s fun4 :r PD]PU]
   end

   be shape8
      PU for[r 0 1800 50][for[s 0 360 20][setCylinderPos (:r*0.1)-200 :s fun4 :r PD]PU]
      PU for[s 0 360 20][for[r 0 1800 50][setCylinderPos (:r*0.1)-200 :s fun4 :r PD]PU]
   end

   be shape9
      PU for[h 0 1800 60][for[s 0 360 20][setCylinderPos fun5 :h :s -180+ :h/4 PD]PU]
      PU for[s 0 360 20][for[h 0 1800 60][setCylinderPos fun5 :h :s -180+ :h/4 PD]PU]
   end

   be table1
      3dsurfaces::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
      3dsurfaces::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
      3dsurfaces::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
      3dsurfaces::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
      3dsurfaces::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