diff options
| -rw-r--r-- | sly/render.scm | 44 | ||||
| -rw-r--r-- | sly/render/model.scm | 18 | ||||
| -rw-r--r-- | sly/render/scene.scm | 22 |
3 files changed, 49 insertions, 35 deletions
diff --git a/sly/render.scm b/sly/render.scm index c1d19e3..6ff7bb9 100644 --- a/sly/render.scm +++ b/sly/render.scm @@ -54,11 +54,15 @@ set-graphics-framebuffer! graphics-viewport set-graphics-viewport! - graphics-transform - graphics-transform-mul! - graphics-transform-identity! + graphics-model-view-transform + graphics-model-view-mul! + graphics-model-view-identity! + with-model-view-excursion + graphics-projection-transform + graphics-projection-mul! + graphics-projection-identity! + with-projection-excursion with-graphics - with-transform-excursion with-graphics-excursion)) ;;; @@ -84,9 +88,10 @@ (define (call-with-transform-excursion stack thunk) (let ((t (q-pop! stack))) (dynamic-wind + (const #t) (lambda () - (copy-transform! t (q-front stack))) - thunk + (copy-transform! t (q-front stack)) + (thunk)) (lambda () (q-push! stack t))))) @@ -180,20 +185,33 @@ body ... (graphics-reset! gfx))) -(define (graphics-transform gfx) +(define (graphics-model-view-transform gfx) (q-front (graphics-model-view gfx))) -(define (graphics-transform-mul! gfx t) +(define (graphics-model-view-mul! gfx t) (stack-transform-mul! (graphics-model-view gfx) t)) -(define (graphics-transform-identity! gfx) +(define (graphics-model-view-identity! gfx) (stack-transform-identity! (graphics-model-view gfx))) -;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1) -(define-syntax-rule (with-transform-excursion gfx body ...) +;; emacs: (put 'with-model-view-excursion 'scheme-indent-function 1) +(define-syntax-rule (with-model-view-excursion gfx body ...) (call-with-transform-excursion (graphics-model-view gfx) - (lambda () - body ...))) + (lambda () body ...))) + +(define (graphics-projection-transform gfx) + (q-front (graphics-projection gfx))) + +(define (graphics-projection-mul! gfx t) + (stack-transform-mul! (graphics-projection gfx) t)) + +(define (graphics-projection-identity! gfx) + (stack-transform-identity! (graphics-projection gfx))) + +;; emacs: (put 'with-projection-excursion 'scheme-indent-function 1) +(define-syntax-rule (with-projection-excursion gfx body ...) + (call-with-transform-excursion (graphics-projection gfx) + (lambda () body ...))) (define-syntax-rule (with-graphics-excursion gfx body ...) (match gfx diff --git a/sly/render/model.scm b/sly/render/model.scm index 77c550e..d18ace5 100644 --- a/sly/render/model.scm +++ b/sly/render/model.scm @@ -139,8 +139,8 @@ changing the fields specified in KWARGS." (define draw-sub-scene (delay (module-ref (resolve-interface '(sly render scene)) 'draw-scene))) -(define (draw-model model view gfx) - "Render MODEL by applying its transform (multiplied by VIEW), texture, +(define (draw-model model gfx) + "Render MODEL by applying its transformation, texture, shader, vertex array, uniforms, blend mode, etc. using GFX." (match model ((? model-null? _) @@ -152,26 +152,24 @@ shader, vertex array, uniforms, blend mode, etc. using GFX." (with-graphics-excursion gfx ((force draw-sub-scene) sub-scene gfx))) - (with-transform-excursion gfx - (graphics-transform-mul! gfx local-transform) - (with-transform-excursion gfx - (graphics-transform-mul! gfx view) + (with-model-view-excursion gfx + (graphics-model-view-mul! gfx local-transform) + (with-model-view-excursion gfx + (graphics-model-view-mul! gfx (graphics-projection-transform gfx)) (set-graphics-depth-test! gfx depth-test?) (set-graphics-blend-mode! gfx blend-mode) (set-graphics-shader! gfx shader) (set-graphics-mesh! gfx mesh) (set-graphics-texture! gfx texture) ;; TODO: Support user-defined uniforms. - (uniform-set! shader "mvp" (graphics-transform gfx)) + (uniform-set! shader "mvp" (graphics-model-view-transform gfx)) (uniform-set! shader "color" color) (uniform-set! shader "use_texture" (not (texture-null? texture))) (glDrawElements (begin-mode triangles) (mesh-length mesh) (data-type unsigned-int) %null-pointer)) - (for-each (lambda (child) - (draw-model child view gfx)) - children))))) + (for-each (lambda (child) (draw-model child gfx)) children))))) ;;; ;;; Utility Procedures diff --git a/sly/render/scene.scm b/sly/render/scene.scm index 48e8af7..b46baae 100644 --- a/sly/render/scene.scm +++ b/sly/render/scene.scm @@ -58,18 +58,16 @@ scene is drawn to directly to the OpenGL window." "Render SCENE with the given rendering GFX." (match scene (($ <scene> camera model framebuffer) - (with-transform-excursion gfx - (graphics-transform-identity! gfx) - (let ((view (graphics-transform gfx))) - (transform*! view - (camera-location camera) - (camera-projection camera)) - (with-transform-excursion gfx - (graphics-transform-identity! gfx) - (set-graphics-framebuffer! gfx framebuffer) - (set-graphics-viewport! gfx (camera-viewport camera)) - (clear-viewport (camera-viewport camera)) - (draw-model model view gfx))))))) + (with-projection-excursion gfx + (graphics-projection-identity! gfx) + (graphics-projection-mul! gfx (camera-projection camera)) + (with-model-view-excursion gfx + (graphics-model-view-identity! gfx) + (graphics-model-view-mul! gfx (camera-location camera)) + (set-graphics-framebuffer! gfx framebuffer) + (set-graphics-viewport! gfx (camera-viewport camera)) + (clear-viewport (camera-viewport camera)) + (draw-model model gfx)))))) (define* (scene->sprite scene #:key (anchor 'center)) "Create a sprite that renders the framebuffer texture for SCENE." |