camera: Rewrite module.

* Makefile.am (SOURCES): Update camera module file name.
* sly/camera.scm: Delete.
* sly/render/renderer.scm: Import new camera module.
* sly/render/camera.scm: New file.

4 files changed, 108 insertions, 142 deletions

diff --git a/Makefile.am b/Makefile.am
index 8d020d0..86e9d15 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -24,7 +24,6 @@ SOURCES = 					\
   sly/agenda.scm 				\
   sly/animation.scm				\
   sly/audio.scm					\
-  sly/camera.scm				\
   sly/color.scm					\
   sly/config.scm					\
   sly/coroutine.scm				\
@@ -54,6 +53,7 @@ SOURCES = 					\
   sly/window.scm					\
   sly/joystick.scm				\
   sly/render/utils.scm				\
+  sly/render/camera.scm				\
   sly/render/vertex-array.scm			\
   sly/render/renderer.scm			\
   $(WRAPPER_SOURCES)
diff --git a/sly/camera.scm b/sly/camera.scm
deleted file mode 100644
index da1edf0..0000000
--- a/sly/camera.scm
+++ /dev/null
@@ -1,140 +0,0 @@
-;;; Sly
-;;; Copyright (C) 2014 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:
-;;
-;; A view to a scene graph.
-;;
-;;; Code:
-
-(define-module (sly camera)
-  #:use-module (srfi srfi-9)
-  #:use-module (gl)
-  #:use-module (sly wrappers gl)
-  #:use-module (sly color)
-  #:use-module (sly rect)
-  #:use-module (sly signal)
-  #:use-module (sly transform)
-  #:export (make-camera
-            orthographic-camera
-            camera?
-            camera-scene
-            camera-location
-            camera-projection
-            camera-viewport
-            camera-clear-flags
-            camera-clear-color
-            camera-before-draw-handler camera-after-draw-handler
-            call-with-camera))
-
-(define-record-type <camera>
-  (%make-camera location projection viewport clear-flags clear-color
-                before-draw-handler after-draw-handler)
-  camera?
-  (location camera-location)
-  (projection camera-projection)
-  (viewport camera-viewport)
-  (clear-flags camera-clear-flags)
-  (clear-color camera-clear-color)
-  (before-draw-handler camera-before-draw-handler)
-  (after-draw-handler camera-after-draw-handler))
-
-(define* (make-camera location projection viewport
-                      #:optional #:key
-                      (clear-flags '(color-buffer depth-buffer))
-                      (clear-color black)
-                      before-draw after-draw)
-  (%make-camera location projection viewport clear-flags clear-color
-                before-draw after-draw))
-
-(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 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
-         identity-transform
-         (orthographic-projection 0 width 0 height z-near z-far)
-         viewport
-         rest))
-
-;; guile-opengl's clear-buffer-mask does not work with symbols, only
-;; syntax.
-(define (clear-buffer-mask . flags)
-  (apply logior
-   (map (lambda (flag)
-          (assq-ref '((depth-buffer . 256)
-                      (accum-buffer . 512)
-                      (stencil-buffer . 1024)
-                      (color-buffer . 16384)
-                      (coverage-buffer-bit-nv . 32768))
-                    flag))
-        flags)))
-
-(define (clear-camera camera)
-  "Define viewport and clear it."
-  (let ((vp (camera-viewport camera))
-        (c (camera-clear-color camera)))
-    (gl-viewport (rect-x vp)
-                 (rect-y vp)
-                 (rect-width vp)
-                 (rect-height vp))
-    ;; Restrict gl-clear to the viewport.
-    (gl-scissor (rect-x vp)
-                (rect-y vp)
-                (rect-width vp)
-                (rect-height vp))
-    (gl-clear-color (color-r c)
-                    (color-g c)
-                    (color-b c)
-                    (color-a c))
-    (gl-clear (apply clear-buffer-mask (camera-clear-flags camera)))))
-
-(define (run-handler camera getter)
-  (let ((handler (getter camera)))
-    (when (procedure? handler)
-      (handler))))
-
-;; 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))
-  (gl-enable (enable-cap depth-test))
-  (gl-enable (enable-cap scissor-test))
-  (set-gl-blend-function (blending-factor-src src-alpha)
-                         (blending-factor-dest one-minus-src-alpha))
-  (run-handler camera camera-before-draw-handler)
-  (clear-camera camera)
-  (signal-let ((projection (camera-projection camera))
-               (location (camera-location camera)))
-    (proc projection location))
-  (run-handler camera camera-after-draw-handler)
-  (gl-disable (enable-cap texture-2d))
-  (gl-disable (enable-cap blend))
-  (gl-disable (enable-cap cull-face))
-  (gl-disable (enable-cap depth-test))
-  (gl-disable (enable-cap scissor-test)))
diff --git a/sly/render/camera.scm b/sly/render/camera.scm
new file mode 100644
index 0000000..65e384c
--- /dev/null
+++ b/sly/render/camera.scm
@@ -0,0 +1,106 @@
+;;; Sly
+;;; Copyright (C) 2014 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:
+;;
+;; Cameras and viewports.
+;;
+;;; Code:
+
+(define-module (sly render camera)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (gl)
+  #:use-module (gl low-level)
+  #:use-module (gl enums)
+  #:use-module (sly wrappers gl)
+  #:use-module (sly color)
+  #:use-module (sly rect)
+  #:use-module (sly transform)
+  #:export (make-viewport viewport?
+            viewport-area viewport-clear-color viewport-clear-flags
+            apply-viewport
+            make-camera camera?
+            camera-location camera-projection camera-viewport
+            orthographic-camera))
+
+;;;
+;;; Viewport
+;;;
+
+(define-record-type <viewport>
+  (%make-viewport area clear-color clear-flags)
+  viewport?
+  (area viewport-area)
+  (clear-color viewport-clear-color)
+  (clear-flags viewport-clear-flags))
+
+(define* (make-viewport area #:optional #:key (clear-color black)
+                        (clear-flags '(color-buffer depth-buffer)))
+  "Create a viewport that covers the rectangle AREA of the window.
+Fill the viewport with CLEAR-COLOR when clearing the screen.  Clear
+the buffers denoted by the list of symbols in CLEAR-FLAGS.  Possible
+values for CLEAR-FLAGS are 'color-buffer', 'depth-buffer',
+'accum-buffer', and 'stencil-buffer'."
+  (%make-viewport area clear-color clear-flags))
+
+(define (clear-buffer-mask flags)
+  (apply logior
+         ;; Map symbols to OpenGL constants.
+         (map (match-lambda
+                ('depth-buffer 256)
+                ('accum-buffer 512)
+                ('stencil-buffer 1024)
+                ('color-buffer 16384))
+              flags)))
+
+(define (apply-viewport viewport)
+  "Set the OpenGL state for VIEWPORT.  Clip rendering to the viewport
+area, set the clear color, and clear necessary buffers."
+  (gl-enable (enable-cap scissor-test))
+  (match (viewport-area viewport)
+    (($ <rect> x y width height)
+     (gl-viewport x y width height)
+     (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 (clear-buffer-mask (viewport-clear-flags viewport))))
+
+;;;
+;;; Camera
+;;;
+
+(define-record-type <camera>
+  (make-camera location projection viewport)
+  camera?
+  (location camera-location)
+  (projection camera-projection)
+  (viewport camera-viewport))
+
+(define* (orthographic-camera width height
+                              #:optional #:key
+                              (z-near 0) (z-far 1)
+                              (viewport (make-viewport
+                                         (make-rect 0 0 width height))))
+  "Create a camera object 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 is WIDTH x HEIGHT, which is convenient if
+the dimensions are measured in pixels."
+  (let ((projection (orthographic-projection 0 width 0 height z-near z-far)))
+    (make-camera identity-transform projection viewport)))
diff --git a/sly/render/renderer.scm b/sly/render/renderer.scm
index b600b35..a0ac2ca 100644
--- a/sly/render/renderer.scm
+++ b/sly/render/renderer.scm
@@ -28,12 +28,12 @@
   #:use-module (srfi srfi-26)
   #:use-module (gl)
   #:use-module (gl low-level)
-  #:use-module (sly camera)
   #:use-module (sly shader)
   #:use-module (sly texture)
   #:use-module (sly transform)
   #:use-module (sly math vector)
   #:use-module (sly render utils)
+  #:use-module (sly render camera)
   #:use-module (sly render vertex-array)
   #:export (make-render-op render-op?
             render-op-transform render-op-vertex-array