From bfb137179b5662f897fa606022875cc6797006b3 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 12 Mar 2015 17:53:41 -0400 Subject: 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. --- sly/render/context.scm | 45 ++++++++++++++++++++++++++++++++++++--------- sly/render/model.scm | 33 +++++++++++++++++---------------- 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 (%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 - (($ mesh transform texture shader color blend-mode + (($ 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 -- cgit v1.2.3