From 009998e281d24dc110661d2f348094376f1b57d5 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 6 Sep 2014 14:56:29 -0400
Subject: camera: Add before/after draw handlers.

* sly/camera.scm (camera-before-draw-handler,
  camera-after-draw-handler): New procedures.
  (make-camera): Add before-draw and after-draw keyword parameters.
  (orthographic-camera): Use #:allow-other-keys.
  (run-handler): New procedure.
  (draw-camera): Enable/disable GL features before/after drawing and run
  handlers.
* sly/window.scm (open-window): Remove calls to GL procedures.
---
 sly/camera.scm | 50 ++++++++++++++++++++++++++++++++++++++------------
 sly/window.scm | 11 +----------
 2 files changed, 39 insertions(+), 22 deletions(-)

diff --git a/sly/camera.scm b/sly/camera.scm
index 2b4d77f..cfcb716 100644
--- a/sly/camera.scm
+++ b/sly/camera.scm
@@ -39,30 +39,35 @@
             camera-viewport
             camera-clear-flags
             camera-clear-color
+            camera-before-draw-handler camera-after-draw-handler
             draw-camera))
 
 (define-record-type <camera>
-  (%make-camera scene location projection viewport clear-flags clear-color)
+  (%make-camera scene 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)
   (clear-flags camera-clear-flags)
-  (clear-color camera-clear-color))
+  (clear-color camera-clear-color)
+  (before-draw-handler camera-before-draw-handler)
+  (after-draw-handler camera-after-draw-handler))
 
 (define* (make-camera scene location projection viewport
                       #:optional #:key
                       (clear-flags '(color-buffer depth-buffer))
-                      (clear-color black))
-  (%make-camera scene location projection viewport clear-flags clear-color))
+                      (clear-color black)
+                      before-draw after-draw)
+  (%make-camera scene location projection viewport clear-flags clear-color
+                before-draw after-draw))
 
 (define* (orthographic-camera scene width height
                               #:optional #:key
                               (z-near 0) (z-far 1)
                               (viewport (make-rect 0 0 width height))
-                              (clear-flags '(color-buffer depth-buffer))
-                              (clear-color black))
+                              #: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,
@@ -70,11 +75,11 @@ 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."
-  (make-camera scene identity-transform
-               (orthographic-projection 0 width 0 height z-near z-far)
-               viewport
-               #:clear-flags clear-flags
-               #:clear-color clear-color))
+  (apply make-camera
+         scene 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.
@@ -108,11 +113,32 @@ can be specified."
                     (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))))
+
 (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.
+  (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 ((scene (camera-scene camera))
                (projection (camera-projection camera))
                (location (camera-location camera)))
-    (draw-scene-node scene alpha (transform* projection location))))
+    (draw-scene-node scene alpha (transform* 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/window.scm b/sly/window.scm
index 802132f..0e400f5 100644
--- a/sly/window.scm
+++ b/sly/window.scm
@@ -23,7 +23,6 @@
 
 (define-module (sly window)
   #:use-module (srfi srfi-9)
-  #:use-module (gl)
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module ((sdl mixer) #:prefix SDL:)
   #:use-module (sly event)
@@ -102,15 +101,7 @@
     (SDL:init 'everything)
     ;; Open SDL window in OpenGL mode.
     (SDL:set-video-mode width height 24 flags)
-    (SDL:set-caption (window-title window))
-    ;; Enable texturing and alpha blending
-    (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))))
+    (SDL:set-caption (window-title window))))
 
 (define (close-window)
   "Close the currently open window and audio."
-- 
cgit v1.2.3