aUCBLogo Demos and Tests / mapping

;Hi !
;Here is a file:  map.lg  ,which show mapping of curves on a sphere this
;file; is written to run on aUcblogo which is a fork from the famous UCBLogo,
;you can download  aUcblogo from :
;<http://www.physik.uni-augsburg.de/TILDEmicheler/aUCBLogo-4.67-win.zip>
;
;this demo is fairly extensive ,
;I hope you will enjoy it.
;Best Regards.
;mhelhefny

to fl :size
   pu
   for[s 0 :size]
   [   setspherepos :r :u+:s*cos heading :v+:s*sin heading
      pd
   ]
   make "u :u+:size*cos heading
   make "v :v+:size*sin heading
end

to mapping
   ;By mhelhefny
   perspective cs ht
   setlabelsize [20 40]
   setLabelAlign 0 0
   setupdategraph false
   s=[   [square spiral]
         [circular spiral]
         [penta spiral]
         [dragon]
         [hilbert curve]
         [see]
         [penta star]
         [snow flake]
         [sierpinski carpet]
         [star1]
         [tree]
         [triangle]
      ]

   pr [ESC stops, + - chooses demo, * / changes speed]

   demos=[   [hil1]
            [hil2]
            [hil3]
            [hil4]
            [hil5]
            [hil6]
            [hil7]
            [hil8]
            [hil9]
            [hil10]
            [hil11]
            [hil12]
         ]

   phi=0  dphi=2  ddphi=dphi/4
   theta=30 dtheta=5
   i=1
   r=140
   eye= {400 400 400}
   run demos.i

   forever
   [   phi=phi+dphi
      eye.1= -400*(cos theta)*sin phi
      eye.2=  400* sin theta
      eye.3=  400*(cos theta)*cos phi
      setEye eye {0 0 0}{0 1 0}
      redraw
      waitms 1

      if key?
      [   c=rc
         if c==char 27 [stop]
         if c=="+ [if i < 12 [i=i+1]  clearScreen  run demos.i]
         if c=="- [if i >  1 [i=i-1]  clearScreen  run demos.i]
         if c=="* [dphi=dphi+ddphi]
         if c=="/ [dphi=dphi-ddphi]
         if c==char 255
         [   c=readCharExt
            if c==WXK_NUMPAD_ADD
            [   if i < 12 [i=i+1]  clearScreen  run demos.i
            ]
            if c==WXK_NUMPAD_SUBTRACT
            [   if i >  1 [i=i-1]  clearScreen  run demos.i
            ]
            if c==WXK_LEFT  [dphi=dphi+ddphi]
            if c==WXK_RIGHT [dphi=dphi-ddphi]
            if c==WXK_UP    [theta=theta+dtheta]
            if c==WXK_DOWN  [theta=theta-dtheta]
         ]
      ]
      gc
   ]
end

to j :s
   cs pu setxyz 0  225 0  seth 90  label [mapping on a sphere ]
         setxyz 0 -300 0  seth 90  label :s home
end

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

to hil1
   make "u 30 make "v 70 pu setpensize [0 0] setpc 4
   j s.1 sq2 2 setpc 11 setpensize [0 0] wireSphere :r
end

to hil2
   cs
   make "u 10 make "v 90 setpc 4 rt 90 j s.2 wait 3
   sq 0.5 setpc 11 wireSphere :r
end

to hil3
   make "u 50 make "v 60 pu setpc 4
   j s.3
   setpensize [0 0] sq1 2 setpc 11
   setpensize [0 0] wireSphere :r wait 1
end

to hil4
   make "u 40 make "v 130 setpc 4 setpensize [0 0]
   j s.4 rdragon 2 10  setpensize [0 0] setpc 11 wireSphere :r
end

to hil5
   make "u 30 make "v 140 setpensize [0 0]setpc 4
   j s.5 hilbert 5 4 1  setpensize [0 0] setpc 11 wireSphere :r
end

to hil6
   make "u 80 make "v 80 setpensize [0 0] setpc 4
   j s.6 see 200  setpensize [0 0] setpc 11 wireSphere :r wait 3
end

to hil7
   pu make "u 30 make "v 70 setpensize [0 0] setpc 4
   j s.7 pd star 45 5  setpensize [0 0] setpc 11 wireSphere :r
   ;better star 100 5 but very slow
end

to hil8
   u=30 v=100 setpc 4 setpensize [0 0]
   j s.8 snow 180 setpc 11  setpensize [0 0] wireSphere :r wait 3
end

to hil9
   make "u 70 make "v 70 setpensize [0 0] setpc 4
   j s.9 star 50 4  setpensize [0 0] setpc 11 wireSphere :r
end

to hil10
   make "u 25 make "v 280 setpensize [0 0] setpc 4
   j s.10 star1 50 5  setpensize [0 0] setpc 11 wireSphere :r
end

to hil11
   make "u 70 make "v 110 setpensize [0 0] setpc 4
   j s.11 lt 90 tree 5 30
   setpensize [0 0] setpc 11 wireSphere :r wait 3
end

to hil12
   cs make "u 50 v= -90
   setpc 4 j s.12 star2 230 3 setpc 11 wireSphere :r
end

TO HILBERT :SIZE :LEVEL :PARITY
   IF :LEVEL == 0 [STOP]
   LEFT :PARITY * 90
   LOCAL "L
   MAKE "L :LEVEL - 1
   HILBERT :SIZE :L (-:PARITY)
   Fl :SIZE
   RIGHT :PARITY * 90
   HILBERT :SIZE :L :PARITY
   Fl :SIZE
   HILBERT :SIZE :L :PARITY
   RIGHT :PARITY * 90
   Fl :SIZE
   HILBERT :SIZE :L (-:PARITY)
   LEFT :PARITY * 90
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 see :l
   if :l<3 [fl :l stop]
   see :l*0.6 lt 90
   see :l*0.6 rt 90
end

to snow :size
   if :size < 3 [fl :size stop]
   snow :size/3 lt 60
   snow :size/3 rt 120
   snow :size/3 lt 60
   snow :size/3
end

to sq :size
   if :size>20[stop]
   fl :size rt 10
   sq :size+0.2
end

to sq1 :size
   if :size>60[stop]
   fl :size rt 70
   sq1 :size+1
end

to sq2 :size
   if :size>80[stop]
   fl :size rt 90
   sq2 :size+1
end

to star :l :n
   if :l<1 [fl :l stop]
   repeat :n[fl :l/3 star :l/3 :n fl :l*2/3 rt 360/:n]
end

to star1 :l :n
   pu fl :l*2
      if :l>2 [repeat :n[star1 :l/3 :n fl :l/3 rt 360/:n pd]]
   pu fl -:l*3
end

to star2 :l :n
   if :l>20 [repeat :n[star2 :l/2 :n fl :l/3 rt 360/:n pd]]
end

to tree :level :size
   if level==0 [stop]
   fl size
      lt 80
      tree2 level-1 size/2
      rt 70
      tree level-1 size*2/3
      rt 90
      tree2 level-1 size/2
      lt 80
   fl -size
end

to tree2 :level :size
   if level==0 [stop]
   fl size
      rt 80
      tree level-1 size/2
      lt 70
      tree2 level-1 size*2/3
      lt 90
      tree level-1 size/2
      rt 40
      tree level-1 size*4/5
      rt 40
   fl -size
end