diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | sly/camera.scm | 140 | ||||
| -rw-r--r-- | sly/render/camera.scm | 106 | ||||
| -rw-r--r-- | sly/render/renderer.scm | 2 |
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 |