render: Collect all managed GPU state into a single record type.

9 files changed, 142 insertions, 76 deletions

diff --git a/chickadee.scm b/chickadee.scm
index 3066f26..58513d4 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -144,6 +144,7 @@ not being pushed at all."
                               #:size (list window-width window-height)
                               #:fullscreen? window-fullscreen?))
          (gl-context (make-gl-context window))
+         (gpu (make-gpu gl-context))
          (default-viewport (make-viewport 0 0 window-width window-height))
          (default-projection (orthographic-projection 0 window-width
                                                       window-height 0
@@ -221,7 +222,7 @@ not being pushed at all."
       ;; Switch to the null viewport to ensure that
       ;; the default viewport will be re-applied and
       ;; clear the screen.
-      (gpu-state-set! *viewport-state* null-viewport)
+      (set-gpu-viewport! gpu null-viewport)
       (with-viewport default-viewport
         (with-projection default-projection
           (draw alpha)))
@@ -229,7 +230,8 @@ not being pushed at all."
     (dynamic-wind
       (const #t)
       (lambda ()
-        (parameterize ((current-window window))
+        (parameterize ((current-window window)
+                       (current-gpu gpu))
           ;; Attempt to activate vsync, if possible.  Some systems do
           ;; not support setting the OpenGL swap interval.
           (catch #t
diff --git a/chickadee/render.scm b/chickadee/render.scm
index 8b5ba6c..49244f9 100644
--- a/chickadee/render.scm
+++ b/chickadee/render.scm
@@ -140,18 +140,18 @@
              (uniform-apply shader rest)))))))
 
 (define-syntax-rule (gpu-prepare shader vertex-array uniforms)
-  (begin
+  (let ((gpu (current-gpu)))
     ;; It's important that the framebuffer is set before setting the
     ;; viewport because applying a new viewport will clear the current
     ;; framebuffer.
-    (gpu-state-set! *framebuffer-state* (current-framebuffer))
-    (gpu-state-set! *viewport-state* (current-viewport))
-    (gpu-state-set! *blend-mode-state* (current-blend-mode))
-    (gpu-state-set! *depth-test-state* (current-depth-test))
-    (gpu-state-set! *shader-state* shader)
+    (set-gpu-framebuffer! gpu (current-framebuffer))
+    (set-gpu-viewport! gpu (current-viewport))
+    (set-gpu-blend-mode! gpu (current-blend-mode))
+    (set-gpu-depth-test! gpu (current-depth-test))
+    (set-gpu-shader! gpu shader)
     (let loop ((i 0))
       (when (< i 32)
-        (texture-set! i (current-texture i))
+        (set-gpu-texture! gpu i (current-texture i))
         (loop (1+ i))))
     (uniform-apply shader uniforms)
     ;; Sampler2D values aren't explicitly passed as uniform values via
diff --git a/chickadee/render/blend.scm b/chickadee/render/blend.scm
index 2452ef8..e5f3ffc 100644
--- a/chickadee/render/blend.scm
+++ b/chickadee/render/blend.scm
@@ -20,8 +20,8 @@
   #:use-module (gl)
   #:use-module (chickadee render gl)
   #:use-module (chickadee render gpu)
-  #:export (*blend-mode-state*
-            *depth-test-state*))
+  #:export (apply-blend-mode
+            apply-depth-test))
 
 (define (apply-blend-mode blend-mode)
   (if blend-mode
@@ -63,11 +63,7 @@
                           (blending-factor-dest zero)))))
       (gl-disable (enable-cap blend))))
 
-(define *blend-mode-state* (make-gpu-state apply-blend-mode 'replace))
-
 (define (apply-depth-test depth-test?)
   (if depth-test?
       (gl-enable (enable-cap depth-test))
       (gl-disable (enable-cap depth-test))))
-
-(define *depth-test-state* (make-gpu-state apply-depth-test #f))
diff --git a/chickadee/render/buffer.scm b/chickadee/render/buffer.scm
index 3361ba2..c38e1fc 100644
--- a/chickadee/render/buffer.scm
+++ b/chickadee/render/buffer.scm
@@ -50,7 +50,6 @@
             map-buffer!
             unmap-buffer!
             with-mapped-buffer
-            *buffer-state*
             make-buffer-view
             make-streaming-buffer-view
             buffer-view?
@@ -76,7 +75,6 @@
             vertex-array-attributes
             vertex-array-mode
             null-vertex-array
-            *vertex-array-state*
             render-vertices
             render-vertices/instanced))
 
@@ -121,9 +119,6 @@
   (gl-bind-buffer (buffer-target-gl buffer)
                   (buffer-id buffer)))
 
-(define *buffer-state*
-  (make-gpu-state apply-buffer null-buffer))
-
 (define (generate-buffer-gl)
   (let ((bv (u32vector 1)))
     (gl-gen-buffers 1 (bytevector->pointer bv))
@@ -172,7 +167,7 @@ NAME is simply an arbitrary string for debugging purposes that is
 never sent to the GPU."
   ;; Weird bugs will occur when creating a new vertex buffer while a
   ;; vertex array is bound.
-  (gpu-state-set! *vertex-array-state* null-vertex-array)
+  (set-gpu-vertex-array! (current-gpu) null-vertex-array)
   (let ((buffer (gpu-guard
                  (%make-buffer (generate-buffer-gl)
                                name
@@ -181,14 +176,14 @@ never sent to the GPU."
                                target
                                usage
                                #f))))
-    (gpu-state-set! *buffer-state* buffer)
+    (set-gpu-vertex-buffer! (current-gpu) buffer)
     (gl-buffer-data (buffer-target-gl buffer)
                     length
                     (if data
                         (bytevector->pointer data offset)
                         %null-pointer)
                     (buffer-usage-gl buffer))
-    (gpu-state-set! *buffer-state* null-buffer)
+    (set-gpu-vertex-buffer! (current-gpu) null-buffer)
     buffer))
 
 (define* (make-streaming-buffer length #:key
@@ -210,7 +205,7 @@ vertex buffer data back to the GPU."
   (unless (buffer-mapped? buffer) ;; Don't map a buffer that is already mapped!
     (let ((target (buffer-target-gl buffer))
           (length (buffer-length buffer)))
-      (gpu-state-set! *buffer-state* buffer)
+      (set-gpu-vertex-buffer! (current-gpu) buffer)
       (when (eq? (buffer-usage buffer) 'stream)
         ;; Orphan the buffer to avoid implicit synchronization.
         ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
@@ -223,7 +218,7 @@ vertex buffer data back to the GPU."
 
 (define (unmap-buffer! buffer)
   "Return the mapped vertex buffer data for BUFFER to the GPU."
-  (gpu-state-set! *buffer-state* buffer)
+  (set-gpu-vertex-buffer! (current-gpu) buffer)
   (gl-unmap-buffer (buffer-target-gl buffer))
   (set-buffer-data! buffer #f))
 
@@ -404,7 +399,7 @@ which attributes advance when rendering multiple instances."
   (with-mapped-buffer (buffer-view->buffer buffer-view) body ...))
 
 (define* (apply-buffer-view buffer-view #:optional attribute-index)
-  (gpu-state-set! *buffer-state* (buffer-view->buffer buffer-view))
+  (set-gpu-vertex-buffer! (current-gpu) (buffer-view->buffer buffer-view))
   ;; If there is no attribute-index, we assume this is being bound for
   ;; use as an index buffer.
   (when attribute-index
@@ -547,9 +542,6 @@ which attributes advance when rendering multiple instances."
 (define (apply-vertex-array va)
   (gl-bind-vertex-array (vertex-array-id va)))
 
-(define *vertex-array-state*
-  (make-gpu-state apply-vertex-array null-vertex-array))
-
 (define* (make-vertex-array #:key indices attributes (mode 'triangles))
   "Return a new vertex array using the index data within the typed
 buffer INDICES and the vertex attribute data within ATTRIBUTES, an
@@ -572,13 +564,13 @@ argument may be overridden.  The following values are supported:
                                     indices
                                     attributes
                                     mode))))
-    (gpu-state-set! *vertex-array-state* array)
+    (set-gpu-vertex-array! (current-gpu) array)
     (for-each (match-lambda
                 ((index . buffer-view)
                  (apply-buffer-view buffer-view index)))
               attributes)
     (apply-buffer-view indices)
-    (gpu-state-set! *vertex-array-state* null-vertex-array)
+    (set-gpu-vertex-array! (current-gpu) null-vertex-array)
     array))
 
 (define (vertex-array-mode-gl array)
@@ -592,7 +584,7 @@ argument may be overridden.  The following values are supported:
     ('triangle-fan (begin-mode triangle-fan))))
 
 (define* (render-vertices array #:optional count)
-  (gpu-state-set! *vertex-array-state* array)
+  (set-gpu-vertex-array! (current-gpu) array)
   (let ((indices (vertex-array-indices array)))
     (gl-draw-elements (vertex-array-mode-gl array)
                       (or count
@@ -601,7 +593,7 @@ argument may be overridden.  The following values are supported:
                       %null-pointer)))
 
 (define* (render-vertices/instanced array instances #:optional count)
-  (gpu-state-set! *vertex-array-state* array)
+  (set-gpu-vertex-array! (current-gpu) array)
   (let ((indices (vertex-array-indices array)))
     (gl-draw-elements-instanced (vertex-array-mode-gl array)
                                 (or count
diff --git a/chickadee/render/framebuffer.scm b/chickadee/render/framebuffer.scm
index 86fc417..d5a8d44 100644
--- a/chickadee/render/framebuffer.scm
+++ b/chickadee/render/framebuffer.scm
@@ -38,9 +38,7 @@
             framebuffer-texture
             framebuffer-viewport
             framebuffer-projection
-            null-framebuffer
-            apply-framebuffer
-            *framebuffer-state*))
+            null-framebuffer))
 
 (define (generate-framebuffer)
   "Generate a new OpenGL framebuffer object."
@@ -85,9 +83,6 @@
   (gl-bind-framebuffer (version-3-0 framebuffer)
                        (framebuffer-id framebuffer)))
 
-(define *framebuffer-state*
-  (make-gpu-state apply-framebuffer null-framebuffer))
-
 (define make-framebuffer
   (let ((draw-buffers (u32vector (version-3-0 color-attachment0))))
     (lambda* (width height #:key (min-filter 'linear) (mag-filter 'linear)
@@ -114,7 +109,7 @@ dimensions WIDTH x HEIGHT."
                                              texture
                                              viewport
                                              projection)))
-        (gpu-state-set! *framebuffer-state* framebuffer)
+        (set-gpu-framebuffer! (current-gpu) framebuffer)
         ;; Setup depth buffer.
         (gl-bind-renderbuffer (version-3-0 renderbuffer)
                               renderbuffer-id)
diff --git a/chickadee/render/gpu.scm b/chickadee/render/gpu.scm
index dde8a69..1a09a6a 100644
--- a/chickadee/render/gpu.scm
+++ b/chickadee/render/gpu.scm
@@ -1,5 +1,5 @@
 ;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2019 David Thompson <davet@gnu.org>
 ;;;
 ;;; Chickadee is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published
@@ -24,7 +24,28 @@
 
             gpu-finalize
             gpu-guard
-            gpu-reap!))
+            gpu-reap!
+
+            make-gpu
+            current-gpu
+            gpu?
+            gpu-gl-context
+            gpu-blend-mode
+            gpu-depth-test
+            gpu-framebuffer
+            gpu-shader
+            gpu-texture
+            gpu-vertex-buffer
+            gpu-vertex-array
+            gpu-viewport
+            set-gpu-blend-mode!
+            set-gpu-depth-test!
+            set-gpu-framebuffer!
+            set-gpu-shader!
+            set-gpu-texture!
+            set-gpu-vertex-buffer!
+            set-gpu-vertex-array!
+            set-gpu-viewport!))
 
 
 ;;;
@@ -62,3 +83,90 @@ from the GPU's memory."
     (when obj
       (gpu-finalize obj)
       (loop (*gpu-guardian*)))))
+
+
+;;;
+;;; GPU
+;;;
+
+(define-record-type <gpu>
+  (%make-gpu gl-context
+             blend-mode
+             depth-test
+             framebuffer
+             shader
+             textures
+             vertex-buffer
+             vertex-array
+             viewport)
+  gpu?
+  (gl-context gpu-gl-context)
+  (blend-mode %gpu-blend-mode)
+  (depth-test %gpu-depth-test)
+  (framebuffer %gpu-framebuffer)
+  (shader %gpu-shader)
+  (textures gpu-textures)
+  (vertex-buffer %gpu-vertex-buffer)
+  (vertex-array %gpu-vertex-array)
+  (viewport %gpu-viewport))
+
+(define current-gpu (make-parameter #f))
+
+(define (make-gpu gl-context)
+  (let ((textures (make-vector 32))
+        (apply-texture (@@ (chickadee render texture) apply-texture)))
+    ;; Create state for 32 texture units.
+    (let loop ((i 0))
+      (when (< i 32)
+        (vector-set! textures i
+                     (make-gpu-state (lambda (texture)
+                                       (apply-texture i texture))
+                                     (@ (chickadee render texture) null-texture)))
+        (loop (+ i 1))))
+    (%make-gpu gl-context
+               ;; Use @ and @@ to avoid circular module dependencies.
+               (make-gpu-state (@@ (chickadee render blend) apply-blend-mode)
+                               'replace)
+               (make-gpu-state (@@ (chickadee render blend) apply-depth-test)
+                               #f)
+               (make-gpu-state (@@ (chickadee render framebuffer) apply-framebuffer)
+                               (@ (chickadee render framebuffer) null-framebuffer))
+               (make-gpu-state (@@ (chickadee render shader) apply-shader)
+                               (@ (chickadee render shader) null-shader))
+               textures
+               (make-gpu-state (@@ (chickadee render buffer) apply-buffer)
+                               (@ (chickadee render buffer) null-buffer))
+               (make-gpu-state (@@ (chickadee render buffer) apply-vertex-array)
+                               (@ (chickadee render buffer) null-vertex-array))
+               (make-gpu-state (@@ (chickadee render viewport) apply-viewport)
+                               (@ (chickadee render viewport) null-viewport)))))
+
+(define-syntax-rule (define-gpu-getter name ref)
+  (define (name gpu)
+    (gpu-state-ref (ref gpu))))
+
+(define-gpu-getter gpu-blend-mode %gpu-blend-mode)
+(define-gpu-getter gpu-depth-test %gpu-depth-test)
+(define-gpu-getter gpu-framebuffer %gpu-framebuffer)
+(define-gpu-getter gpu-shader %gpu-shader)
+(define-gpu-getter gpu-vertex-buffer %gpu-vertex-buffer)
+(define-gpu-getter gpu-vertex-array %gpu-vertex-array)
+(define-gpu-getter gpu-viewport %gpu-viewport)
+
+(define-syntax-rule (define-gpu-setter name ref)
+  (define (name gpu x)
+    (gpu-state-set! (ref gpu) x)))
+
+(define-gpu-setter set-gpu-blend-mode! %gpu-blend-mode)
+(define-gpu-setter set-gpu-depth-test! %gpu-depth-test)
+(define-gpu-setter set-gpu-framebuffer! %gpu-framebuffer)
+(define-gpu-setter set-gpu-shader! %gpu-shader)
+(define-gpu-setter set-gpu-vertex-buffer! %gpu-vertex-buffer)
+(define-gpu-setter set-gpu-vertex-array! %gpu-vertex-array)
+(define-gpu-setter set-gpu-viewport! %gpu-viewport)
+
+(define (gpu-texture gpu texture-unit)
+  (gpu-state-ref (vector-ref (gpu-textures gpu) texture-unit)))
+
+(define (set-gpu-texture! gpu texture-unit texture)
+  (gpu-state-set! (vector-ref (gpu-textures gpu) texture-unit) texture))
diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm
index 07e1ffd..5b807ab 100644
--- a/chickadee/render/shader.scm
+++ b/chickadee/render/shader.scm
@@ -68,8 +68,7 @@
             attribute?
             attribute-name
             attribute-location
-            attribute-type
-            *shader-state*))
+            attribute-type))
 
 
 ;;;
@@ -478,8 +477,6 @@
 (define (apply-shader shader)
   (gl-use-program (shader-id shader)))
 
-(define *shader-state* (make-gpu-state apply-shader null-shader))
-
 (define (make-shader vertex-port fragment-port)
   "Read GLSL source from VERTEX-PORT and FRAGMENT-PORT and compile
 them into a GPU shader program."
diff --git a/chickadee/render/texture.scm b/chickadee/render/texture.scm
index bdb5030..c376bd9 100644
--- a/chickadee/render/texture.scm
+++ b/chickadee/render/texture.scm
@@ -47,8 +47,6 @@
             texture-gl-rect
             texture-gl-tex-rect
             null-texture
-            texture-set!
-            texture-ref
 
             texture-atlas
             list->texture-atlas
@@ -115,28 +113,11 @@
 (define-method (gpu-finalize (texture <<texture>>))
   (free-texture texture))
 
-(define (make-apply-texture n)
+(define (apply-texture n texture)
   (let ((texture-unit (+ (version-1-3 texture0) n)))
-    (lambda (texture)
-      (set-gl-active-texture texture-unit)
-      (gl-bind-texture (texture-target texture-2d)
-                       (texture-id texture)))))
-
-(define *texture-states*
-  (let ((states (make-vector 32)))
-    (let loop ((i 0))
-      (if (< i 32)
-          (begin
-            (vector-set! states i (make-gpu-state (make-apply-texture i)
-                                                  null-texture))
-            (loop (1+ i)))
-          states))))
-
-(define (texture-ref! n)
-  (gpu-state-ref (vector-ref *texture-states* n)))
-
-(define (texture-set! n texture)
-  (gpu-state-set! (vector-ref *texture-states* n) texture))
+    (set-gl-active-texture texture-unit)
+    (gl-bind-texture (texture-target texture-2d)
+                     (texture-id texture))))
 
 (define* (make-texture pixels width height #:key
                        flip?
@@ -171,7 +152,7 @@ clamp-to-edge.  FORMAT specifies the pixel format.  Currently only
                                  (if flip?
                                      (make-rect 0.0 1.0 1.0 -1.0)
                                      (make-rect 0.0 0.0 1.0 1.0))))))
-    (texture-set! 0 texture)
+    (set-gpu-texture! (current-gpu) 0 texture)
     (gl-texture-parameter (texture-target texture-2d)
                           (texture-parameter-name texture-min-filter)
                           (match min-filter
diff --git a/chickadee/render/viewport.scm b/chickadee/render/viewport.scm
index 45c93d3..8005f80 100644
--- a/chickadee/render/viewport.scm
+++ b/chickadee/render/viewport.scm
@@ -39,9 +39,7 @@
             viewport-clear-flags
             null-viewport
             %default-clear-flags
-            %default-clear-color
-            apply-viewport
-            *viewport-state*))
+            %default-clear-color))
 
 (define-record-type <viewport>
   (%make-viewport x y width height clear-color clear-flags)
@@ -107,6 +105,3 @@ area, set the clear color, and clear necessary buffers."
       (gl-scissor x y w h)
       (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))
       (gl-clear (clear-buffer-mask (viewport-clear-flags viewport))))))
-
-(define *viewport-state*
-  (make-gpu-state apply-viewport null-viewport))