render: Reimplement OpenGL state machine manager.

The implementation is a bit cleaner, and it's a stepping stone towards
render combinators.

* sly/render/context.scm: Delete.
* sly/render.scm: New file.
* Makefile.am (SOURCES): Add it.  Remove context.scm.
* sly/game.scm (run-game-loop): Use new <graphics> type.
* sly/render/model.scm (draw-model): Likewise.
* sly/render/scene.scm (draw-scene): Likewise.
* examples/2048/2048.scm: Remove (sly render context) import.

3 files changed, 28 insertions, 228 deletions

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."