groworld/plant-eyes/test-scripts/extrude.scm

;#lang scheme
;(require fluxus-016/drflux)

; extrusion code

(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 width lv up size)
    (cond ((not (null? path))
            (let ((v (path-vector (zero? index) path lv)))                
                (draw-profile index (transform-profile profile 
                        (mmul
                            (maim v up)
                            (mrotate (vector 0 90 0))
                            (mscale (vmul (vector (car width) (car width) (car width)) size))))
                    (car path))
                v))))

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

(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-tex-coords profile-size path-size vscale)
    (pdata-index-map!
        (lambda (i t)
            (vector (* vscale (/ (quotient i profile-size) path-size))
                (/ (modulo i profile-size) profile-size) 0))
        "t"))

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

; partial extrusions are for animating

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

(define (partial-extrude t profile path width up grow)
    (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))))))
    
    (define (collapse-front)
        (let ((start (* (floor t) (length profile))))
            (for ((i (in-range (+ start (* (length profile) 1)) (pdata-size))))
                (pdata-set! "p" i (pdata-ref "p" start)))))
    
    (define (scale-front)
        (when (> t 1)
            (let* ((start (* (floor t) (length profile)))
                    (from (list-ref path (- (inexact->exact (floor t)) 1)))
                    (to (list-ref path (+ (inexact->exact (floor t)) 0))))
                
                (for ((i (in-range start (+ start (length profile)))))
                    (pdata-set! "p" i (vmix (pdata-ref "p" i)
                        (vmix to from (- t (floor t))) (- t (floor t))))))))
    

    (define (_ t v g)
        (cond 
            ((< t 1) (with-primitive p (recalc-normals 0)) v)
            (else
                (let ((start (* (floor t) (length profile))))
                    (_ (- t 1)
                        (extrude-segment start profile
                            (chop-front path (floor t))
                            (chop-front width (floor t)) v up 
                            (if (< g 1)
                                (+ g (* (- t (floor t)) grow))
                                g))
                        (if (< g 1)
                            (+ g grow)
                            1))))))
    (_ t (vector 0 0 0) 0)
    (scale-front)
    (collapse-front)
)

(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)
(clear-colour 0.5)
(define profile (build-circle-profile 12 0.5))

(define width (build-list 100
        (lambda (n) (* n 0.01 (+ 1.5 (cos (* 0.5 n)))))))

(define path (build-list 100
        (lambda (n) (vmul (vector (sin (* 0.2 n)) 0 (cos (* 0.2 n))) (* 0.05 n)))))

(define p (with-state
        (wire-colour 0)
;        (colour (vector 0.5 0.3 0.2))   
        (colour (vector 1 1 1))   
        (specular (vector 1 1 1))
        (shinyness 20)
        (hint-wire)
    (texture (load-texture "textures/root.png"))
        (build-partial-extrusion profile path 10)))

#;(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 width 1 (vector 0 1 0))) 

(define t 0)

(define (animate)
    (with-primitive p
        (partial-extrude 
            (* (* 0.5 (+ 1 (sin (* 0.2 t)))) (length path)) 
            profile path width (vector 0 1 0) 0.05)
        (set! t (+ t 0.01))))

(every-frame (animate))


(end-framedump)
;(start-framedump "ext-" "jpg")