render: Add separate projection and model-view matrix stacks.

Just like the Opengl 2.x days! ;)

* sly/render.scm (graphics-transform, graphics-transform-mul!,
  graphics-transform-identity!): Delete.
  (graphics-model-view-transform, graphics-model-view-mul!,
   graphics-model-view-identity!, graphics-projection-transform,
   graphics-projection-mul!, graphics-projection-identity!): New
   procedures.
   (with-model-view-excursion, with-projection-excursion): New syntax.
   (call-with-transform-excursion): Move matrix copying out of the "in
   guard."
   (draw-scene): Use new matrix stacks.

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."