aUCBLogo Demos and Tests / mappingorbit

;Hi
;Here is a file map2.lg for mapping curves
;to an orbitting sphere written in aUCBlogo.
;Enjoy it
;Regards
;mhelhefny

to fl :size
   for [s 0 :size]
   [   sppos  :r  u+:s*cos heading  v+:s*sin heading
      pd
   ]
   u=:u+:size*cos heading
   v=:v+:size*sin heading
end

to mappingOrbit
   perspective cs ht setupdategraph false
   eye={400 400 400}
   phi=0  dphi=2  ddphi=dphi/4
   r=70
   hil
   forever
   [   phi=phi+dphi
      eye.1= -400*sin phi
      eye.3=  400*cos phi
      setEye eye {0 0 0}{0 1 0}
      redraw
      if key?
      [   c=rc
         if c==char 27 [stop]
         if c=="* [dphi=dphi+ddphi]
         if c=="/ [dphi=dphi-ddphi]
      ]
      gc
   ]
end

to hil
   pu make "u 40 make "v 50 rt 40 sppos :r :u :v
   setpc 11 wireSphere :r setpc 2 ldragon 4 8
end

to ldragon :l :lev
   if :lev==0 [fl :l stop]
   ldragon :l :lev-1 lt 90
   rdragon :l lev-1
end

to rdragon :l :lev
   if :lev==0 [fl :l stop]
   ldragon :l :lev-1 rt 90
   rdragon :l lev-1
end

to wireSphere :r
   pu for [u 0 360 30][for[v 0 180 20][sppos :r :u :v pd]pu]
   pu for [v 0 180 30][for[u 0 360 20][sppos :r :u :v pd]pu]
end

to sppos :r :fi :theta
   setxyz 160+:r*(sin :theta)*cos :fi 40+:r*cos :theta 130+:r*(sin :theta)*sin :fi
end