render: Add rendering context record type.

* sly/render/context.scm: New file.
* Makefile.am (SOURCES): Add it.
* sly/render/renderer.scm (with-texture-maybe): Delete.
  (apply-render-op): Use render context.
  (<renderer>) [context]: New field.
  (%make-renderer): New syntax.
  (make-renderer): Was syntax, now a procedure.
  (render): Use render context.
* sly/render/vertex-array.scm (apply-vertex-array): New procedure.
  (with-vertex-array): Use it.
* sly/shader.scm (apply-shader-program): New procedure.
  (with-shader-program): Use it.
* sly/texture.scm (apply-texture): New procedure.
  (with-texture): Use it.

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)))