diff options
Diffstat (limited to 'sly/scene.scm')
| -rw-r--r-- | sly/scene.scm | 68 |
1 files changed, 11 insertions, 57 deletions
diff --git a/sly/scene.scm b/sly/scene.scm index e3f00c3..bb748ca 100644 --- a/sly/scene.scm +++ b/sly/scene.scm @@ -47,10 +47,6 @@ (position scene-node-position) (scale scene-node-scale) (rotation scene-node-rotation) - (prev-position scene-node-prev-position set-scene-node-prev-position!) - (prev-scale scene-node-prev-scale set-scene-node-prev-scale!) - (prev-rotation scene-node-prev-rotation set-scene-node-prev-rotation!) - (transform scene-node-transform set-scene-node-transform!) (uniforms scene-node-uniforms) (children scene-node-children)) @@ -61,75 +57,33 @@ (uniforms '()) (children '()) #:allow-other-keys) - (let ((node (%make-scene-node position scale rotation uniforms children))) - (update-scene-node node) - (recompute-transform! node 0) - node)) + (%make-scene-node position scale rotation uniforms children)) (define-syntax-rule (scene-node (field val) ...) (apply make-scene-node (append (list (symbol->keyword 'field) val) ...))) -(define (scene-node-dirty? node) - (define (different? a b) - (not (equal? (a node) (b node)))) - - (or (different? scene-node-position scene-node-prev-position) - (different? scene-node-scale scene-node-prev-scale) - (different? scene-node-rotation scene-node-prev-rotation))) - -(define (scene-root . children) - (make-scene-node #:children children)) - -(define (update-scene-node node) - (signal-let ((node node)) - (when (scene-node? node) - (signal-let ((position (scene-node-position node)) - (scale (scene-node-scale node)) - (rotation (scene-node-rotation node)) - (children (scene-node-children node))) - (set-scene-node-prev-position! node position) - (set-scene-node-prev-scale! node scale) - (set-scene-node-prev-rotation! node rotation) - (for-each update-scene-node children))))) - (define (interpolate current prev alpha) (if (or (not prev) (equal? current prev)) current (vector-interpolate prev current alpha))) -(define (recompute-transform! node alpha) - (signal-let ((position (scene-node-position node)) - (%scale (scene-node-scale node)) - (rotation (scene-node-rotation node))) - (let ((t (transform* - (translate - (interpolate position - (scene-node-prev-position node) - alpha)) - (quaternion->transform - (quaternion-slerp rotation - (scene-node-prev-rotation node) - alpha)) - (scale (interpolate %scale - (scene-node-prev-scale node) - alpha))))) - (set-scene-node-transform! node t) - t))) - (define* (draw-scene-node node alpha transform #:optional (uniforms '())) (signal-let ((node node)) (if (mesh? node) (draw-mesh node `(("mvp" ,transform) ,@uniforms)) - (let ((transform - (transform* transform - (if (scene-node-dirty? node) - (recompute-transform! node alpha) - (scene-node-transform node))))) - (signal-let ((children (scene-node-children node))) - (for-each (cut draw-scene-node <> alpha transform + (signal-let ((children (scene-node-children node)) + (position (scene-node-position node)) + (%scale (scene-node-scale node)) + (rotation (scene-node-rotation node))) + (let ((node-transform (transform* + (translate position) + (scale %scale) + (quaternion->transform rotation)))) + (for-each (cut draw-scene-node <> alpha + (transform* transform node-transform) (scene-node-uniforms node)) children)))))) |