summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am4
-rwxr-xr-xexamples/2048/2048.scm1
-rw-r--r--sly/game.scm14
-rw-r--r--sly/render.scm206
-rw-r--r--sly/render/context.scm199
-rw-r--r--sly/render/model.scm35
-rw-r--r--sly/render/scene.scm22
7 files changed, 243 insertions, 238 deletions
diff --git a/Makefile.am b/Makefile.am
index a6405d5..dad4409 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -48,14 +48,14 @@ SOURCES = \
sly/render/font.scm \
sly/render/framebuffer.scm \
sly/render/mesh.scm \
- sly/render/model.scm \
sly/render/texture.scm \
sly/render/shader.scm \
sly/render/shape.scm \
sly/render/sprite.scm \
sly/render/tileset.scm \
sly/render/tile-map.scm \
- sly/render/context.scm \
+ sly/render.scm \
+ sly/render/model.scm \
sly/render/scene.scm \
$(WRAPPER_SOURCES) \
sly.scm
diff --git a/examples/2048/2048.scm b/examples/2048/2048.scm
index 043835b..97922de 100755
--- a/examples/2048/2048.scm
+++ b/examples/2048/2048.scm
@@ -35,7 +35,6 @@
(sly math vector)
(sly render camera)
(sly render color)
- (sly render context)
(sly render font)
(sly render model)
(sly render scene)
diff --git a/sly/game.scm b/sly/game.scm
index b836c22..7e4a79c 100644
--- a/sly/game.scm
+++ b/sly/game.scm
@@ -34,7 +34,7 @@
#:use-module (sly signal)
#:use-module (sly math vector)
#:use-module (sly window)
- #:use-module (sly render context)
+ #:use-module (sly render)
#:use-module (sly render scene)
#:export (draw-hook
after-game-loop-error-hook
@@ -63,9 +63,9 @@ for the given STACK and error KEY with additional arguments ARGS."
(newline cep)))
(define* (run-game-loop scene #:key
- (frame-rate 60)
- (tick-rate 60)
- (max-ticks-per-frame 4))
+ (frame-rate 60)
+ (tick-rate 60)
+ (max-ticks-per-frame 4))
"Run the game loop. SCENE is a signal which contains the current
scene to render. FRAME-RATE specifies the optimal number of frames to
draw SCENE per second. TICK-RATE specifies the optimal game logic
@@ -76,7 +76,7 @@ due to poor performance, the game will start to slow down instead of
becoming completely unresponsive and possibly crashing."
(let ((tick-interval (interval tick-rate))
(frame-interval (interval frame-rate))
- (context (make-render-context)))
+ (gfx (make-graphics)))
(define (draw dt alpha)
"Render a frame."
@@ -84,8 +84,8 @@ becoming completely unresponsive and possibly crashing."
(gl-viewport 0 0 (vx size) (vy size)))
(gl-clear (clear-buffer-mask color-buffer depth-buffer))
(run-hook draw-hook dt alpha)
- (with-render-context context
- (draw-scene (signal-ref scene) context))
+ (with-graphics gfx
+ (draw-scene (signal-ref scene) gfx))
(SDL:gl-swap-buffers))
(define (update lag)
diff --git a/sly/render.scm b/sly/render.scm
new file mode 100644
index 0000000..15103cd
--- /dev/null
+++ b/sly/render.scm
@@ -0,0 +1,206 @@
+;;; 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:
+;;
+;; Manages the OpenGL state machine.
+;;
+;;; Code:
+
+(define-module (sly render)
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 q)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-42)
+ #:use-module (gl)
+ #:use-module (gl enums)
+ #:use-module (gl low-level)
+ #:use-module (sly wrappers gl)
+ #:use-module (sly math transform)
+ #:use-module (sly render shader)
+ #:use-module (sly render texture)
+ #:use-module (sly render utils)
+ #:use-module (sly render mesh)
+ #:use-module (sly render framebuffer)
+ #:use-module (sly render camera)
+ #:export (make-graphics
+ graphics?
+ graphics-blend-mode
+ set-graphics-blend-mode!
+ graphics-depth-test?
+ set-graphics-depth-test!
+ graphics-texture
+ set-graphics-texture!
+ graphics-shader
+ set-graphics-shader!
+ graphics-mesh
+ set-graphics-mesh!
+ graphics-framebuffer
+ set-graphics-framebuffer!
+ graphics-viewport
+ set-graphics-viewport!
+ graphics-transform
+ graphics-transform-mul!
+ graphics-transform-identity!
+ with-graphics
+ with-transform-excursion
+ with-graphics-excursion))
+
+;;;
+;;; Transformation matrix stack.
+;;;
+
+(define (make-null-transform)
+ (make-transform 0 0 0 0
+ 0 0 0 0
+ 0 0 0 0
+ 0 0 0 0))
+
+(define (make-transform-stack size)
+ (let ((stack (make-q)))
+ (do-ec (: i size) (q-push! stack (make-null-transform)))
+ stack))
+
+(define (copy-transform! src dest)
+ (bytevector-copy! (transform-matrix src) 0
+ (transform-matrix dest) 0
+ 64))
+
+(define (call-with-transform-excursion stack thunk)
+ (let ((t (q-pop! stack)))
+ (dynamic-wind
+ (lambda ()
+ (copy-transform! t (q-front stack)))
+ thunk
+ (lambda ()
+ (q-push! stack t)))))
+
+(define (stack-transform-mul! stack t)
+ (let ((dest (q-front stack)))
+ (call-with-transform-excursion stack
+ (lambda ()
+ (transform*! dest (q-front stack) t)))))
+
+(define (stack-transform-identity! stack)
+ (copy-transform! identity-transform (q-front stack)))
+
+;;;
+;;; Graphics context.
+;;;
+
+(define-record-type <graphics>
+ (%make-graphics blend-mode depth-test? texture shader
+ mesh framebuffer viewport projection model-view)
+ graphics?
+ (blend-mode graphics-blend-mode %set-graphics-blend-mode!)
+ (depth-test? graphics-depth-test? %set-graphics-depth-test!)
+ (texture graphics-texture %set-graphics-texture!)
+ (shader graphics-shader %set-graphics-shader!)
+ (mesh graphics-mesh %set-graphics-mesh!)
+ (framebuffer graphics-framebuffer %set-graphics-framebuffer!)
+ (viewport graphics-viewport %set-graphics-viewport!)
+ (projection graphics-projection)
+ (model-view graphics-model-view))
+
+(define (make-context-switcher getter setter switch)
+ (lambda* (gfx x #:optional force)
+ (when (or force (not (equal? (getter gfx) x)))
+ (setter gfx x)
+ (switch x))))
+
+(define set-graphics-blend-mode!
+ (make-context-switcher graphics-blend-mode
+ %set-graphics-blend-mode!
+ apply-blend-mode))
+
+(define set-graphics-depth-test!
+ (make-context-switcher graphics-depth-test?
+ %set-graphics-depth-test!
+ apply-depth-test))
+
+(define set-graphics-texture!
+ (make-context-switcher graphics-texture
+ %set-graphics-texture!
+ apply-texture))
+
+(define set-graphics-shader!
+ (make-context-switcher graphics-shader
+ %set-graphics-shader!
+ apply-shader-program))
+
+(define set-graphics-mesh!
+ (make-context-switcher graphics-mesh
+ %set-graphics-mesh!
+ apply-mesh))
+
+(define set-graphics-framebuffer!
+ (make-context-switcher graphics-framebuffer
+ %set-graphics-framebuffer!
+ apply-framebuffer))
+
+(define set-graphics-viewport!
+ (make-context-switcher graphics-viewport
+ %set-graphics-viewport!
+ apply-viewport))
+
+(define* (make-graphics #:optional (transform-stack-size 32))
+ (%make-graphics #f #f #f #f #f #f #f
+ (make-transform-stack transform-stack-size)
+ (make-transform-stack transform-stack-size)))
+
+(define (graphics-reset! gfx)
+ (set-graphics-blend-mode! gfx #f)
+ (set-graphics-depth-test! gfx #f)
+ (set-graphics-texture! gfx null-texture)
+ (set-graphics-shader! gfx null-shader-program)
+ (set-graphics-mesh! gfx null-mesh)
+ (set-graphics-framebuffer! gfx null-framebuffer)
+ (set-graphics-viewport! gfx null-viewport)
+ (stack-transform-identity! (graphics-projection gfx))
+ (stack-transform-identity! (graphics-model-view gfx)))
+
+(define-syntax-rule (with-graphics gfx body ...)
+ (begin (graphics-reset! gfx) body ...))
+
+(define (graphics-transform gfx)
+ (q-front (graphics-model-view gfx)))
+
+(define (graphics-transform-mul! gfx t)
+ (stack-transform-mul! (graphics-model-view gfx) t))
+
+(define (graphics-transform-identity! gfx)
+ (stack-transform-identity! (graphics-model-view gfx)))
+
+;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1)
+(define-syntax-rule (with-transform-excursion gfx body ...)
+ (call-with-transform-excursion (graphics-model-view gfx)
+ (lambda ()
+ body ...)))
+
+(define-syntax-rule (with-graphics-excursion gfx body ...)
+ (match gfx
+ (($ <graphics> blend-mode depth-test? texture shader mesh
+ viewport framebuffer _ _)
+ body ...
+ (set-graphics-blend-mode! gfx blend-mode)
+ (set-graphics-depth-test! gfx depth-test?)
+ (set-graphics-texture! gfx texture)
+ (set-graphics-shader! gfx shader)
+ (set-graphics-mesh! gfx mesh)
+ (set-graphics-framebuffer! gfx framebuffer)
+ (set-graphics-viewport! gfx viewport))))
diff --git a/sly/render/context.scm b/sly/render/context.scm
deleted file mode 100644
index a83b612..0000000
--- a/sly/render/context.scm
+++ /dev/null
@@ -1,199 +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:
-;;
-;; Manages OpenGL state and reduces state changes.
-;;
-;;; Code:
-
-(define-module (sly render context)
- #:use-module (rnrs bytevectors)
- #:use-module (ice-9 match)
- #:use-module (ice-9 q)
- #:use-module (srfi srfi-9)
- #:use-module (srfi srfi-42)
- #:use-module (gl)
- #:use-module (gl enums)
- #:use-module (gl low-level)
- #:use-module (sly wrappers gl)
- #:use-module (sly math transform)
- #:use-module (sly render shader)
- #:use-module (sly render texture)
- #:use-module (sly render utils)
- #:use-module (sly render mesh)
- #:use-module (sly render framebuffer)
- #:use-module (sly render camera)
- #:export (make-render-context
- render-context?
- with-render-context
- render-context-blend-mode set-render-context-blend-mode!
- render-context-depth-test? set-render-context-depth-test?!
- render-context-texture set-render-context-texture!
- render-context-shader set-render-context-shader!
- render-context-mesh set-render-context-mesh!
- render-context-framebuffer set-render-context-framebuffer!
- render-context-viewport set-render-context-viewport!
- render-context-transform render-context-transform*!
- render-context-transform-identity!
- with-transform-excursion
- with-render-context-excursion))
-
-(define-record-type <gl-parameter>
- (%make-gl-parameter default bind value)
- gl-parameter?
- (default gl-parameter-default)
- (bind gl-parameter-bind)
- (value gl-parameter-ref %gl-parameter-set!))
-
-(define (make-gl-parameter default bind)
- (%make-gl-parameter default bind default))
-
-(define* (gl-parameter-set! parameter value #:optional force?)
- (unless (and (not force?) (equal? (gl-parameter-ref parameter) value))
- (%gl-parameter-set! parameter value)
- ((gl-parameter-bind parameter) value)))
-
-(define (gl-parameter-reset! parameter)
- (gl-parameter-set! parameter (gl-parameter-default parameter) #t))
-
-(define-record-type <render-context>
- (%make-render-context blend-mode depth-test? texture shader
- mesh framebuffer viewport transform-stack)
- render-context?
- (blend-mode render-context-blend-mode)
- (depth-test? render-context-depth-test?)
- (texture render-context-texture)
- (shader render-context-shader)
- (mesh render-context-mesh)
- (framebuffer render-context-framebuffer)
- (viewport render-context-viewport)
- (transform-stack render-context-transform-stack))
-
-(define (make-null-transform)
- (make-transform 0 0 0 0
- 0 0 0 0
- 0 0 0 0
- 0 0 0 0))
-
-(define (make-transform-stack size)
- (let ((stack (make-q)))
- (do-ec (: i 128) (q-push! stack (make-null-transform)))
- stack))
-
-(define* (make-render-context #:optional (transform-stack-size 32))
- (%make-render-context (make-gl-parameter #f apply-blend-mode)
- (make-gl-parameter #t apply-depth-test)
- (make-gl-parameter null-texture apply-texture)
- (make-gl-parameter null-shader-program
- apply-shader-program)
- (make-gl-parameter null-mesh apply-mesh)
- (make-gl-parameter null-framebuffer apply-framebuffer)
- (make-gl-parameter null-viewport apply-viewport)
- (make-transform-stack transform-stack-size)))
-
-(define (render-context-reset! context)
- (gl-parameter-reset! (render-context-blend-mode context))
- (gl-parameter-reset! (render-context-depth-test? context))
- (gl-parameter-reset! (render-context-texture context))
- (gl-parameter-reset! (render-context-shader context))
- (gl-parameter-reset! (render-context-mesh context))
- (gl-parameter-reset! (render-context-framebuffer context))
- (gl-parameter-reset! (render-context-viewport context))
- (render-context-transform-identity! context))
-
-(define-syntax-rule (with-render-context context body ...)
- (begin (render-context-reset! context)
- body ...
- (render-context-reset! context)))
-
-(define-syntax-rule (define-context-setter name accessor)
- (define (name context value)
- (gl-parameter-set! (accessor context) value)))
-
-(define-context-setter set-render-context-blend-mode!
- render-context-blend-mode)
-
-(define-context-setter set-render-context-depth-test?!
- render-context-depth-test?)
-
-(define-context-setter set-render-context-texture!
- render-context-texture)
-
-(define-context-setter set-render-context-shader!
- render-context-shader)
-
-(define-context-setter set-render-context-mesh!
- render-context-mesh)
-
-(define-context-setter set-render-context-framebuffer!
- render-context-framebuffer)
-
-(define-context-setter set-render-context-viewport!
- render-context-viewport)
-
-(define (render-context-transform context)
- (q-front (render-context-transform-stack context)))
-
-(define (render-context-push-transform! context t)
- (q-push! (render-context-transform-stack context) t))
-
-(define render-context-pop-transform!
- (compose q-pop! render-context-transform-stack))
-
-(define (copy-transform! src dest)
- (bytevector-copy! (transform-matrix src) 0
- (transform-matrix dest) 0
- 64))
-
-;; emacs: (put 'with-transform-excursion 'scheme-indent-function 1)
-(define-syntax-rule (with-transform-excursion context body ...)
- (let ((t (render-context-pop-transform! context)))
- (dynamic-wind
- (lambda ()
- (copy-transform! t (render-context-transform context)))
- (lambda () body ...)
- (lambda ()
- (render-context-push-transform! context t)))))
-
-(define (render-context-transform*! context t)
- (let ((dest (render-context-transform context)))
- (with-transform-excursion context
- (transform*! dest (render-context-transform context) t))))
-
-(define (render-context-transform-identity! context)
- (copy-transform! identity-transform (render-context-transform context)))
-
-(define-syntax-rule (with-render-context-excursion context body ...)
- (match context
- (($ <render-context> blend-mode depth-test? texture shader mesh
- viewport framebuffer _)
- (let ((prev-blend-mode (gl-parameter-ref blend-mode))
- (prev-depth-test? (gl-parameter-ref depth-test?))
- (prev-texture (gl-parameter-ref texture))
- (prev-shader (gl-parameter-ref shader))
- (prev-mesh (gl-parameter-ref mesh))
- (prev-framebuffer (gl-parameter-ref framebuffer))
- (prev-viewport (gl-parameter-ref viewport)))
- body ...
- (gl-parameter-set! blend-mode prev-blend-mode)
- (gl-parameter-set! depth-test? prev-depth-test?)
- (gl-parameter-set! texture prev-texture)
- (gl-parameter-set! shader prev-shader)
- (gl-parameter-set! mesh prev-mesh)
- (gl-parameter-set! framebuffer prev-framebuffer)
- (gl-parameter-set! viewport prev-viewport)))))
diff --git a/sly/render/model.scm b/sly/render/model.scm
index 3cc310a..77c550e 100644
--- a/sly/render/model.scm
+++ b/sly/render/model.scm
@@ -31,12 +31,12 @@
#:use-module (sly math transform)
#:use-module (sly math vector)
#:use-module (sly math rect)
+ #:use-module (sly render)
#:use-module (sly render shader)
#:use-module (sly render texture)
#:use-module (sly render utils)
#:use-module (sly render camera)
#:use-module (sly render color)
- #:use-module (sly render context)
#:use-module (sly render mesh)
#:export (make-model
model
@@ -139,10 +139,9 @@ changing the fields specified in KWARGS."
(define draw-sub-scene
(delay (module-ref (resolve-interface '(sly render scene)) 'draw-scene)))
-(define (draw-model model view context)
+(define (draw-model model view gfx)
"Render MODEL by applying its transform (multiplied by VIEW), texture,
-shader, vertex array, uniforms, blend mode, etc. to the render
-CONTEXT."
+shader, vertex array, uniforms, blend mode, etc. using GFX."
(match model
((? model-null? _)
*unspecified*)
@@ -150,20 +149,20 @@ CONTEXT."
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)
+ (with-graphics-excursion gfx
+ ((force draw-sub-scene) sub-scene gfx)))
+
+ (with-transform-excursion gfx
+ (graphics-transform-mul! gfx local-transform)
+ (with-transform-excursion gfx
+ (graphics-transform-mul! gfx view)
+ (set-graphics-depth-test! gfx depth-test?)
+ (set-graphics-blend-mode! gfx blend-mode)
+ (set-graphics-shader! gfx shader)
+ (set-graphics-mesh! gfx mesh)
+ (set-graphics-texture! gfx texture)
;; TODO: Support user-defined uniforms.
- (uniform-set! shader "mvp" (render-context-transform context))
+ (uniform-set! shader "mvp" (graphics-transform gfx))
(uniform-set! shader "color" color)
(uniform-set! shader "use_texture" (not (texture-null? texture)))
(glDrawElements (begin-mode triangles)
@@ -171,7 +170,7 @@ CONTEXT."
(data-type unsigned-int)
%null-pointer))
(for-each (lambda (child)
- (draw-model child view context))
+ (draw-model child view gfx))
children)))))
;;;
diff --git a/sly/render/scene.scm b/sly/render/scene.scm
index 9f66902..48e8af7 100644
--- a/sly/render/scene.scm
+++ b/sly/render/scene.scm
@@ -25,8 +25,8 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (sly math transform)
+ #:use-module (sly render)
#: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)
@@ -54,22 +54,22 @@ scene is drawn to directly to the OpenGL window."
(define scene make-scene)
-(define (draw-scene scene context)
- "Render SCENE with the given rendering CONTEXT."
+(define (draw-scene scene gfx)
+ "Render SCENE with the given rendering GFX."
(match scene
(($ <scene> camera model framebuffer)
- (with-transform-excursion context
- (render-context-transform-identity! context)
- (let ((view (render-context-transform context)))
+ (with-transform-excursion gfx
+ (graphics-transform-identity! gfx)
+ (let ((view (graphics-transform gfx)))
(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))
+ (with-transform-excursion gfx
+ (graphics-transform-identity! gfx)
+ (set-graphics-framebuffer! gfx framebuffer)
+ (set-graphics-viewport! gfx (camera-viewport camera))
(clear-viewport (camera-viewport camera))
- (draw-model model view context)))))))
+ (draw-model model view gfx)))))))
(define* (scene->sprite scene #:key (anchor 'center))
"Create a sprite that renders the framebuffer texture for SCENE."