; util functions
  
  
  ; deformation functions
  
  (define (deform-expand o amount)
    (define (inner n)
      (pdata-set "p" n (vadd (pdata-get "p" n) (vmul (pdata-get "n" n) amount))) 
      (if (zero? n)
          0
          (inner (- n 1))))
    (grab o)
    (inner (pdata-size))
    (ungrab))
  
  
  ; modelling functions
  
  (define extrude-verts 10)
  (define extrude-radius 0.1)
  (define extrude-tex-vincr 0.1)
  (define extrude-texv 0)
  
  (define (extrude-circle-shape-func deg dist pos)
    (turtle-turn (vector 0 deg 0))
    (turtle-move dist))
  
  (define extrude-shape-func extrude-circle-shape-func)
  
  (define (extrude-begin o)
    (turtle-attach o)
    (grab o)
    (turtle-reset)
    (set! extrude-texv 0))
  
  (define (extrude-end)
    (recalc-normals 1)
    (ungrab))
  
  (define (extrude-tex-vincr-set n)
    (set! extrude-tex-vincr n))
  
  (define (extrude-verts-set n)
    (set! extrude-verts n))
  
  (define (extrude-radius-set n)
    (set! extrude-radius n))
  
  (define (extrude-shape-func-set func)
    (set! extrude-shape-func func))
  
  (define (extrude-push)
    (define (inner n dist deg first)
      
      (let ((tx (vector (/ n extrude-verts) extrude-texv 0)))
        
        (cond 
          (first 
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (turtle-skip 1))
          ((zero? n)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert))
          (else
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (turtle-skip 2)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (turtle-skip 1))))
      
      (cond 
        ((zero? n)
         0)
        (else
         (extrude-shape-func deg dist n)
         (inner (- n 1) dist deg #f))))
    
    (turtle-move extrude-radius)
    (turtle-turn (vector 0 90 0))
    
    ; move the texture coordinates
    (set! extrude-texv (+ extrude-texv extrude-tex-vincr))
    (let ((p (turtle-position)))
      
      (let ((angle (/ 360 extrude-verts)))
        (inner extrude-verts (* (atan angle) extrude-radius) angle #t))
      (turtle-turn (vector 0 0 90))
      (turtle-move 1)
      (turtle-turn (vector 0 0 -90))
      (turtle-seek (+ p 1))))
  
  
  (define (extrude-pop)
    (define (inner n dist deg first)
      
      (let ((tx (vector (/ n extrude-verts) extrude-texv 0)))
        
        (cond
          (first
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (turtle-skip 2)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert))
          ((zero? n) 
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (pdata-set "t" (turtle-position) tx))
          (else
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (turtle-skip 1)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert)
           (turtle-skip 2)
           (pdata-set "t" (turtle-position) tx)
           (turtle-vert))))
      
      (cond 
        ((zero? n)
         0)
        (else
         (extrude-shape-func deg dist n)
         (inner (- n 1) dist deg #f))))
    
    ; move the texture coordinates
    (set! extrude-texv (+ extrude-texv extrude-tex-vincr))
    (let ((angle (/ 360 extrude-verts)))
      (inner extrude-verts (* (atan angle) extrude-radius) angle #t))
      
    (turtle-turn (vector 0 90 0))
    (turtle-move extrude-radius)
    (turtle-turn (vector 0 180 0)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (build-path path)
    (define (segment count angle)
        (extrude-push)
        (turtle-turn (vector angle 0 0))
        (extrude-pop)
        (if (zero? count)
            0
            (segment (- count 1) angle)))
    (define (loop-path l)
        (segment (car (car l)) (car (cdr (car l))))
        (if (null? (cdr l))
            0
            (loop-path (cdr l))))
    (loop-path path))

(define (make-shells obj n count dist col)
    (push)
    (colour col)
    (let ((shell (build-copy obj)))
    (pop)
    (deform-expand shell (* dist n))
    (if (eq? n count)
        0
        (make-shells obj (+ n 1) count dist (vmul col 1.1)))))

;---------------------------------------------------
(define time
'(
(15000000000 "Big Bang")
(13000000000 "Clusters of Galaxies")
(12000000000 "Milky Way Galaxy")
(11000000000 "Water")
(4700000000 "Solar System")
(4500000000 "Earth")
(4000000000 "Life")
(3900000000 "Cell Membrane")
(3800000000 "Chromosomes")
(3500000000 "Bacteria, Viruses")
(3000000000 "Oxygen") 
(2000000000 "Respiration") 
(1500000000 "Algae")
(1000000000 "Fungi") 
(700000000 "Sponges")
(650000000 "Jellyfish")
(570000000 "Ancestral Flatworms, Arthropods") 
(500000000 "Vertebrates")
(470000000 "Moss")
(450000000 "Lichen, Bony fish")
(390000000 "Sharks")
(380000000 "Insects")
(350000000 "Ferns, Amphibians") 
(300000000 "Seeds, Reptiles, Gondwanaland") 
(250000000 "Dinosaurs")
(200000000 "Fruiting Plants, Mammals")
(150000000 "Birds")
(65000000 "Meteorite strike")
(50000000 "Primates, Grasses") 
(40000000 "Cow Family")
(3000000 "Homo Erectus")
(700000 "Use of fire")
(200000 "Neanderthals")
(100000 "People")
(11000 "Nomads, Farmers")
(6000 "Cities")
(5000 "Kings and Peasants")
(3000 "Empires, Iron")
(2000 "Roman Empire") 
(1600 "Byzantium")
(1500 "Dark Ages")
(1400 "Islam")
(1000 "Middle Ages")
(550 "Renaissance Colonialism")
(450 "Copernicus")
(350 "Science")
(250 "Industrial Revolution")
(225 "Democracy")
(200 "Industrial Growth")
(150 "Communism")
(100 "New Industrial Nations")
(75 "Totalitarian Dictatorships")
(55 "Nuclear Weapons")
(0 "Now")
))

;---------------------------------------------------

(define years-per-vert 400)

(define (place-event event obj)
    (let ((vert (/ (car event) years-per-vert)))

    (grab obj)
    (cond
        ((< vert (pdata-size))
            (let ((pos (pdata-get "p" vert))
                  (dir (pdata-get "n" vert)))
            (ungrab)
        
            (push)
            (hint-unlit)

            (translate pos)
            (translate (vmul (vector (flxrnd) (flxrnd) (flxrnd)) 0.01))
     ;       (rotate (vector 180 0 0))
            (concat (maim dir (vector 0 1 0)))
            (translate (vector 0.2 0 0))
            (scale (vector 0.2 0.2 0.2))
            (build-text (car (cdr event)))
            (pop)))
        (else
            (ungrab)))))
    
(define (place-events events obj)
    (place-event (car events) obj)
    (if (null? (cdr events))
        0
        (place-events (cdr events) obj)))

;---------------------------------------------------

(clear)
(show-axis 1)
(turtle-reset)
;(hint-wire)
(fog (vector 1 1 1) 0.1 1 100)
(clip 0.4 100)
(backfacecull 1)
(clear-colour (vector 1 1 1))
;(scale (vector 20 20 20))

;(specular (vector 1 1 1))
;(shinyness 100)
(wire-colour (vector 1 1 1))
(push)
(colour (vector 1 1 1))
(define obj (build-polygons (* 5 5400) 'triangle-list))
(pop)

(define path '((5 0)(9 18)(5 0)(14 -12)
               (5 0)(9 18)(5 0)(14 -12)
               (5 0)(9 18)(5 0)(14 -12)
               (5 0)(9 18)(5 0)(14 -12)

               (25 0)(14 -12)
               (5 0)(9 18)(5 0)(14 -12)
               (5 0)(9 18)(5 0)(14 -12)
               (5 0)(9 18)(5 0)(14 -12)
               (5 0)(9 18);(5 0)(14 -12)

;               (25 0)(9 18)(5 0)(14 -12)
;               (5 0)(9 18)(5 0)(14 -12)
;               (5 0)(9 18)(5 0)(14 -12)
;               (5 0)(9 18)(5 0)(14 -12)
               

                ))

(extrude-radius-set 1)
(extrude-verts-set 12)

(extrude-begin obj)
(build-path path)
(extrude-end)


(push)
(hint-depth-sort)
(push)
(colour (vector 0 0 0))
(texture (load-texture "BitstreamVeraSansMonoBold.png"))
(place-events time obj)
(pop)

(grab obj)
;(poly-convert-to-indexed)
(ungrab)

(colour (vector 0.1 0.1 0.1))
(texture (load-texture "200000.png"))
;(hint-ignore-depth)
;(blend-mode 'one 'one)
(make-shells obj 0 10 0.02 (vector 0.2 0.2 0.2))
(pop)

(show-fps 0)
(desiredfps 100000)