summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--sly/render/context.scm105
-rw-r--r--sly/render/renderer.scm57
-rw-r--r--sly/render/vertex-array.scm7
-rw-r--r--sly/shader.scm6
-rw-r--r--sly/texture.scm6
6 files changed, 147 insertions, 35 deletions
diff --git a/Makefile.am b/Makefile.am
index 5dc36fc..45d501e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -56,6 +56,7 @@ SOURCES = \
sly/render/camera.scm \
sly/render/framebuffer.scm \
sly/render/vertex-array.scm \
+ sly/render/context.scm \
sly/render/renderer.scm \
$(WRAPPER_SOURCES)
diff --git a/sly/render/context.scm b/sly/render/context.scm
new file mode 100644
index 0000000..67e233d
--- /dev/null
+++ b/sly/render/context.scm
@@ -0,0 +1,105 @@
+;;; 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 (srfi srfi-9)
+ #:use-module (gl)
+ #:use-module (gl enums)
+ #:use-module (gl low-level)
+ #:use-module (sly wrappers gl)
+ #:use-module (sly shader)
+ #:use-module (sly texture)
+ #:use-module (sly render utils)
+ #:use-module (sly render vertex-array)
+ #: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-vertex-array set-render-context-vertex-array!))
+
+(define-record-type <render-context>
+ (%make-render-context blend-mode depth-test? texture shader vertex-array)
+ render-context?
+ (blend-mode render-context-blend-mode %set-render-context-blend-mode!)
+ (depth-test? render-context-depth-test? %set-render-context-depth-test?!)
+ (texture render-context-texture %set-render-context-texture!)
+ (shader render-context-shader %set-render-context-shader!)
+ (vertex-array render-context-vertex-array %set-render-context-vertex-array!))
+
+(define (make-render-context)
+ (%make-render-context #f #f #f #f #f))
+
+(define (render-context-reset! context)
+ (gl-disable (enable-cap blend))
+ (%set-render-context-blend-mode! context #f)
+ (gl-disable (enable-cap depth-test))
+ (%set-render-context-depth-test?! context #f)
+ (glBindTexture (texture-target texture-2d) 0)
+ (%set-render-context-texture! context #f)
+ (glUseProgram 0)
+ (%set-render-context-shader! context #f)
+ (glBindVertexArray 0)
+ (%set-render-context-vertex-array! context #f))
+
+(define-syntax-rule (with-render-context context body ...)
+ (begin (render-context-reset! context) body ...))
+
+(define (set-render-context-blend-mode! context blend-mode)
+ (unless (equal? (render-context-blend-mode context) blend-mode)
+ (if blend-mode
+ (apply-blend-mode blend-mode)
+ ;; Turn off blending if there is no blend-mode specified.
+ (gl-disable (enable-cap blend)))
+ (%set-render-context-blend-mode! context blend-mode)))
+
+(define (set-render-context-depth-test?! context depth-test?)
+ (unless (eq? (render-context-depth-test? context) depth-test?)
+ (if depth-test?
+ (gl-enable (enable-cap depth-test))
+ (gl-disable (enable-cap depth-test)))
+ (%set-render-context-depth-test?! context depth-test?)))
+
+(define (set-render-context-texture! context texture)
+ (let ((current-texture (render-context-texture context)))
+ (unless (equal? current-texture texture)
+ (if texture
+ (begin
+ ;; Enable texturing if it was disabled.
+ (unless current-texture
+ (gl-enable (enable-cap texture-2d)))
+ (apply-texture texture))
+ (gl-disable (enable-cap texture-2d)))
+ (%set-render-context-texture! context texture))))
+
+(define (set-render-context-shader! context shader)
+ (unless (equal? (render-context-shader context) shader)
+ (apply-shader-program shader)
+ (%set-render-context-shader! context shader)))
+
+(define (set-render-context-vertex-array! context vertex-array)
+ (unless (equal? (render-context-vertex-array context) vertex-array)
+ (apply-vertex-array vertex-array)
+ (%set-render-context-vertex-array! context vertex-array)))
diff --git a/sly/render/renderer.scm b/sly/render/renderer.scm
index 3584023..19ab170 100644
--- a/sly/render/renderer.scm
+++ b/sly/render/renderer.scm
@@ -33,6 +33,7 @@
#:use-module (sly transform)
#:use-module (sly math vector)
#:use-module (sly render utils)
+ #:use-module (sly render context)
#:use-module (sly render vertex-array)
#:export (make-render-op render-op?
render-op-transform render-op-vertex-array
@@ -78,47 +79,41 @@ with its transformation matrix multiplied by TRANSFORM."
(%make-render-op (transform* transform local-transform) vertex-array
texture shader uniforms blend-mode depth-test?))))
-(define-syntax-rule (with-texture-maybe texture body ...)
- (if texture
- (with-texture texture body ...)
- (begin body ...)))
-
-(define (apply-render-op op)
+(define (apply-render-op context op)
"Render OP by applying its texture, shader, vertex array, uniforms,
blend mode, etc.."
(match op
(($ <render-op> transform vertex-array texture shader uniforms
blend-mode depth-test?)
- (when depth-test?
- (gl-enable (enable-cap depth-test)))
- (if blend-mode
- (begin
- (gl-enable (enable-cap blend))
- (apply-blend-mode blend-mode))
- (gl-disable (enable-cap blend)))
- (with-shader-program shader
- (for-each (lambda (uniform)
- (match uniform
- ((name value)
- (uniform-set! shader name value))))
- `(("mvp" ,transform)
- ,@uniforms))
- (with-vertex-array vertex-array
- (with-texture-maybe texture
- (glDrawElements (begin-mode triangles)
- (vertex-array-length vertex-array)
- (data-type unsigned-int)
- %null-pointer))))
- (when depth-test?
- (gl-disable (enable-cap depth-test))))))
+ (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-vertex-array! context vertex-array)
+ (set-render-context-texture! context texture)
+ (for-each (lambda (uniform)
+ (match uniform
+ ((name value)
+ (uniform-set! shader name value))))
+ `(("mvp" ,transform)
+ ,@uniforms))
+ (glDrawElements (begin-mode triangles)
+ (vertex-array-length vertex-array)
+ (data-type unsigned-int)
+ %null-pointer))))
(define-record-type <renderer>
- (make-renderer ops)
+ (%make-renderer context ops)
renderer?
+ (context renderer-context)
(ops renderer-ops))
+(define (make-renderer ops)
+ (%make-renderer (make-render-context) ops))
+
(define (render renderer)
"Apply all of the render operations in RENDERER. The render
operations are applied once for each camera."
- (for-each (cut apply-render-op <>)
- (renderer-ops renderer)))
+ (let ((context (renderer-context renderer)))
+ (with-render-context context
+ (for-each (cut apply-render-op context <>)
+ (renderer-ops renderer)))))
diff --git a/sly/render/vertex-array.scm b/sly/render/vertex-array.scm
index fbe8f28..51caad1 100644
--- a/sly/render/vertex-array.scm
+++ b/sly/render/vertex-array.scm
@@ -37,7 +37,7 @@
#:export (make-vertex-array
vertex-array?
vertex-array-id vertex-array-length
- with-vertex-array))
+ apply-vertex-array with-vertex-array))
;;;
;;; Vertex Buffers
@@ -145,9 +145,12 @@
(glGenVertexArrays 1 (bytevector->pointer bv))
(u32vector-ref bv 0)))
+(define (apply-vertex-array vao)
+ (glBindVertexArray (vertex-array-id vao)))
+
(define-syntax-rule (with-vertex-array vao body ...)
(begin
- (glBindVertexArray (vertex-array-id vao))
+ (apply-vertex-array vao)
body ...
(glBindVertexArray 0)))
diff --git a/sly/shader.scm b/sly/shader.scm
index 4c31edc..5e9ad0a 100644
--- a/sly/shader.scm
+++ b/sly/shader.scm
@@ -52,6 +52,7 @@
shader-program-id
shader-program?
shader-program-linked?
+ apply-shader-program
with-shader-program
load-default-shader
%uniform-setters
@@ -282,11 +283,14 @@ VERTEX-SHADER and FRAGMENT-SHADER."
(define current-shader-program (make-parameter #f))
+(define (apply-shader-program shader-program)
+ (glUseProgram (shader-program-id shader-program)))
+
(define-syntax-rule (with-shader-program shader-program body ...)
"Evaluate BODY with SHADER-PROGRAM bound."
(parameterize ((current-shader-program shader-program))
(begin
- (glUseProgram (shader-program-id shader-program))
+ (apply-shader-program shader-program)
(let ((return-value (begin body ...)))
(glUseProgram 0)
return-value))))
diff --git a/sly/texture.scm b/sly/texture.scm
index 55b6204..15521a0 100644
--- a/sly/texture.scm
+++ b/sly/texture.scm
@@ -49,6 +49,7 @@
texture-vertex
pack-texture-vertices
draw-texture-vertices
+ apply-texture
with-texture))
;;;
@@ -216,9 +217,12 @@ vector to be returned."
(pack vertices (+ offset 2) texture-vertex width height s2 t2)
(pack vertices (+ offset 3) texture-vertex width 0 s2 t1))
+(define (apply-texture texture)
+ (glBindTexture (texture-target texture-2d) (texture-id texture)))
+
(define-syntax-rule (with-texture texture body ...)
(begin
- (glBindTexture (texture-target texture-2d) (texture-id texture))
+ (apply-texture texture)
body
...
(glBindTexture (texture-target texture-2d) 0)))