summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/camera.scm50
-rw-r--r--sly/window.scm11
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."