summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-03-12 17:53:41 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-03-12 17:53:41 -0400
commitbfb137179b5662f897fa606022875cc6797006b3 (patch)
tree5608b52c1ca9a2f3a5fd996febaf3642d30cbbde
parent9049e845387b3734f2d1969e89fbb3283a584ec4 (diff)
render: context: Rewrite transform stack.
* sly/render/context.scm (with-temp-transform): Delete. (render-context-transform, render-context-transform*!, render-context-transform-identity!, render-context-push-transform!, render-context-pop-transform!, copy-transform!): New procedures. (with-transform-excursion): New syntax. (render-context-reset!): Set top of matrix stack to identity matrix.
-rw-r--r--sly/render/context.scm45
-rw-r--r--sly/render/model.scm33
2 files changed, 53 insertions, 25 deletions
diff --git a/sly/render/context.scm b/sly/render/context.scm
index 1e23f17..e3ccd21 100644
--- a/sly/render/context.scm
+++ b/sly/render/context.scm
@@ -36,12 +36,15 @@
#:use-module (sly render mesh)
#:export (make-render-context
render-context?
- with-render-context with-temp-transform
+ with-render-context
render-context-blend-mode set-render-context-blend-mode!
render-context-depth-test? set-render-context-depth-test?!
render-context-texture set-render-context-texture!
render-context-shader set-render-context-shader!
- render-context-mesh set-render-context-mesh!))
+ render-context-mesh set-render-context-mesh!
+ render-context-transform render-context-transform*!
+ render-context-transform-identity!
+ with-transform-excursion))
(define-record-type <gl-parameter>
(%make-gl-parameter default bind value)
@@ -97,7 +100,8 @@
(gl-parameter-reset! (render-context-depth-test? context))
(gl-parameter-reset! (render-context-texture context))
(gl-parameter-reset! (render-context-shader context))
- (gl-parameter-reset! (render-context-mesh context)))
+ (gl-parameter-reset! (render-context-mesh context))
+ (render-context-transform-identity! context))
(define-syntax-rule (with-render-context context body ...)
(begin (render-context-reset! context)
@@ -123,9 +127,32 @@
(define-context-setter set-render-context-mesh!
render-context-mesh)
-;; emacs: (put 'with-temp-transform 'scheme-indent-function 2)
-(define-syntax-rule (with-temp-transform context name body ...)
- (let* ((stack (render-context-transform-stack context))
- (name (q-pop! stack)))
- (begin body ...)
- (q-push! stack name)))
+(define (render-context-transform context)
+ (q-front (render-context-transform-stack context)))
+
+(define (render-context-push-transform! context t)
+ (q-push! (render-context-transform-stack context) t))
+
+(define render-context-pop-transform!
+ (compose q-pop! render-context-transform-stack))
+
+(define (copy-transform! src dest)
+ (array-copy! (transform-matrix src) (transform-matrix dest)))
+
+;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1)
+(define-syntax-rule (with-transform-excursion context body ...)
+ (let ((t (render-context-pop-transform! context)))
+ (dynamic-wind
+ (lambda ()
+ (copy-transform! t (render-context-transform context)))
+ (lambda () body ...)
+ (lambda ()
+ (render-context-push-transform! context t)))))
+
+(define (render-context-transform*! context t)
+ (let ((dest (render-context-transform context)))
+ (with-transform-excursion context
+ (transform*! dest (render-context-transform context) t))))
+
+(define (render-context-transform-identity! context)
+ (copy-transform! identity-transform (render-context-transform context)))
diff --git a/sly/render/model.scm b/sly/render/model.scm
index 01c1223..fdda5ed 100644
--- a/sly/render/model.scm
+++ b/sly/render/model.scm
@@ -121,39 +121,40 @@ changing the fields specified in KWARGS."
"Render MODEL by applying its transform (multiplied by VIEW), texture,
shader, vertex array, uniforms, blend mode, etc. to the render
CONTEXT."
- (define (iter model world-transform view context)
+ (define (iter model view context)
(match model
- (($ <model> mesh transform texture shader color blend-mode
+ (($ <model> mesh local-transform texture shader color blend-mode
depth-test? children)
- (with-temp-transform context new-transform
- (transform*! new-transform transform world-transform)
- (with-temp-transform context mvp
- (transform*! mvp new-transform view)
+ (with-transform-excursion context
+ (render-context-transform*! context local-transform)
+ (with-transform-excursion context
+ (render-context-transform*! context view)
(set-render-context-depth-test?! context depth-test?)
(set-render-context-blend-mode! context blend-mode)
(set-render-context-shader! context shader)
(set-render-context-mesh! context mesh)
(set-render-context-texture! context texture)
;; TODO: Support user-defined uniforms.
- (uniform-set! shader "mvp" mvp)
+ (uniform-set! shader "mvp" (render-context-transform context))
(uniform-set! shader "color" color)
(glDrawElements (begin-mode triangles)
(mesh-length mesh)
(data-type unsigned-int)
%null-pointer))
(for-each (lambda (child)
- (iter child new-transform view context))
+ (iter child view context))
children)))))
(with-render-context context
- (with-temp-transform context view
- (transform*! view
- (camera-location camera)
- (camera-projection camera))
- (with-temp-transform context base-transform
- (set-transform-identity! base-transform)
- (apply-viewport (camera-viewport camera))
- (iter model base-transform view context)))))))
+ (with-transform-excursion context
+ (let ((view (render-context-transform context)))
+ (transform*! view
+ (camera-location camera)
+ (camera-projection camera))
+ (with-transform-excursion context
+ (render-context-transform-identity! context)
+ (apply-viewport (camera-viewport camera))
+ (iter model view context))))))))
;;;
;;; Utility Procedures