scene: Decouple cameras from the scene they render.

* sly/camera.scm (make-camera, orthographic-camera): Remove 'scene'
  parameter.
  (draw-camera): Delete.
  (call-with-camera): New procedure.
* sly/game.scm (start-game-loop): Replace 'camera' parameter with
  'scene'.
* sly/scene.scm (make-scene, scene?, update-scene, draw-scene): New
  procedures.
  (scene-root): Replace.

3 files changed, 59 insertions, 35 deletions

diff --git a/sly/camera.scm b/sly/camera.scm
index cfcb716..da1edf0 100644
--- a/sly/camera.scm
+++ b/sly/camera.scm
@@ -27,7 +27,6 @@
   #:use-module (sly wrappers gl)
   #:use-module (sly color)
   #:use-module (sly rect)
-  #:use-module (sly scene)
   #:use-module (sly signal)
   #:use-module (sly transform)
   #:export (make-camera
@@ -40,13 +39,12 @@
             camera-clear-flags
             camera-clear-color
             camera-before-draw-handler camera-after-draw-handler
-            draw-camera))
+            call-with-camera))
 
 (define-record-type <camera>
-  (%make-camera scene location projection viewport clear-flags clear-color
+  (%make-camera location projection viewport clear-flags clear-color
                 before-draw-handler after-draw-handler)
   camera?
-  (scene camera-scene)
   (location camera-location)
   (projection camera-projection)
   (viewport camera-viewport)
@@ -55,28 +53,27 @@
   (before-draw-handler camera-before-draw-handler)
   (after-draw-handler camera-after-draw-handler))
 
-(define* (make-camera scene location projection viewport
+(define* (make-camera location projection viewport
                       #:optional #:key
                       (clear-flags '(color-buffer depth-buffer))
                       (clear-color black)
                       before-draw after-draw)
-  (%make-camera scene location projection viewport clear-flags clear-color
+  (%make-camera location projection viewport clear-flags clear-color
                 before-draw after-draw))
 
-(define* (orthographic-camera scene width height
+(define* (orthographic-camera width height
                               #:optional #:key
                               (z-near 0) (z-far 1)
                               (viewport (make-rect 0 0 width height))
                               #:allow-other-keys #:rest rest)
-  "Return a camera that renders SCENE using an orthographic (2D)
-projection of size WIDTH x HEIGHT.  Optionally, z-axis clipping planes
-Z-NEAR and Z-FAR can be specified, but default to 0 and 1,
-respectively.  By default, the camera's VIEWPORT uses the same
-dimensions as the projection, which is convenient if the dimensions
-are in pixels.  Like 'make-camera', custom CLEAR-COLOR and CLEAR-FLAGS
-can be specified."
+  "Return a camera that uses an orthographic (2D) projection of size
+WIDTH x HEIGHT.  Optionally, z-axis clipping planes Z-NEAR and Z-FAR
+can be specified, but default to 0 and 1, respectively.  By default,
+the camera's VIEWPORT uses the same dimensions as the projection,
+which is convenient if the dimensions are in pixels.  Like
+'make-camera', custom CLEAR-COLOR and CLEAR-FLAGS can be specified."
   (apply make-camera
-         scene identity-transform
+         identity-transform
          (orthographic-projection 0 width 0 height z-near z-far)
          viewport
          rest))
@@ -118,11 +115,11 @@ can be specified."
     (when (procedure? handler)
       (handler))))
 
-(define (draw-camera camera alpha)
-  "Draw SCENE from the perspective of CAMERA with interpolation factor
-ALPHA."
-  ;; Enable texturing, alpha blending, face culling, depth and scissor
-  ;; tests.
+;; emacs: (put 'call-with-camera 'scheme-indent-function 1)
+(define (call-with-camera camera proc)
+  "Setup CAMERA state and apply PROC."
+  ;; Enable texturing, alpha blending, face culling, depth
+  ;; and scissor tests.
   (gl-enable (enable-cap texture-2d))
   (gl-enable (enable-cap blend))
   (gl-enable (enable-cap cull-face))
@@ -132,10 +129,9 @@ ALPHA."
                          (blending-factor-dest one-minus-src-alpha))
   (run-handler camera camera-before-draw-handler)
   (clear-camera camera)
-  (signal-let ((scene (camera-scene camera))
-               (projection (camera-projection camera))
+  (signal-let ((projection (camera-projection camera))
                (location (camera-location camera)))
-    (draw-scene-node scene alpha (transform* projection location)))
+    (proc projection location))
   (run-handler camera camera-after-draw-handler)
   (gl-disable (enable-cap texture-2d))
   (gl-disable (enable-cap blend))
diff --git a/sly/game.scm b/sly/game.scm
index 3f00bf3..67398de 100644
--- a/sly/game.scm
+++ b/sly/game.scm
@@ -62,7 +62,7 @@ for the given STACK and error KEY with additional arguments ARGS."
     (apply display-error (stack-ref stack 0) cep args)
     (newline cep)))
 
-(define* (start-game-loop camera
+(define* (start-game-loop scene
                           #:optional #:key
                           (frame-rate 60)
                           (tick-rate 60)
@@ -85,10 +85,10 @@ unresponsive and possibly crashing."
       (let ((size (signal-ref window-size)))
         (gl-viewport 0 0 (vx size) (vy size)))
       (gl-clear (clear-buffer-mask color-buffer depth-buffer))
-      (signal-let ((camera camera))
-        (if (list? camera)
-            (for-each (cut draw-camera <> alpha) camera)
-            (draw-camera camera alpha)))
+      (signal-let ((scene scene))
+        (if (list? scene)
+            (for-each (cut draw-scene <> alpha) scene)
+            (draw-scene scene alpha)))
       (SDL:gl-swap-buffers))
 
     (define (update lag)
@@ -99,11 +99,10 @@ unused accumulator time."
         (cond ((>= ticks max-ticks-per-frame)
                lag)
               ((>= lag tick-interval)
-               (signal-let ((camera camera))
-                 (if (list? camera)
-                     (for-each (cut update-scene-node <>)
-                               (delete-duplicates (map camera-scene camera) eq?))
-                     (update-scene-node (camera-scene camera))))
+               (signal-let ((scene scene))
+                 (if (list? scene)
+                     (for-each (cut update-scene <>) scene)
+                     (update-scene scene)))
                (tick-agenda!)
                (iter (- lag tick-interval) (1+ ticks)))
               (else
diff --git a/sly/scene.scm b/sly/scene.scm
index b523c72..e3f00c3 100644
--- a/sly/scene.scm
+++ b/sly/scene.scm
@@ -24,6 +24,7 @@
 (define-module (sly scene)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (sly camera)
   #:use-module (sly mesh)
   #:use-module (sly quaternion)
   #:use-module (sly signal)
@@ -31,11 +32,14 @@
   #:use-module (sly transition)
   #:export (scene-node
             make-scene-node
-            scene-root
             scene-node?
             scene-node-position scene-node-scale scene-node-rotation
             scene-node-uniforms scene-node-children
-            update-scene-node draw-scene-node))
+            update-scene-node draw-scene-node
+            make-scene
+            scene?
+            scene-root
+            update-scene draw-scene))
 
 (define-record-type <scene-node>
   (%make-scene-node position scale rotation uniforms children)
@@ -128,3 +132,28 @@
             (for-each (cut draw-scene-node <> alpha transform
                            (scene-node-uniforms node))
                       children))))))
+
+;;;
+;;; Scene
+;;;
+
+(define-record-type <scene>
+  (make-scene root cameras)
+  scene?
+  (root scene-root)
+  (cameras scene-cameras))
+
+(define (update-scene scene)
+  "Update the nodes within SCENE."
+  (update-scene-node (scene-root scene)))
+
+(define (draw-scene scene alpha)
+  "Draw SCENE from the perspective of CAMERA with interpolation factor
+ALPHA."
+  (for-each (lambda (camera)
+              (call-with-camera camera
+                (lambda (projection location)
+                  (draw-scene-node (scene-root scene)
+                                   alpha
+                                   (transform* projection location)))))
+            (scene-cameras scene)))