diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | sly/camera.scm | 99 |
2 files changed, 100 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index 468c42f..2790eea 100644 --- a/Makefile.am +++ b/Makefile.am @@ -24,6 +24,7 @@ SOURCES = \ sly/agenda.scm \ sly/animation.scm \ sly/audio.scm \ + sly/camera.scm \ sly/color.scm \ sly/config.scm \ sly/coroutine.scm \ diff --git a/sly/camera.scm b/sly/camera.scm new file mode 100644 index 0000000..8992acf --- /dev/null +++ b/sly/camera.scm @@ -0,0 +1,99 @@ +;;; 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 scene) + #:use-module (sly signal) + #:use-module (sly transform) + #:export (make-camera + camera? + camera-scene + camera-location + camera-projection + camera-viewport + camera-clear-flags + camera-clear-color + draw-camera)) + +(define-record-type <camera> + (%make-camera scene location projection viewport clear-flags clear-color) + camera? + (scene camera-scene) + (location camera-location) + (projection camera-projection) + (viewport camera-viewport) + (clear-flags camera-clear-flags) + (clear-color camera-clear-color)) + +(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)) + +;; 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 (draw-camera camera alpha) + "Draw SCENE from the perspective of CAMERA with interpolation factor +ALPHA." + (clear-camera camera) + (draw-scene-node (camera-scene camera) + alpha + (transform* + (signal-ref-maybe (camera-projection camera)) + (signal-ref-maybe (camera-location camera))))) |