diff options
| -rw-r--r-- | sly/camera.scm | 42 | ||||
| -rw-r--r-- | sly/game.scm | 19 | ||||
| -rw-r--r-- | sly/scene.scm | 33 |
3 files changed, 59 insertions, 35 deletions
diff --git a/sly/camera.scm b/sly/camera.scm index cfcb716..da1edf0 100644 --- a/sly/camera.scm +++ b/sly/camera.scm @@ -27,7 +27,6 @@ #: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 @@ -40,13 +39,12 @@ camera-clear-flags camera-clear-color camera-before-draw-handler camera-after-draw-handler - draw-camera)) + call-with-camera)) (define-record-type <camera> - (%make-camera scene location projection viewport clear-flags clear-color + (%make-camera 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) @@ -55,28 +53,27 @@ (before-draw-handler camera-before-draw-handler) (after-draw-handler camera-after-draw-handler)) -(define* (make-camera scene location projection viewport +(define* (make-camera location projection viewport #:optional #:key (clear-flags '(color-buffer depth-buffer)) (clear-color black) before-draw after-draw) - (%make-camera scene location projection viewport clear-flags clear-color + (%make-camera location projection viewport clear-flags clear-color before-draw after-draw)) -(define* (orthographic-camera scene width height +(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 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, -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." + "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 - scene identity-transform + identity-transform (orthographic-projection 0 width 0 height z-near z-far) viewport rest)) @@ -118,11 +115,11 @@ can be specified." (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. +;; 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)) @@ -132,10 +129,9 @@ 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)) + (signal-let ((projection (camera-projection camera)) (location (camera-location camera))) - (draw-scene-node scene alpha (transform* projection location))) + (proc projection location)) (run-handler camera camera-after-draw-handler) (gl-disable (enable-cap texture-2d)) (gl-disable (enable-cap blend)) diff --git a/sly/game.scm b/sly/game.scm index 3f00bf3..67398de 100644 --- a/sly/game.scm +++ b/sly/game.scm @@ -62,7 +62,7 @@ for the given STACK and error KEY with additional arguments ARGS." (apply display-error (stack-ref stack 0) cep args) (newline cep))) -(define* (start-game-loop camera +(define* (start-game-loop scene #:optional #:key (frame-rate 60) (tick-rate 60) @@ -85,10 +85,10 @@ unresponsive and possibly crashing." (let ((size (signal-ref window-size))) (gl-viewport 0 0 (vx size) (vy size))) (gl-clear (clear-buffer-mask color-buffer depth-buffer)) - (signal-let ((camera camera)) - (if (list? camera) - (for-each (cut draw-camera <> alpha) camera) - (draw-camera camera alpha))) + (signal-let ((scene scene)) + (if (list? scene) + (for-each (cut draw-scene <> alpha) scene) + (draw-scene scene alpha))) (SDL:gl-swap-buffers)) (define (update lag) @@ -99,11 +99,10 @@ unused accumulator time." (cond ((>= ticks max-ticks-per-frame) lag) ((>= lag tick-interval) - (signal-let ((camera camera)) - (if (list? camera) - (for-each (cut update-scene-node <>) - (delete-duplicates (map camera-scene camera) eq?)) - (update-scene-node (camera-scene camera)))) + (signal-let ((scene scene)) + (if (list? scene) + (for-each (cut update-scene <>) scene) + (update-scene scene))) (tick-agenda!) (iter (- lag tick-interval) (1+ ticks))) (else diff --git a/sly/scene.scm b/sly/scene.scm index b523c72..e3f00c3 100644 --- a/sly/scene.scm +++ b/sly/scene.scm @@ -24,6 +24,7 @@ (define-module (sly scene) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (sly camera) #:use-module (sly mesh) #:use-module (sly quaternion) #:use-module (sly signal) @@ -31,11 +32,14 @@ #:use-module (sly transition) #:export (scene-node make-scene-node - scene-root scene-node? scene-node-position scene-node-scale scene-node-rotation scene-node-uniforms scene-node-children - update-scene-node draw-scene-node)) + update-scene-node draw-scene-node + make-scene + scene? + scene-root + update-scene draw-scene)) (define-record-type <scene-node> (%make-scene-node position scale rotation uniforms children) @@ -128,3 +132,28 @@ (for-each (cut draw-scene-node <> alpha transform (scene-node-uniforms node)) children)))))) + +;;; +;;; Scene +;;; + +(define-record-type <scene> + (make-scene root cameras) + scene? + (root scene-root) + (cameras scene-cameras)) + +(define (update-scene scene) + "Update the nodes within SCENE." + (update-scene-node (scene-root scene))) + +(define (draw-scene scene alpha) + "Draw SCENE from the perspective of CAMERA with interpolation factor +ALPHA." + (for-each (lambda (camera) + (call-with-camera camera + (lambda (projection location) + (draw-scene-node (scene-root scene) + alpha + (transform* projection location))))) + (scene-cameras scene))) |