render: Use separate model, view, and projection matrices.

* sly/render.scm: Replace 'model-view' procedures with separate 'model'
and 'view' procedures.
(<graphics>)[model-view]: Delete field.
[model, view]: New fields.
* sly/render/camera.scm (with-camera): Use separate model/view matrices.
* sly/render/shader.scm (%default-shader): Specify model, view, and
projection uniforms.
* sly/render/sprite-batch.scm (sprite-batch-flush!): Use new model,
view, and projection uniforms.
* data/shaders/default-vertex.glsl (model, view, projection): New
uniforms.
(mvp): Delete.

5 files changed, 118 insertions, 77 deletions

diff --git a/data/shaders/default-vertex.glsl b/data/shaders/default-vertex.glsl
index 11f389f..d2ab135 100644
--- a/data/shaders/default-vertex.glsl
+++ b/data/shaders/default-vertex.glsl
@@ -3,9 +3,11 @@
 in vec3 position;
 in vec2 tex;
 out vec2 frag_tex;
-uniform mat4 mvp;
+uniform mat4 model;
+uniform mat4 view;
+uniform mat4 projection;
 
 void main(void) {
     frag_tex = tex;
-    gl_Position = mvp * vec4(position.xyz, 1.0);
+    gl_Position = projection * view * model * vec4(position.xyz, 1.0);
 }
diff --git a/sly/render.scm b/sly/render.scm
index deac23a..5bc0d30 100644
--- a/sly/render.scm
+++ b/sly/render.scm
@@ -1,5 +1,5 @@
 ;;; Sly
-;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;; Copyright (C) 2014, 2015, 2016 David Thompson <davet@gnu.org>
 ;;;
 ;;; Sly is free software: you can redistribute it and/or modify it
 ;;; under the terms of the GNU General Public License as published by
@@ -59,10 +59,14 @@
             set-graphics-viewport!
             graphics-alpha
             set-graphics-alpha!
-            graphics-model-view-transform
-            graphics-model-view-mul!
-            graphics-model-view-identity!
-            graphics-model-view-excursion
+            graphics-model-transform
+            graphics-model-mul!
+            graphics-model-identity!
+            graphics-model-excursion
+            graphics-view-transform
+            graphics-view-mul!
+            graphics-view-identity!
+            graphics-view-excursion
             graphics-projection-transform
             graphics-projection-mul!
             graphics-projection-identity!
@@ -89,8 +93,9 @@
             mesh-excursion
             framebuffer-excursion
             viewport-excursion
+            model-excursion
+            view-excursion
             projection-excursion
-            model-view-excursion
             set-blend-mode
             set-depth-test
             set-texture
@@ -98,10 +103,12 @@
             set-mesh
             set-framebuffer
             set-viewport
+            model-mul
+            model-identity
+            view-mul
+            view-identity
             projection-mul
             projection-identity
-            model-view-mul
-            model-view-identity
             with-blend-mode
             with-depth-test
             with-texture
@@ -109,8 +116,9 @@
             with-mesh
             with-framebuffer
             with-viewport
+            with-model-mul
+            with-view-mul
             with-projection-mul
-            with-model-view-mul
             move
             scale
             rotate-x
@@ -168,7 +176,7 @@
 
 (define-record-type <graphics>
   (%make-graphics blend-mode depth-test? texture shader mesh framebuffer
-                  viewport projection model-view uniforms)
+                  viewport model view projection uniforms)
   graphics?
   (blend-mode graphics-blend-mode %set-graphics-blend-mode!)
   (depth-test? graphics-depth-test? %set-graphics-depth-test!)
@@ -177,8 +185,9 @@
   (mesh graphics-mesh %set-graphics-mesh!)
   (framebuffer graphics-framebuffer %set-graphics-framebuffer!)
   (viewport graphics-viewport %set-graphics-viewport!)
+  (model graphics-model)
+  (view graphics-view)
   (projection graphics-projection)
-  (model-view graphics-model-view)
   (uniforms graphics-uniforms set-graphics-uniforms!)
   (alpha graphics-alpha set-graphics-alpha!))
 
@@ -267,6 +276,7 @@
   (%make-graphics #f #f #f #f #f #f #f
                   (make-transform-stack transform-stack-size)
                   (make-transform-stack transform-stack-size)
+                  (make-transform-stack transform-stack-size)
                   (make-hash-table)))
 
 (define (graphics-reset! gfx)
@@ -278,8 +288,9 @@
     (set-graphics-mesh!        gfx null-mesh #t)
     (set-graphics-framebuffer! gfx null-framebuffer #t)
     (set-graphics-viewport!    gfx null-viewport #t)
-    (stack-transform-identity! (graphics-projection gfx))
-    (stack-transform-identity! (graphics-model-view gfx))))
+    (stack-transform-identity! (graphics-model gfx))
+    (stack-transform-identity! (graphics-view gfx))
+    (stack-transform-identity! (graphics-projection gfx))))
 
 (define-syntax-rule (with-graphics gfx body ...)
   (begin
@@ -287,17 +298,30 @@
     body ...
     (graphics-reset! gfx)))
 
-(define (graphics-model-view-transform gfx)
-  (q-front (graphics-model-view gfx)))
+(define (graphics-model-transform gfx)
+  (q-front (graphics-model gfx)))
+
+(define (graphics-model-mul! gfx t)
+  (stack-transform-mul! (graphics-model gfx) t))
+
+(define (graphics-model-identity! gfx)
+  (stack-transform-identity! (graphics-model gfx)))
+
+(define (graphics-model-excursion gfx proc)
+  (call-with-transform-excursion (graphics-model gfx)
+    (lambda () (proc gfx))))
+
+(define (graphics-view-transform gfx)
+  (q-front (graphics-view gfx)))
 
-(define (graphics-model-view-mul! gfx t)
-  (stack-transform-mul! (graphics-model-view gfx) t))
+(define (graphics-view-mul! gfx t)
+  (stack-transform-mul! (graphics-view gfx) t))
 
-(define (graphics-model-view-identity! gfx)
-  (stack-transform-identity! (graphics-model-view gfx)))
+(define (graphics-view-identity! gfx)
+  (stack-transform-identity! (graphics-view gfx)))
 
-(define (graphics-model-view-excursion gfx proc)
-  (call-with-transform-excursion (graphics-model-view gfx)
+(define (graphics-view-excursion gfx proc)
+  (call-with-transform-excursion (graphics-view gfx)
     (lambda () (proc gfx))))
 
 (define (graphics-projection-transform gfx)
@@ -395,12 +419,15 @@ argument is a graphics context, into the rendering monad."
 (define viewport-excursion
   (render-lift1 graphics-viewport-excursion))
 
+(define model-excursion
+  (render-lift1 graphics-model-excursion))
+
+(define view-excursion
+  (render-lift1 graphics-view-excursion))
+
 (define projection-excursion
   (render-lift1 graphics-projection-excursion))
 
-(define model-view-excursion
-  (render-lift1 graphics-model-view-excursion))
-
 (define set-blend-mode
   (render-lift1 set-graphics-blend-mode!))
 
@@ -422,18 +449,24 @@ argument is a graphics context, into the rendering monad."
 (define set-viewport
   (render-lift1 set-graphics-viewport!))
 
+(define model-mul
+  (render-lift1 graphics-model-mul!))
+
+(define model-identity
+  (render-lift1 graphics-model-identity!))
+
+(define view-mul
+  (render-lift1 graphics-view-mul!))
+
+(define view-identity
+  (render-lift1 graphics-view-identity!))
+
 (define projection-mul
   (render-lift1 graphics-projection-mul!))
 
 (define projection-identity
   (render-lift1 graphics-projection-identity!))
 
-(define model-view-mul
-  (render-lift1 graphics-model-view-mul!))
-
-(define model-view-identity
-  (render-lift1 graphics-model-view-identity!))
-
 (define (with-blend-mode blend-mode renderer)
   (blend-mode-excursion
    (render-begin (set-blend-mode blend-mode) renderer)))
@@ -462,43 +495,47 @@ argument is a graphics context, into the rendering monad."
   (viewport-excursion
    (render-begin (set-viewport viewport) renderer)))
 
+(define (with-model-mul transform renderer)
+  (model-excursion
+   (render-begin (model-mul transform) renderer)))
+
+(define (with-view-mul transform renderer)
+  (view-excursion
+   (render-begin (view-mul transform) renderer)))
+
 (define (with-projection-mul transform renderer)
   (projection-excursion
    (render-begin (projection-mul transform) renderer)))
 
-(define (with-model-view-mul transform renderer)
-  (model-view-excursion
-   (render-begin (model-view-mul transform) renderer)))
-
 (define (move v renderer)
   "Create a new renderer that moves the scene by the vector V and
 applies RENDERER."
-  (with-model-view-mul (t:translate v) renderer))
+  (with-model-mul (t:translate v) renderer))
 
 (define (scale s renderer)
   "Create a new renderer that scales the scene by S and applies
 RENDERER."
-  (with-model-view-mul (t:scale s) renderer))
+  (with-model-mul (t:scale s) renderer))
 
 (define (rotate-x theta renderer)
   "Create a new renderer that rotates the scene by THETA about the X
 axis and applies RENDERER."
-  (with-model-view-mul (t:rotate-x theta) renderer))
+  (with-model-mul (t:rotate-x theta) renderer))
 
 (define (rotate-y theta renderer)
   "Create a new renderer that rotates the scene by THETA about the Y
 axis and applies RENDERER."
-  (with-model-view-mul (t:rotate-y theta) renderer))
+  (with-model-mul (t:rotate-y theta) renderer))
 
 (define (rotate-z theta renderer)
   "Create a new renderer that rotates the scene by THETA about the Z
 axis and applies RENDERER."
-  (with-model-view-mul (t:rotate-z theta) renderer))
+  (with-model-mul (t:rotate-z theta) renderer))
 
 (define (rotate quaternion renderer)
   "Create a new renderer that rotates the scene by QUATERNION and
 applies RENDERER."
-  (with-model-view-mul (t:rotate quaternion) renderer))
+  (with-model-mul (t:rotate quaternion) renderer))
 
 (define (clear-screen gfx)
   "Clear the current viewport bound to GFX."
@@ -521,14 +558,13 @@ COLOR and applies RENDERER."
 (define (render-mesh mesh)
   "Create a new renderer that render MESH to the framebuffer."
   (lambda (gfx)
-    (graphics-model-view-excursion gfx
-      (lambda (gfx)
-        (graphics-model-view-mul! gfx (graphics-projection-transform gfx))
-        (set-graphics-mesh! gfx mesh)
-        (graphics-uniform-excursion gfx
-            `((mvp ,(graphics-model-view-transform gfx))
-              (texture? ,(not (texture-null? (graphics-texture gfx)))))
-          draw-graphics-mesh!)))))
+    (set-graphics-mesh! gfx mesh)
+    (graphics-uniform-excursion gfx
+        `((model ,(graphics-model-transform gfx))
+          (view ,(graphics-view-transform gfx))
+          (projection ,(graphics-projection-transform gfx))
+          (texture? ,(not (texture-null? (graphics-texture gfx)))))
+      draw-graphics-mesh!)))
 
 (define-syntax-rule (render/signal ((name signal) ...) renderer)
   "Evaluate RENDERER whenever a bound signal changes."
diff --git a/sly/render/camera.scm b/sly/render/camera.scm
index 5b69808..dcd0ccf 100644
--- a/sly/render/camera.scm
+++ b/sly/render/camera.scm
@@ -1,5 +1,5 @@
 ;;; Sly
-;;; Copyright (C) 2014, 2015 David Thompson <davet@gnu.org>
+;;; Copyright (C) 2014, 2015, 2016 David Thompson <davet@gnu.org>
 ;;;
 ;;; Sly is free software: you can redistribute it and/or modify it
 ;;; under the terms of the GNU General Public License as published by
@@ -56,11 +56,14 @@
    (render-begin
     projection-identity
     (projection-mul (camera-projection camera))
-    (move (camera-location camera)
-          (with-viewport (camera-viewport camera)
-            (render-begin
-             clear-screen
-             renderer))))))
+    (view-excursion
+     (render-begin
+      view-identity
+      (view-mul (translate (camera-location camera)))
+      (with-viewport (camera-viewport camera)
+        (render-begin
+         clear-screen
+         renderer)))))))
 
 (define* (2d-camera #:key (z-near 0) (z-far 1) (area (make-rect 0 0 640 480))
                     (clear-color black) (clear-flags %standard-clear-flags)
diff --git a/sly/render/shader.scm b/sly/render/shader.scm
index 3367b57..e9e8b33 100644
--- a/sly/render/shader.scm
+++ b/sly/render/shader.scm
@@ -1,5 +1,5 @@
 ;;; Sly
-;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu>
+;;; Copyright (C) 2014, 2015, 2016 David Thompson <dthompson2@worcester.edu>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -353,7 +353,9 @@ within SHADER."
     (load-shader
      #:vertex-source (scope-datadir "/shaders/default-vertex.glsl")
      #:fragment-source (scope-datadir "/shaders/default-fragment.glsl")
-     #:uniforms `((mvp "mvp" ,identity-transform)
+     #:uniforms `((model "model" ,identity-transform)
+                  (view "view" ,identity-transform)
+                  (projection "projection" ,identity-transform)
                   (color "color" ,white)
                   (texture? "use_texture" #f)))))
 
diff --git a/sly/render/sprite-batch.scm b/sly/render/sprite-batch.scm
index 8b59cb3..fe17f42 100644
--- a/sly/render/sprite-batch.scm
+++ b/sly/render/sprite-batch.scm
@@ -174,26 +174,24 @@
     (graphics-texture-excursion context
       (lambda (context)
         (set-graphics-texture! context (sprite-batch-texture batch))
-        (graphics-model-view-excursion context
+        (graphics-uniform-excursion context
+            `((model ,(graphics-model-transform context))
+              (view ,(graphics-view-transform context))
+              (projection ,(graphics-projection-transform context))
+              (texture? ,(not (texture-null? (graphics-texture context)))))
           (lambda (context)
-            (graphics-model-view-mul! context
-                                      (graphics-projection-transform context))
-            (graphics-uniform-excursion context
-                `((mvp ,(graphics-model-view-transform context))
-                  (texture? ,(not (texture-null? (graphics-texture context)))))
-              (lambda (context)
-                (unmap-vertex-buffer! (sprite-batch-index-buffer batch))
-                (unmap-vertex-buffer! (sprite-batch-position-buffer batch))
-                (unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
-
-                (set-graphics-mesh! context (sprite-batch-mesh batch))
-                (glDrawElements (begin-mode triangles)
-                                ;; 6 indices per sprite.
-                                (* (sprite-batch-size batch) 6)
-                                (data-type unsigned-int)
-                                %null-pointer)
-
-                (sprite-batch-reset! batch)))))))))
+            (unmap-vertex-buffer! (sprite-batch-index-buffer batch))
+            (unmap-vertex-buffer! (sprite-batch-position-buffer batch))
+            (unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
+
+            (set-graphics-mesh! context (sprite-batch-mesh batch))
+            (glDrawElements (begin-mode triangles)
+                            ;; 6 indices per sprite.
+                            (* (sprite-batch-size batch) 6)
+                            (data-type unsigned-int)
+                            %null-pointer)
+
+            (sprite-batch-reset! batch)))))))
 
 (define-syntax-rule (with-sprite-batch batch context body ...)
   ;; IMPORTANT! We need to make sure that the current VAO is unbound