; *********************************************************************

;  Three dimensional turtle graphics for LOGO.

; *********************************************************************

if buriedp "turtle-3d-stuff [ unbury :turtle-3d-stuff ] [ ]

; *********************************************************************
;  turtle3        ( bit-planes )
;     Open a screen, a window, and the 3-D turtle. 

make "turtle3 [
   procedure [ [ ] [ :d ] ]
   if numberp :d [ ] [ make "d 1 ]
   ( intuition 6 @0 )
   recycle
   make "s1 ( openscreen 3 :d [ \ 3-D\ Turtle\ Graphics ] )
   make "w1 openwindow :s1
   ( prep3turtle :w1 0.88 1 )
   setrgb :s1 0 [ 0  0  0 ]
   setrgb :s1 1 [ 14 14 14 ]
   ( intuition 2 @0 0 0 )
   ( intuition 8 @0 550 54 )
   if < 300 peek -2 psum peek 0 :s1 14
   [  ( intuition 1 @0 0 350 ) ]
   [  ( intuition 1 @0 0 150 ) ]
   ( intuition 6 @0 ) ]

; *********************************************************************
;  prep3turtle    window-pointer ( aspect-ratio pen-number )
;     Assign turtle to window.

make "prep3turtle [ 
   procedure [ [ :w ] [ :ar :pn ] [ ] ] 
   degrees 
   if numberp :ar [ make "scr-t3ar :ar ] [ make "scr-t3ar 1 ] 
   if numberp :pn [ setpen :w :pn ] [ ] 
   make "scr-t3xscale / peek -2 + bf :w 8  200 
   make "scr-t3yscale * :scr-t3xscale :scr-t3ar 
   make "scr-t3xoff / peek -2 + bf :w 8  2 
   make "scr-t3yoff / peek -2 + bf :w 10  2 
   make "scr-t3wp :w 
   home3 ] 

; *********************************************************************
;  yaw            angle
;     Rotate turtle.

make "yaw [
   procedure [ [ :a ] [ ] [ :t ] ] 
   make "t rotate :scr-t3h :scr-t3l :a
   make "scr-t3l  rotate :scr-t3l -v :scr-t3h :a
   make "scr-t3h :t ]

; *********************************************************************
;  pitch          angle
;     Rotate turtle.

make "pitch [
   procedure [ [ :a ] [ ] [ :t ] ] 
   make "t rotate :scr-t3h :scr-t3u :a
   make "scr-t3u  rotate :scr-t3u -v :scr-t3h :a
   make "scr-t3h :t ]

; *********************************************************************
;  roll           angle
;     Rotate turtle.

make "roll [
   procedure [ [ :a ] [ ] [ :t ] ] 
   make "t rotate :scr-t3l :scr-t3u :a
   make "scr-t3u  rotate :scr-t3u -v :scr-t3l :a
   make "scr-t3l :t ]

; *********************************************************************
;  fd3            number
;     Move turtle forward.

make "fd3 [
   procedure [ [ :d ] ] 
   make "scr-t3pos vadd :scr-t3pos vscale :scr-t3h :d
   draw :scr-t3wp    + :scr-t3xoff   * item 1 :scr-t3pos  :scr-t3xscale 
                     - :scr-t3yoff   * item 2 :scr-t3pos  :scr-t3yscale ] 

; *********************************************************************
;  bk3            number
;     Move turtle backward.

make "bk3 [
   procedure [ [ :d ] ] 
   make "scr-t3pos vsub :scr-t3pos vscale :scr-t3h :d
   draw :scr-t3wp    + :scr-t3xoff   * item 1 :scr-t3pos  :scr-t3xscale 
                     - :scr-t3yoff   * item 2 :scr-t3pos  :scr-t3yscale ] 

; *********************************************************************
;  setpos3        vector
;     Set the position of turtle. ( vectur = [ X Y Z ] )

make "setpos3 [
   procedure [ [ :p ] ] 
   make "scr-t3pos :p
   draw :scr-t3wp    + :scr-t3xoff   * item 1 :scr-t3pos  :scr-t3xscale 
                     - :scr-t3yoff   * item 2 :scr-t3pos  :scr-t3yscale ] 

; *********************************************************************
;  movepos3       vector
;     Set the position of turtle. ( vectur = [ X Y Z ] )

make "movepos3 [
   procedure [ [ :p ] ] 
   make "scr-t3pos :p
   move :scr-t3wp    + :scr-t3xoff   * item 1 :scr-t3pos  :scr-t3xscale 
                     - :scr-t3yoff   * item 2 :scr-t3pos  :scr-t3yscale ] 

; *********************************************************************
;  cw3
;     Clear window and home turtle.

make "cw3 [
   procedure [ ] 
   clean3 
   home3 ] 

; *********************************************************************
;  home3
;     Zero position and heading.

make "home3 [
   procedure [ ] 
   make "scr-t3pos [ 0 0 0 ]
   make "scr-t3h [ 0 1 0 ]
   make "scr-t3l [ -1 0 0 ]
   make "scr-t3u [ 0 0 1 ]
   move :scr-t3wp :scr-t3xoff :scr-t3yoff ] 

; *********************************************************************
;  clean3
;     Clear window.

make "clean3 [
   procedure [ [ ] [ ] [ :c ] ] 
   make "c peek 1 + 25 peek 4 + 50 bf :scr-t3wp 
   setpen :scr-t3wp 0 
   rectfill :scr-t3wp 0 0 * :scr-t3xoff 2 * :scr-t3yoff 2 
   setpen :scr-t3wp :c ] 

; *********************************************************************
;  3-D vector arithmatic.

make "-v [
   procedure [ [ :a ] ]
   output vscale :a -1 ]

make "rotate [
   procedure [ [ :v :pv :a ] ] 
   output vadd vscale :v cos :a vscale :pv sin :a ]

make "vadd [
   procedure [ [ :a :b ] ]
   output ( list  + item 1 :a item 1 :b
                  + item 2 :a item 2 :b
                  + item 3 :a item 3 :b ) ]

make "vsub [
   procedure [ [ :a :b ] ]
   output ( list  - item 1 :a item 1 :b
                  - item 2 :a item 2 :b
                  - item 3 :a item 3 :b ) ]

make "vscale [
   procedure [ [ :a :b ] ]
   output ( list  * item 1 :a :b
                  * item 2 :a :b
                  * item 3 :a :b ) ]

; *********************************************************************
;  Names defined for 3-D turtles.

make "turtle-3d-stuff   [  turtle3 prep3turtle yaw roll pitch fd3 bk3
      setpos3 cw3 movepos3 home3 clean3 -v rotate vadd vsub vscale
      turtle-3d-stuff ]

bury :turtle-3d-stuff

; *********************************************************************

;  Some examples of weeds in 3D turtle graphics.

; *********************************************************************
;  gyp         size
;     Gypsopphila, babies breath. Gyp uses pens 6 and 7 for stems, and pen
;     3 for flowers.
;  gyp 35

make "gyp [
   procedure [ [ :d ] [ ] [ :p :h :l :u :a :z ] ]
   if < :d 4.3 [ gypbloom stop ] [ ]
   make "p :scr-t3pos
   make "h :scr-t3h
   make "l :scr-t3l
   make "u :scr-t3u
   setpen :scr-t3wp + 6 random 2
   fd3 :d
   repeat 3 [
      make "a random 90
      make "z + 20 random 25
      roll :a
      pitch :z
      gyp * :d + 0.54 * 0.25 rand
      pitch +- :z
      roll - 120 :a ]
   movepos3 :p
   make "scr-t3h :h
   make "scr-t3l :l
   make "scr-t3u :u ]

make "gypbloom [
   procedure [ ]
   setpen :w1 if = 1 random 4 [ 4 ] [ 3 ]
   fd3 1.5
   bk3 1.5 ]

; *********************************************************************
;  fern3       size size-limit back-curl side-curl
;              twist thickness node-spacing
;     A fern leaf.
;  fern3 90 3 2 1 1 0.3 0.18

make "fern3 [
   procedure [ [ :size :limit :bcurl :scurl :twist :thick :nspace ] [ ]
               [ :d1 :d2 :a1 :p :h :l :u ] ]
   make "d1 * :size :nspace
   make "d2 * - 1 :nspace :size
   make "p :scr-t3pos
   make "h :scr-t3h
   make "l :scr-t3l
   make "u :scr-t3u
   fd3 :d1
   roll :twist
   yaw :scurl
   if > :limit :size
   [  make "a1 atan / :thick - 1 :nspace
      fd3 :d2
      yaw :a1
      bk3 :d2
      fd3 :d2
      yaw ( - 0 :a1 :a1 )
      bk3 :d2 ]
   [  pitch :bcurl
      fern3 :d2 :limit :bcurl :scurl :twist :thick :nspace
      pitch +- :bcurl
      yaw 60
      pitch +- :bcurl
      fern3 * :thick :size :limit :bcurl :scurl :twist :thick :nspace
      pitch :bcurl
      yaw -120
      pitch +- :bcurl
      fern3 * :thick :size :limit :bcurl :scurl :twist :thick :nspace ]
   movepos3 :p
   make "scr-t3h :h
   make "scr-t3l :l
   make "scr-t3u :u ]

; *********************************************************************
;  daisy       size petals height
;     A Gerbera daisy. Daisy uses pen 6 for the stem, pens 8 and 9 for the
;     center, pens 10 and 11 for under sides of petals, and pens 12 - 15
;     for the tops of the petals.
;  daisy 25 30 70

make "daisy [
   procedure [ [ :size :petals :height ] [ ]
               [ :a :d  :p :h :l :u ] ]
   make "p :scr-t3pos
   make "h :scr-t3h
   make "l :scr-t3l
   make "u :scr-t3u
   setpen :scr-t3wp 6
   make "d / :height 12
   make "a * 0.8 + 0.5 rand
   roll random 360
   repeat 12 [
      fd3 :d
      yaw :a ]
   pitch * 8 rand
   yaw * 8 rand
   daisybloom :size :petals
   movepos3 :p
   make "scr-t3h :h
   make "scr-t3l :l
   make "scr-t3u :u ]

make "daisybloom [
   procedure [ [ :size :petals ] [ ]
               [ :turn :rp :ry :s :p :h :l :u ] ]
   make "p :scr-t3pos
   make "h :scr-t3h
   make "l :scr-t3l
   make "u :scr-t3u
   if >0 last :scr-t3h
   [  make "turn / 360 :petals         ;  Top of daisy.
      repeat :petals
      [  roll :turn
         make "rp + 82.5 * 5 rand
         make "ry - 2.5 * 5 rand
         pitch :rp
         yaw :ry
         setpen :scr-t3wp + 12 random 4
         daisypetal * 0.9 + * 0.2 rand :size
         yaw +- :ry
         pitch +- :rp ]
      repeat * 2 + :size :petals
      [  setpen :scr-t3wp if > 50 random 100 [ 8 ] [ 9 ]
         roll random 360
         make "rp + 80 * 4 rand
         make "s ( * 0.07 + 2.5 rand :size + 0.3 sin :rp )
         pitch :rp
         fd3 :s
         bk3 :s
         pitch +- :rp ]
      repeat * 2 + :size :petals
      [  setpen :scr-t3wp if > 40 random 100 [ 8 ] [ 9 ]
         roll random 360
         make "rp * 84 rand
         make "s ( * 0.07 + 2.5 rand :size + 0.3 sin :rp )
         pitch :rp
         fd3 :s
         bk3 :s
         pitch +- :rp ]
   ]
   [  make "turn / 360 :petals         ;  Buttom of daisy.
      repeat :petals
      [  roll :turn
         make "rp + 82.5 * 5 rand
         make "ry - 2.5 * 5 rand
         pitch :rp
         yaw :ry
         setpen :scr-t3wp + 10 random 2
         daisypetal * 0.9 + * 0.2 rand :size
         yaw +- :ry
         pitch +- :rp ]
      bk3 * 0.2 :size
      repeat * 3 + :size :petals
      [  setpen :scr-t3wp + 4 random 4
         make "s ( * 0.09 + 2.5 rand :size )
         roll random 360
         make "rp + 45 * 2 rand
         pitch :rp
         fd3 :s
         bk3 :s
         pitch +- :rp ]
   ]
   movepos3 :p
   make "scr-t3h :h
   make "scr-t3l :l
   make "scr-t3u :u ]

make "daisypetal [
   procedure [ [ :size ] [ ] [ :step-size ] ]
   fd3 * 0.2 :size
   yaw 5.5
   make "step-size * 0.08 :size
   arc :step-size 4
   yaw -1.3
   arc :step-size 6.5      ; + 2.5
   yaw -1.2
   arc :step-size 8        ; + 1.5
   yaw -1
   arc :step-size 9        ; + 1
   yaw -0.9
   arc :step-size 9.7      ; + 0.7
   yaw -0.6
   arc :step-size 9.9      ; + 0.2
   yaw -0.5
   arc :step-size 10       ; + 0.1
   yaw -0.5
   arc :step-size 9.9      ; + 0.2
   yaw -0.6
   arc :step-size 9.7
   yaw -0.9
   arc :step-size 9
   yaw -1
   arc :step-size 8
   yaw -1.2
   arc :step-size 6.5
   yaw -1.3
   arc :step-size 4
   yaw 5.5
   bk3 * 0.2 :size ]

make "arc [
   procedure [ [ :size :steps ] ]
   repeat :steps [ fd3 :size pitch 1 ]
   fd3 * frac :steps :size
   bk3 * frac :steps :size
   repeat :steps [ pitch -1 bk3 :size ] ]

; *********************************************************************
;  bouquet
;     A handful of weeds. This takes hours to run.

make "bouquet [
   procedure [ [ ] [ ] [ :a :h :r ] ]
   ( turtle3 4 )
   setrgb :s1 0 [ 0 0 0 ]           ;  Set screens colors.
   setrgb :s1 1 [ 12 12 12 ]
   setrgb :s1 2 [ 12 0 0 ]
   setrgb :s1 3 [ 15 15 15 ]
   setrgb :s1 4 [ 0 15 3 ]
   setrgb :s1 5 [ 0 13 1 ]
   setrgb :s1 6 [ 1 11 0 ]
   setrgb :s1 7 [ 3 8 0 ]
   setrgb :s1 8 [ 10 4  0 ]
   setrgb :s1 9 [ 14 12 1 ]
   setrgb :s1 10 [ 15 6 2 ]
   setrgb :s1 11 [ 15 5 4 ]
   setrgb :s1 12 [ 14 2 0 ]
   setrgb :s1 13 [ 14 3 0 ]
   setrgb :s1 14 [ 15 1 0 ]
   setrgb :s1 15 [ 15 2 2 ]
   setpen :scr-t3wp 0               ;  Set position.
   yaw 30
   pitch 30
   bk3 60
   repeat + 5 random 3              ;  Ferns.
   [  roll random 360
      make "a + 35 * 30 rand
      make "r random 360
      yaw :a
      roll :r
      setpen :scr-t3wp + 5 random 3
      fern3    + 60 random 60
               3
               + 1 * 2 rand
               - rand rand
               - rand rand
               + 0.28 * 0.04 rand
               + 0.16 * 0.04 rand
      roll +- :r
      yaw +- :a ]
   repeat + 4 random 3              ;  Babies breath.
   [  roll random 360
      make "a * 35 rand
      yaw :a
      gyp + 20 random 15
      yaw +- :a ]
                                    ;  Flowers.
   repeat + 3 random 3 [ make "h fput + 75 random 45 :h ]
   make "h sort "< :h
   while [ not emptyp :h ]
   [  roll random 360
      make "a + 5 * 25 rand
      yaw :a
      daisy + 22 random 10 + 35 random 20 first :h
      yaw +- :a
      make "h bf :h ] ]