render: Add <scene> record type.

* sly/render/scene.scm: New file.
* Makefile.am (SOURCES): Add it.
* sly/render/camera.scm (apply-viewport): Do not clear viewport.
  (clear-viewport): New procedure.
* sly/render/model.scm (model-sub-scene): New accessor.
  (make-model): Add #:sub-scene keyword argument.
  (draw-sub-scene): New variable.
  (draw-model): Remove rendering initialization code.  Render sub-scenes.

4 files changed, 135 insertions, 50 deletions

diff --git a/Makefile.am b/Makefile.am
index f9bc879..130c9a0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -56,6 +56,7 @@ SOURCES = 					\
   sly/render/tileset.scm			\
   sly/render/tile-map.scm			\
   sly/render/context.scm			\
+  sly/render/scene.scm				\
   $(WRAPPER_SOURCES)
 
 WRAPPER_SOURCES =				\
diff --git a/sly/render/camera.scm b/sly/render/camera.scm
index 48a66b2..9de7ae6 100644
--- a/sly/render/camera.scm
+++ b/sly/render/camera.scm
@@ -32,10 +32,15 @@
   #:use-module (sly render color)
   #:use-module (sly math rect)
   #:use-module (sly math transform)
-  #:export (make-viewport viewport?
-            viewport-area viewport-clear-color viewport-clear-flags
-            %standard-clear-flags apply-viewport
+  #:export (make-viewport
+            viewport?
+            viewport-area
+            viewport-clear-color
+            viewport-clear-flags
             null-viewport
+            %standard-clear-flags
+            apply-viewport
+            clear-viewport
             make-camera camera?
             camera-location camera-projection camera-viewport
             orthographic-camera))
@@ -86,7 +91,10 @@ area, set the clear color, and clear necessary buffers."
      (gl-scissor x y width height)))
   (match (viewport-clear-color viewport)
     (($ <color> r g b a)
-     (gl-clear-color r g b a)))
+     (gl-clear-color r g b a))))
+
+(define (clear-viewport viewport)
+  "Clear the relevant OpenGL buffers VIEWPORT."
   (gl-clear (clear-buffer-mask (viewport-clear-flags viewport))))
 
 ;;;
diff --git a/sly/render/model.scm b/sly/render/model.scm
index 4d15dc5..72a1719 100644
--- a/sly/render/model.scm
+++ b/sly/render/model.scm
@@ -44,7 +44,7 @@
             model? model-null?
             null-model
             model-mesh model-transform model-texture model-shader model-color
-            model-blend-mode model-depth-test? model-children
+            model-blend-mode model-depth-test? model-sub-scene model-children
             draw-model
             model-paint
             model-blend
@@ -56,7 +56,7 @@
 ;; Representation of a single OpenGL render call.
 (define-record-type <model>
   (%make-model mesh transform texture shader color blend-mode
-               depth-test? children)
+               depth-test? sub-scene children)
   model?
   (mesh model-mesh)
   (transform model-transform)
@@ -65,18 +65,21 @@
   (color model-color)
   (blend-mode model-blend-mode)
   (depth-test? model-depth-test?)
+  (sub-scene model-sub-scene)
   (children model-children))
 
 (define* (make-model #:optional #:key (mesh null-mesh)
                      (transform identity-transform) (texture null-texture)
                      (shader (load-default-shader)) (color white)
                      (blend-mode default-blend-mode) (depth-test? #t)
-                     (children '()))
+                     sub-scene (children '()))
   "Create a new model from MESH and the given rendering state.  When
 rendering, TEXTURE and SHADER are bound, BLEND-MODE and DEPTH-TEST?
-are set, and the COLOR uniform variable is set."
+are set, and the COLOR uniform variable is set.  The presence of a
+SUB-SCENE indicates that the model uses the scene's framebuffer as
+it's texture, so it must be rendered first."
   (%make-model mesh transform texture shader color blend-mode
-               depth-test? children))
+               depth-test? sub-scene children))
 
 (define model make-model)
 
@@ -131,49 +134,44 @@ changing the fields specified in KWARGS."
     (array-set! matrix 0 3 2)
     (array-set! matrix 1 3 3)))
 
-(define draw-model
-  (let ((context (make-render-context)))
-    (lambda* (model camera #:optional (context context))
-      "Render MODEL by applying its transform (multiplied by VIEW), texture,
+;; Avoid circular dependency.
+(define draw-sub-scene
+  (delay (module-ref (resolve-interface '(sly render scene)) 'draw-scene)))
+
+(define (draw-model model view context)
+  "Render MODEL by applying its transform (multiplied by VIEW), texture,
 shader, vertex array, uniforms, blend mode, etc. to the render
 CONTEXT."
-      (define (iter model view context)
-        (match model
-          ((? model-null? _)
-           *unspecified*)
-          (($ <model> mesh local-transform texture shader color blend-mode
-                      depth-test? children)
-           (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" (render-context-transform context))
-              (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)
-                         (iter child view context))
-                       children)))))
-
-      (with-render-context 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))))))))
+  (match model
+    ((? model-null? _)
+     *unspecified*)
+    (($ <model> mesh local-transform texture shader color blend-mode
+        depth-test? sub-scene children)
+
+     (when sub-scene
+       (with-render-context-excursion context
+         ((force draw-sub-scene) sub-scene context)))
+
+     (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" (render-context-transform context))
+         (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 context))
+                 children)))))
 
 ;;;
 ;;; Utility Procedures
diff --git a/sly/render/scene.scm b/sly/render/scene.scm
new file mode 100644
index 0000000..9f66902
--- /dev/null
+++ b/sly/render/scene.scm
@@ -0,0 +1,78 @@
+;;; Sly
+;;; Copyright (C) 2015 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
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Sly is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;;; License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Scene data type.
+;;
+;;; Code:
+
+(define-module (sly render scene)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (sly math transform)
+  #:use-module (sly render camera)
+  #:use-module (sly render context)
+  #:use-module (sly render framebuffer)
+  #:use-module (sly render model)
+  #:use-module (sly render sprite)
+  #:export (make-scene
+            scene
+            scene?
+            scene-camera
+            scene-model
+            scene-framebuffer
+            draw-scene
+            scene->sprite))
+
+(define-record-type <scene>
+  (%make-scene camera model framebuffer)
+  scene?
+  (camera scene-camera)
+  (model scene-model)
+  (framebuffer scene-framebuffer))
+
+(define* (make-scene camera model #:optional (framebuffer null-framebuffer))
+  "Create a new scene that views MODEL from the perspective of CAMERA.
+FRAMEBUFFER specifies where the scene will be drawn to.  By default, a
+scene is drawn to directly to the OpenGL window."
+  (%make-scene camera model framebuffer))
+
+(define scene make-scene)
+
+(define (draw-scene scene context)
+  "Render SCENE with the given rendering CONTEXT."
+  (match scene
+    (($ <scene> camera model framebuffer)
+     (with-transform-excursion context
+       (render-context-transform-identity! context)
+       (let ((view (render-context-transform context)))
+         (transform*! view
+                      (camera-location camera)
+                      (camera-projection camera))
+         (with-transform-excursion context
+           (render-context-transform-identity! context)
+           (set-render-context-framebuffer! context framebuffer)
+           (set-render-context-viewport! context (camera-viewport camera))
+           (clear-viewport (camera-viewport camera))
+           (draw-model model view context)))))))
+
+(define* (scene->sprite scene #:key (anchor 'center))
+  "Create a sprite that renders the framebuffer texture for SCENE."
+  (model-inherit (make-sprite (framebuffer-texture (scene-framebuffer scene))
+                              #:anchor anchor)
+                 #:sub-scene scene))