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.

1 files changed, 206 insertions, 0 deletions

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