diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | sly/render/context.scm | 105 | ||||
| -rw-r--r-- | sly/render/renderer.scm | 57 | ||||
| -rw-r--r-- | sly/render/vertex-array.scm | 7 | ||||
| -rw-r--r-- | sly/shader.scm | 6 | ||||
| -rw-r--r-- | sly/texture.scm | 6 |
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))) |