(define (draw-profile index profile offset)
    (cond ((not (null? profile))
            (pdata-set! "p" index (vadd (car profile) offset))
            (draw-profile (+ index 1) (cdr profile) offset))))


(define (transform-profile profile m)
    (cond
        ((null? profile) '())
        (else
            (cons (vtransform (car profile) m) 
                (transform-profile (cdr profile) m)))))

; figures out the vector for rotation of the profile
(define (path-vector first-segment path lv)
    (let* ((v (if (null? (cdr path))        ; last segment?
                    lv                      ; use the last vector used
                    (vsub (cadr path) (car path)))) ; use the next point
            (vd (if first-segment v          ; first segment?
                    (vadd (vmul lv 0.5) ; blend with the last vector
                        (vmul v 0.5)))))
        vd))

(define (extrude-segment index profile path lv)
    (cond ((not (null? path))
            (let ((v (path-vector (zero? index) path lv)))                
                (draw-profile index (transform-profile profile 
                        (mmul
                            (maim v (vector 0 1 0))
                            (mrotate (vector 0 90 0))))
                    (car path))
                v))))

(define (mmix a b t)
    (vector 
        (+ (* (vector-ref a 0) (- 1 t)) (* (vector-ref b 0) t))
        (+ (* (vector-ref a 1) (- 1 t)) (* (vector-ref b 1) t))
        (+ (* (vector-ref a 2) (- 1 t)) (* (vector-ref b 2) t))
        (+ (* (vector-ref a 3) (- 1 t)) (* (vector-ref b 3) t))
        (+ (* (vector-ref a 4) (- 1 t)) (* (vector-ref b 4) t))
        (+ (* (vector-ref a 5) (- 1 t)) (* (vector-ref b 5) t))
        (+ (* (vector-ref a 6) (- 1 t)) (* (vector-ref b 6) t))
        (+ (* (vector-ref a 7) (- 1 t)) (* (vector-ref b 7) t))
        (+ (* (vector-ref a 8) (- 1 t)) (* (vector-ref b 8) t))
        (+ (* (vector-ref a 9) (- 1 t)) (* (vector-ref b 9) t))
        (+ (* (vector-ref a 10) (- 1 t)) (* (vector-ref b 10) t))
        (+ (* (vector-ref a 11) (- 1 t)) (* (vector-ref b 11) t))
        (+ (* (vector-ref a 12) (- 1 t)) (* (vector-ref b 12) t))
        (+ (* (vector-ref a 13) (- 1 t)) (* (vector-ref b 13) t))
        (+ (* (vector-ref a 14) (- 1 t)) (* (vector-ref b 14) t))
        (+ (* (vector-ref a 15) (- 1 t)) (* (vector-ref b 15) t))))

(define (extrude-segment-blend index profile path lv t)
    (cond ((not (null? path))
            ; figure out the vector for rotation of the profile
            (let ((v (path-vector (zero? index) path v)))
                (cond ((null? (cdr path))
                        (draw-profile index (transform-profile profile 
                                (mmul
                                    (maim v (vector 0 1 0))
                                    (mrotate (vector 0 90 0))))
                            (car path)))
                    (else
                        (let ((v2 (path-vector (zero? index) (cdr path) v)))
                            (draw-profile index (transform-profile profile 
                                    (mmul
                                        (maim (vmix (vnormalise v) (vnormalise v2) t) (vector 0 1 0))
                                        (mrotate (vector 0 90 0))))
                                (vmix (car path) (vadd (car path) v2) t)))))
                v))))


(define (extrude index profile path lv)
    (cond ((not (null? path))
            (let ((v (extrude-segment index profile path lv)))
                (extrude (+ index (length profile)) profile (cdr path) v)))))

(define (stitch-face index count profile-size in)
    (cond 
        ((eq? 1 count) 
            (append in (list (+ (- index profile-size) 1) index (+ index profile-size) 
                    (+ (- index profile-size) 1 profile-size))))
        (else
            (append 
                (list (+ index 1) index
                    (+ index profile-size) (+ index profile-size 1))
                (stitch-face (+ index 1) (- count 1) profile-size in)))))

(define (stitch-indices index profile-size path-size in)
    (cond 
        ((eq? 1 path-size) in)
        (else
            (append
                (stitch-face index profile-size profile-size '())
                (stitch-indices (+ index profile-size) 
                    profile-size
                    (- path-size 1)
                    in)))))

(define (build-extrusion profile path)
    (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
        (with-primitive p
            (poly-set-index (stitch-indices 0 (length profile) (length path) '()))
            (extrude 0 profile path (vector 0 0 0))
            (recalc-normals 0))
        p))

; partial extrusions are for animating

(define (build-partial-extrusion profile path)
    (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
        (with-primitive p
            (poly-set-index (stitch-indices 0 (length profile) (length path) '())))
        p))

(define (chop-front l n)
    (cond ((null? l) l)
        (else
            (if (zero? n) (cons (car l) (chop-front (cdr l) n))
                (chop-front (cdr l) (- n 1))))))

; returns the last vector
(define (partial-extrude p t v profile path)
    (with-primitive p 0
        
        (let* ((start (* (floor t) (length profile)))
                (end (* (length path) (length profile)))
                (v (extrude-segment start profile 
                        (chop-front path (floor t)) v)))
            
            (when (< t (- (length path) 1))
                (for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
                    (pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile))) 
                            (vmul v (- (floor t) t)))))
                
                ; collapse the yet un-extruded part into the last vert
                (for ((i (in-range (+ start (* (length profile) 2)) end)))
                    (pdata-set! "p" i (pdata-get "p" (+ (length profile) start)))))
            
            (recalc-normals 0)
            v)))

#;(define (partial-extrude p t v profile path)
    (with-primitive p 0
        
        (let* ((start (* (floor t) (length profile)))
                (end (* (length path) (length profile)))
                (v (extrude-segment-blend start profile 
                        (chop-front path (floor t)) v (- (floor t) t))))
            
            (when (< t (- (length path) 1))
                #;(for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
                    (pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile))) 
                            (vmul v (- (floor t) t)))))
                
                ; collapse the yet un-extruded part into the last vert
                (for ((i (in-range (+ start (* (length profile) 1)) end)))
                    (pdata-set! "p" i (pdata-get "p" start))))
            
            (recalc-normals 0)
            v)))

(define (build-circle-profile n r)
    (define (_ n c l)
        (cond ((zero? c) l)
            (else
                (let ((a (* (/ c n) (* 2 3.141))))                 
                    (_ n (- c 1) 
                        (cons (vmul (vector (sin a) (cos a) 0) r) l))))))
    (_ n n '()))

(clear)

(define l (make-light 'point 'free))
(light-diffuse 0 (vector 0 0 0))
(light-diffuse l (vector 1 1 1))
(light-position l (vector 50 50 0))
(light-specular l (vector 1 1 1))

(define profile (build-circle-profile 12 0.5))

(define path (build-list 50
        (lambda (n) (vmul (vector (sin (* 0.5 n)) 0 (cos (* 0.5 n))) (+ 0.5 (* 0.2 n))))))

#;(define path (build-list 10
        (lambda (n) (vector (* 10 (rndf)) 0 (* 3 n)))))

(define p (with-state
;        (hint-wire) 
        (colour (vector 0 0.5 0.5))   
        (specular (vector 1 1 1))
        (shinyness 20)
        (build-partial-extrusion profile path)))

(define v (vector 0 0 0))

(define (animate)
    (set! v (partial-extrude p (fmod (* 2 (time)) (length path)) v profile path)))

(every-frame (animate))


(with-state
    (wire-opacity 0.4)
    (translate (vector 0 0 0))
        (wire-colour (vector 0 0 1))
    (hint-none)
    (hint-wire)
;    (hint-normal)
    (backfacecull 1)
    (point-width 5)
    (build-extrusion profile path))