#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) (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 (vector (car width) (car width) (car width))))) (car path)) v)))) (define (extrude-segment-grow index profile path width lv up t) (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)) t)))) (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))) (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 (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 (partial-extrude p t v profile path width up) (with-primitive p 0 (let* ((T (floor t)) (t (- t T)) (seg-len (length profile)) (start (* T seg-len)) (end (* (length path) seg-len)) (v (extrude-segment start profile (chop-front path T) (chop-front width T) v up))) (when (< T (- (length path) 1)) ; extrude the next segment (extrude-segment (+ start seg-len) profile (chop-front path (+ T 1)) (chop-front width (+ T 1)) v up) ; and now blend it back by using both segments to t (for ((i (in-range (+ start seg-len) (+ start (* 2 seg-len))))) (pdata-set! "p" i (vmix (pdata-ref "p" i) (pdata-ref "p" (- i seg-len)) t))) ; collapse the yet un-extruded part into the last vert (for ((i (in-range (+ start (* seg-len 2)) end))) (pdata-set! "p" i (pdata-ref "p" (+ seg-len start))))) (recalc-normals 0) v))) (define (partial-extrude-grow p t v profile path width up) (with-primitive p 0 (let* ((T (floor t)) (t (- t T)) (seg-len (length profile)) (start (* T seg-len)) (end (* (length path) seg-len)) (v (extrude-segment-grow start profile (chop-front path T) (chop-front width T) v up t))) (when (< T (- (length path) 1)) ; extrude the next segment (extrude-segment-grow (+ start seg-len) profile (chop-front path (+ T 1)) (chop-front width (+ T 1)) v up 0) ; and now blend it back by using both segments to t (for ((i (in-range (+ start seg-len) (+ start (* 2 seg-len))))) (pdata-set! "p" i (vmix (pdata-ref "p" i) (pdata-ref "p" (- i seg-len)) t))) ; collapse the yet un-extruded part into the last vert (for ((i (in-range (+ start (* seg-len 2)) end))) (pdata-set! "p" i (pdata-ref "p" (+ seg-len 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) (clear-colour 0.5) (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 width (build-list 100 (lambda (n) (* 0.5 (+ 1 (sin (* 0.3 n))))))) (define path (build-list 100 (lambda (n) (vmul (vector (sin (* 0.05 n)) 0 (cos (* 0.05 n))) (+ 0.5 (* 0.2 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 1))) (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 v (vector 0 0 0)) (define (animate) (set! v (partial-extrude-grow p (fmod (* 2 (flxtime)) (length path)) v profile path width (vector 0 1 0)))) (every-frame (animate))