diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | sly/render/camera.scm | 16 | ||||
| -rw-r--r-- | sly/render/model.scm | 90 | ||||
| -rw-r--r-- | sly/render/scene.scm | 78 |
4 files changed, 135 insertions, 50 deletions
diff --git a/Makefile.am b/Makefile.am index f9bc879..130c9a0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -56,6 +56,7 @@ SOURCES = \ sly/render/tileset.scm \ sly/render/tile-map.scm \ sly/render/context.scm \ + sly/render/scene.scm \ $(WRAPPER_SOURCES) WRAPPER_SOURCES = \ diff --git a/sly/render/camera.scm b/sly/render/camera.scm index 48a66b2..9de7ae6 100644 --- a/sly/render/camera.scm +++ b/sly/render/camera.scm @@ -32,10 +32,15 @@ #:use-module (sly render color) #:use-module (sly math rect) #:use-module (sly math transform) - #:export (make-viewport viewport? - viewport-area viewport-clear-color viewport-clear-flags - %standard-clear-flags apply-viewport + #:export (make-viewport + viewport? + viewport-area + viewport-clear-color + viewport-clear-flags null-viewport + %standard-clear-flags + apply-viewport + clear-viewport make-camera camera? camera-location camera-projection camera-viewport orthographic-camera)) @@ -86,7 +91,10 @@ area, set the clear color, and clear necessary buffers." (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-color r g b a)))) + +(define (clear-viewport viewport) + "Clear the relevant OpenGL buffers VIEWPORT." (gl-clear (clear-buffer-mask (viewport-clear-flags viewport)))) ;;; diff --git a/sly/render/model.scm b/sly/render/model.scm index 4d15dc5..72a1719 100644 --- a/sly/render/model.scm +++ b/sly/render/model.scm @@ -44,7 +44,7 @@ model? model-null? null-model model-mesh model-transform model-texture model-shader model-color - model-blend-mode model-depth-test? model-children + model-blend-mode model-depth-test? model-sub-scene model-children draw-model model-paint model-blend @@ -56,7 +56,7 @@ ;; Representation of a single OpenGL render call. (define-record-type <model> (%make-model mesh transform texture shader color blend-mode - depth-test? children) + depth-test? sub-scene children) model? (mesh model-mesh) (transform model-transform) @@ -65,18 +65,21 @@ (color model-color) (blend-mode model-blend-mode) (depth-test? model-depth-test?) + (sub-scene model-sub-scene) (children model-children)) (define* (make-model #:optional #:key (mesh null-mesh) (transform identity-transform) (texture null-texture) (shader (load-default-shader)) (color white) (blend-mode default-blend-mode) (depth-test? #t) - (children '())) + sub-scene (children '())) "Create a new model from MESH and the given rendering state. When rendering, TEXTURE and SHADER are bound, BLEND-MODE and DEPTH-TEST? -are set, and the COLOR uniform variable is set." +are set, and the COLOR uniform variable is set. The presence of a +SUB-SCENE indicates that the model uses the scene's framebuffer as +it's texture, so it must be rendered first." (%make-model mesh transform texture shader color blend-mode - depth-test? children)) + depth-test? sub-scene children)) (define model make-model) @@ -131,49 +134,44 @@ changing the fields specified in KWARGS." (array-set! matrix 0 3 2) (array-set! matrix 1 3 3))) -(define draw-model - (let ((context (make-render-context))) - (lambda* (model camera #:optional (context context)) - "Render MODEL by applying its transform (multiplied by VIEW), texture, +;; Avoid circular dependency. +(define draw-sub-scene + (delay (module-ref (resolve-interface '(sly render scene)) 'draw-scene))) + +(define (draw-model model view context) + "Render MODEL by applying its transform (multiplied by VIEW), texture, shader, vertex array, uniforms, blend mode, etc. to the render CONTEXT." - (define (iter model view context) - (match model - ((? model-null? _) - *unspecified*) - (($ <model> mesh local-transform texture shader color blend-mode - depth-test? children) - (with-transform-excursion context - (render-context-transform*! context local-transform) - (with-transform-excursion context - (render-context-transform*! context view) - (set-render-context-depth-test?! context depth-test?) - (set-render-context-blend-mode! context blend-mode) - (set-render-context-shader! context shader) - (set-render-context-mesh! context mesh) - (set-render-context-texture! context texture) - ;; TODO: Support user-defined uniforms. - (uniform-set! shader "mvp" (render-context-transform context)) - (uniform-set! shader "color" color) - (uniform-set! shader "use_texture" (not (texture-null? texture))) - (glDrawElements (begin-mode triangles) - (mesh-length mesh) - (data-type unsigned-int) - %null-pointer)) - (for-each (lambda (child) - (iter child view context)) - children))))) - - (with-render-context context - (with-transform-excursion context - (let ((view (render-context-transform context))) - (transform*! view - (camera-location camera) - (camera-projection camera)) - (with-transform-excursion context - (render-context-transform-identity! context) - (apply-viewport (camera-viewport camera)) - (iter model view context)))))))) + (match model + ((? model-null? _) + *unspecified*) + (($ <model> mesh local-transform texture shader color blend-mode + depth-test? sub-scene children) + + (when sub-scene + (with-render-context-excursion context + ((force draw-sub-scene) sub-scene context))) + + (with-transform-excursion context + (render-context-transform*! context local-transform) + (with-transform-excursion context + (render-context-transform*! context view) + (set-render-context-depth-test?! context depth-test?) + (set-render-context-blend-mode! context blend-mode) + (set-render-context-shader! context shader) + (set-render-context-mesh! context mesh) + (set-render-context-texture! context texture) + ;; TODO: Support user-defined uniforms. + (uniform-set! shader "mvp" (render-context-transform context)) + (uniform-set! shader "color" color) + (uniform-set! shader "use_texture" (not (texture-null? texture))) + (glDrawElements (begin-mode triangles) + (mesh-length mesh) + (data-type unsigned-int) + %null-pointer)) + (for-each (lambda (child) + (draw-model child view context)) + children))))) ;;; ;;; Utility Procedures diff --git a/sly/render/scene.scm b/sly/render/scene.scm new file mode 100644 index 0000000..9f66902 --- /dev/null +++ b/sly/render/scene.scm @@ -0,0 +1,78 @@ +;;; Sly +;;; Copyright (C) 2015 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: +;; +;; Scene data type. +;; +;;; Code: + +(define-module (sly render scene) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:use-module (sly math transform) + #:use-module (sly render camera) + #:use-module (sly render context) + #:use-module (sly render framebuffer) + #:use-module (sly render model) + #:use-module (sly render sprite) + #:export (make-scene + scene + scene? + scene-camera + scene-model + scene-framebuffer + draw-scene + scene->sprite)) + +(define-record-type <scene> + (%make-scene camera model framebuffer) + scene? + (camera scene-camera) + (model scene-model) + (framebuffer scene-framebuffer)) + +(define* (make-scene camera model #:optional (framebuffer null-framebuffer)) + "Create a new scene that views MODEL from the perspective of CAMERA. +FRAMEBUFFER specifies where the scene will be drawn to. By default, a +scene is drawn to directly to the OpenGL window." + (%make-scene camera model framebuffer)) + +(define scene make-scene) + +(define (draw-scene scene context) + "Render SCENE with the given rendering CONTEXT." + (match scene + (($ <scene> camera model framebuffer) + (with-transform-excursion context + (render-context-transform-identity! context) + (let ((view (render-context-transform context))) + (transform*! view + (camera-location camera) + (camera-projection camera)) + (with-transform-excursion context + (render-context-transform-identity! context) + (set-render-context-framebuffer! context framebuffer) + (set-render-context-viewport! context (camera-viewport camera)) + (clear-viewport (camera-viewport camera)) + (draw-model model view context))))))) + +(define* (scene->sprite scene #:key (anchor 'center)) + "Create a sprite that renders the framebuffer texture for SCENE." + (model-inherit (make-sprite (framebuffer-texture (scene-framebuffer scene)) + #:anchor anchor) + #:sub-scene scene)) |