summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--sly/render/camera.scm16
-rw-r--r--sly/render/model.scm90
-rw-r--r--sly/render/scene.scm78
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))