From fe0c0f0aabcbe21d8c05571bf7e15ba943c156d4 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Thu, 25 Jun 2009 11:18:37 +0100 Subject: [PATCH] added extrusion test code --- plant-eyes/extrude.scm | 213 ++++++++++++++++++++++++++++++++ plant-eyes/plant-eyes-logic.scm | 19 ++- plant-eyes/ribbontest.scm | 14 +++ 3 files changed, 235 insertions(+), 11 deletions(-) create mode 100644 plant-eyes/extrude.scm create mode 100644 plant-eyes/ribbontest.scm diff --git a/plant-eyes/extrude.scm b/plant-eyes/extrude.scm new file mode 100644 index 0000000..b9913f7 --- /dev/null +++ b/plant-eyes/extrude.scm @@ -0,0 +1,213 @@ + +(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)) \ No newline at end of file diff --git a/plant-eyes/plant-eyes-logic.scm b/plant-eyes/plant-eyes-logic.scm index f3a178b..a44c10d 100644 --- a/plant-eyes/plant-eyes-logic.scm +++ b/plant-eyes/plant-eyes-logic.scm @@ -8,16 +8,12 @@ ; notes: ; -; * keeping with a render/logic separation, although this is quite different to +; * keeping with a view/logic separation, although this is quite different to ; the hexagon game. the main advantages: ; - just a divide and conquer strategy for staying sane -; - able to debug the logic without the renderer, or vice versa +; - able to debug the logic without the view, or vice versa ; - the logic can be ticked at a lower frequency - or even different -; parts at different rates, whereas the renderer side needs ticking every -; frame -; -; * the view just knows about line segments for branches/roots, so these can be -; created in any way in the logic side - lsystem, etc - or different ways +; parts at different rates, whereas the view needs ticking every frame ; ; * need to try to keep all the intensive 'every thing vs every thing' checking ; in the logic side, where it can be done over many frames (i'm thinking the @@ -27,11 +23,14 @@ ; * using a message passing system to formalise the passing of information on ; the logic side. this makes it possible to have objects sending messages ; at any point, and have them automatically collected up and dispatched to -; the renderer side +; the view ; ; * line segments are computed in the logic side, and can be represented any -; way by the renderer - maybe the players plant will be geometry and everyone +; way by the view - maybe the players plant will be geometry and everyone ; elses will be ribbons (stoopid LOD) +; +; * in the same way, the line segments can be created in any way by the logic +; side - eg. lsystem, or different methods per plant (or per twig even) (define debug-messages #f) ; prints out all the messages sent to the renderer @@ -341,8 +340,6 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - (define game-logic% (class game-logic-object% (field diff --git a/plant-eyes/ribbontest.scm b/plant-eyes/ribbontest.scm new file mode 100644 index 0000000..5949067 --- /dev/null +++ b/plant-eyes/ribbontest.scm @@ -0,0 +1,14 @@ +(clear) +(clear-colour 0.5) +(define p (build-ribbon 20)) + +(with-primitive p + (translate (vector 1 0 0)) + (pdata-map! + (lambda (p) + (srndvec)) + "p") + (pdata-map! + (lambda (w) + 0.01) + "w")) \ No newline at end of file