render: texture: Support using 32 texture units.

* chickadee/render/texture.scm (make-apply-texture, texture-ref,
texture-set!): New procedures.
(*texture-states*): New variable.
(apply-texture, *texture-state*): Delete.
(make-texture): Use 'vector-set!'
* chickadee/render/shader.scm: Export 'uniform-type'.
(default-uniform-value): Remove 'sampler-2d' case.
(extract-uniforms): Handle sampler-2d uniforms specially.
* chickadee/render.scm (current-texture): Add 'i' argument.
(with-texture): Add 'n' argument.
(gpu-apply*): Set textures for all texture units.
* .dir-locals.el: Update indentation rules for 'with-texture'.

5 files changed, 58 insertions, 24 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index 3cfdc35..540a9b0 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -2,7 +2,7 @@
   .
   ((eval . (put 'with-blend-mode 'scheme-indent-function 1))
    (eval . (put 'with-depth-test 'scheme-indent-function 1))
-   (eval . (put 'with-texture 'scheme-indent-function 1))
+   (eval . (put 'with-texture 'scheme-indent-function 2))
    (eval . (put 'with-shader 'scheme-indent-function 1))
    (eval . (put 'with-vertex-array 'scheme-indent-function 1))
    (eval . (put 'with-projection 'scheme-indent-function 1))
diff --git a/chickadee/render.scm b/chickadee/render.scm
index cf8a672..9edab51 100644
--- a/chickadee/render.scm
+++ b/chickadee/render.scm
@@ -50,8 +50,8 @@
 (define *current-framebuffer* null-framebuffer)
 (define *current-blend-mode* 'replace)
 (define *current-depth-test* #f)
-(define *current-texture* null-texture)
 (define *current-projection* (make-identity-matrix4))
+(define *current-textures* (make-vector 32 null-texture))
 
 (define (current-viewport)
   *current-viewport*)
@@ -65,8 +65,8 @@
 (define (current-depth-test)
   *current-depth-test*)
 
-(define (current-texture)
-  *current-texture*)
+(define (current-texture i)
+  (vector-ref *current-textures* i))
 
 (define (current-projection)
   *current-projection*)
@@ -95,8 +95,12 @@
 (define-syntax-rule (with-depth-test depth-test body ...)
   (with (*current-depth-test* depth-test) body ...))
 
-(define-syntax-rule (with-texture texture body ...)
-  (with (*current-texture* texture) body ...))
+(define-syntax-rule (with-texture n texture body ...)
+  (let ((prev (vector-ref *current-textures* n)))
+    (dynamic-wind
+      (lambda () (vector-set! *current-textures* n texture))
+      (lambda () body ...)
+      (lambda () (vector-set! *current-textures* n prev)))))
 
 (define-syntax-rule (with-shader shader body ...)
   (with (*current-shader* shader)
@@ -155,10 +159,17 @@
     (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! *texture-state* (current-texture))
     (gpu-state-set! *shader-state* shader)
     (gpu-state-set! *vertex-array-state* vertex-array)
+    (let loop ((i 0))
+      (when (< i 32)
+        (texture-set! i (current-texture i))
+        (loop (1+ i))))
     (uniform-apply shader uniforms)
+    (hash-for-each (lambda (name uniform)
+                     (when (eq? 'sampler-2d (uniform-type uniform))
+                       (set-uniform-value! uniform (uniform-value uniform))))
+                   (shader-uniforms shader))
     (render-vertices count)))
 
 (define-syntax-rule (gpu-apply shader vertex-array uniforms ...)
diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm
index ddf2098..b5f9b7d 100644
--- a/chickadee/render/shader.scm
+++ b/chickadee/render/shader.scm
@@ -42,6 +42,7 @@
             shader-uniforms
             uniform?
             uniform-name
+            uniform-type
             uniform-value
             uniform-default-value
             set-uniform-value!
@@ -199,7 +200,6 @@
     ;; ('int-vec2 (vector2 0 0))
     ;; ('int-vec3 (vector3 0 0 0))
     ;; ('int-vec4 (vector4 0 0 0 0))
-    ('sampler-2d 0)
     ('mat4 %default-mat4)))
 
 (define (uniform-setter-for-type type)
@@ -221,7 +221,8 @@
 (define (extract-uniforms id)
   (let ((total (uniform-count id))
         (table (make-hash-table)))
-    (let loop ((i 0))
+    (let loop ((i 0)
+               (texture-unit 0))
       (unless (= i total)
         (let ((length-bv (make-u32vector 1))
               (size-bv (make-u32vector 1))
@@ -238,17 +239,22 @@
                  (location (gl-get-uniform-location id name))
                  (size (u32vector-ref size-bv 0))
                  (type (gl-type->symbol (u32vector-ref type-bv 0)))
-                 (default (default-uniform-value type))
+                 (sampler? (eq? type 'sampler-2d))
+                 (default (if sampler?
+                              texture-unit
+                              (default-uniform-value type)))
                  (setter (uniform-setter-for-type type)))
             ;; TODO: Handle uniform arrays.
             (unless (= size 1)
               (error "unsupported uniform size" name size))
 
-            (unless (eq? type 'sampler-2d)
-              (hash-set! table
-                         name
-                         (make-uniform name location type default setter)))))
-        (loop (1+ i))))
+            (hash-set! table
+                       name
+                       (make-uniform name location type default setter))
+            (loop (1+ i)
+                  (if sampler?
+                      (1+ texture-unit)
+                      texture-unit))))))
     table))
 
 (define (attribute-count id)
diff --git a/chickadee/render/sprite.scm b/chickadee/render/sprite.scm
index 318a8a5..1ea4dda 100644
--- a/chickadee/render/sprite.scm
+++ b/chickadee/render/sprite.scm
@@ -114,7 +114,7 @@ void main (void) {
       (matrix4-mult! mvp mvp tmp-matrix)
       (matrix4-mult! mvp mvp (current-projection))
       (with-blend-mode blend-mode
-        (with-texture texture
+        (with-texture 0 texture
           (gpu-apply shader (force vertex-array) #:mvp mvp))))))
 
 
@@ -192,7 +192,7 @@ void main (void) {
   "Render the contents of BATCH and clear the cache."
   (unless (zero? (sprite-batch-size batch))
     (with-blend-mode (sprite-batch-blend-mode batch)
-      (with-texture (sprite-batch-texture batch)
+      (with-texture 0 (sprite-batch-texture batch)
         (unmap-vertex-buffer! (sprite-batch-index-buffer batch))
         (unmap-vertex-buffer! (sprite-batch-position-buffer batch))
         (unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
diff --git a/chickadee/render/texture.scm b/chickadee/render/texture.scm
index 20f58a6..65e2ba5 100644
--- a/chickadee/render/texture.scm
+++ b/chickadee/render/texture.scm
@@ -45,7 +45,8 @@
             texture-wrap-s
             texture-wrap-t
             null-texture
-            *texture-state*
+            texture-set!
+            texture-ref
 
             texture-atlas
             list->texture-atlas
@@ -96,12 +97,28 @@
 (define-method (gpu-finalize (texture <<texture>>))
   (free-texture texture))
 
-(define (apply-texture texture)
-  (gl-enable (enable-cap texture-2d))
-  (gl-bind-texture (texture-target texture-2d)
-                   (texture-id texture)))
+(define (make-apply-texture n)
+  (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-state* (make-gpu-state apply-texture null-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))
 
 (define* (make-texture pixels width height #:key
                        (min-filter 'linear)
@@ -127,7 +144,7 @@ clamp-to-edge.  FORMAT specifies the pixel format.  Currently only
   (let ((texture (gpu-guard
                   (%make-texture (gl-generate-texture) width height
                                  min-filter mag-filter wrap-s wrap-t))))
-    (gpu-state-set! *texture-state* texture)
+    (texture-set! 0 texture)
     (gl-texture-parameter (texture-target texture-2d)
                           (texture-parameter-name texture-min-filter)
                           (match min-filter