added extrusion test code
This commit is contained in:
parent
a013bb0508
commit
fe0c0f0aab
3 changed files with 235 additions and 11 deletions
213
plant-eyes/extrude.scm
Normal file
213
plant-eyes/extrude.scm
Normal file
|
@ -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))
|
|
@ -8,16 +8,12 @@
|
||||||
|
|
||||||
; notes:
|
; 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:
|
; the hexagon game. the main advantages:
|
||||||
; - just a divide and conquer strategy for staying sane
|
; - 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
|
; - the logic can be ticked at a lower frequency - or even different
|
||||||
; parts at different rates, whereas the renderer side needs ticking every
|
; parts at different rates, whereas the view needs ticking every frame
|
||||||
; 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
|
|
||||||
;
|
;
|
||||||
; * need to try to keep all the intensive 'every thing vs every thing' checking
|
; * 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
|
; 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
|
; * using a message passing system to formalise the passing of information on
|
||||||
; the logic side. this makes it possible to have objects sending messages
|
; the logic side. this makes it possible to have objects sending messages
|
||||||
; at any point, and have them automatically collected up and dispatched to
|
; 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
|
; * 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)
|
; 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
|
(define debug-messages #f) ; prints out all the messages sent to the renderer
|
||||||
|
|
||||||
|
@ -341,8 +340,6 @@
|
||||||
|
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define game-logic%
|
(define game-logic%
|
||||||
(class game-logic-object%
|
(class game-logic-object%
|
||||||
(field
|
(field
|
||||||
|
|
14
plant-eyes/ribbontest.scm
Normal file
14
plant-eyes/ribbontest.scm
Normal file
|
@ -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"))
|
Loading…
Reference in a new issue