summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render.scm14
-rw-r--r--chickadee/render/shader.scm49
2 files changed, 44 insertions, 19 deletions
diff --git a/chickadee/render.scm b/chickadee/render.scm
index edf21f7..8b5ba6c 100644
--- a/chickadee/render.scm
+++ b/chickadee/render.scm
@@ -155,13 +155,13 @@
(loop (1+ i))))
(uniform-apply shader uniforms)
;; Sampler2D values aren't explicitly passed as uniform values via
- ;; gpu-apply, so we have to set their values correctly behind the
- ;; scenes.
- (uniform-namespace-for-each
- (lambda (name uniform)
- (when (and (uniform? uniform) (eq? 'sampler-2d (uniform-type uniform)))
- (shader-uniform-set! shader (uniform-name uniform) (uniform-value uniform))))
- (shader-uniforms shader))))
+ ;; gpu-apply, so we have to bind them to the proper texture units
+ ;; behind the scenes.
+ (shader-uniform-for-each
+ (lambda (uniform)
+ (when (eq? (uniform-type uniform) sampler-2d)
+ (set-uniform-value! shader uniform (uniform-value uniform))))
+ shader)))
(define-syntax-rule (gpu-apply* shader vertex-array count . uniforms)
(begin
diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm
index 050a81c..28b9b12 100644
--- a/chickadee/render/shader.scm
+++ b/chickadee/render/shader.scm
@@ -59,6 +59,8 @@
shader-uniforms
shader-attributes
shader-uniform-set!
+ shader-uniform-for-each
+ set-uniform-value!
uniform?
uniform-name
uniform-type
@@ -730,24 +732,47 @@ shader program."
(let ((uniform (uniform-namespace-ref (shader-uniforms shader) name)))
(or uniform (error "no such uniform" name))))
+(define (set-uniform-value! shader uniform value)
+ ;; TODO: Figure out a way to avoid unnecessary uniform
+ ;; updates. Maybe UBOs would help address this?
+ (let ((type (uniform-type uniform)))
+ (shader-primitive-type-serialize type (shader-scratch shader) value)
+ (shader-primitive-type-apply-uniform type (uniform-location uniform) 1
+ (shader-scratch-pointer shader))
+ (%set-uniform-value! uniform value)))
+
+(define (shader-uniform-for-each proc shader)
+ (define (traverse thing)
+ (cond
+ ((uniform? thing)
+ (proc thing))
+ ((uniform-namespace? thing)
+ (uniform-namespace-for-each
+ (lambda (key uniform)
+ (traverse uniform))
+ thing))
+ ((uniform-array? thing)
+ (let ((size (uniform-array-size thing)))
+ (let loop ((i 0))
+ (when (< i size)
+ (traverse (uniform-array-namespace-ref thing i))
+ (loop (+ i 1))))))))
+ (traverse (shader-uniforms shader)))
+
+;; TODO: This walks the entire tree every time, but it should instead
+;; stop traversing once it finds the correct leaf node.
(define (shader-uniform-set! shader uniform-name x)
(define (traverse uniform value)
(cond
;; A leaf node of the uniform tree representing a single uniform
;; location as determined by OpenGL.
((uniform? uniform)
- (let ((type (uniform-type uniform)))
- ;; A vector of a primitive type must be the exact size that
- ;; the shader expects.
- (when (and (> (uniform-size uniform) 1)
- (not (= (uniform-size uniform) (vector-length x))))
- (error "vector size mismatch for uniform" uniform-name))
- ;; TODO: Figure out a way to avoid unnecessary uniform
- ;; updates. Maybe UBOs would help address this?
- (shader-primitive-type-serialize type (shader-scratch shader) value)
- (shader-primitive-type-apply-uniform type (uniform-location uniform) 1
- (shader-scratch-pointer shader))
- (%set-uniform-value! uniform value)))
+ ;; A vector of a primitive type must be the exact size that
+ ;; the shader expects.
+ (when (and (> (uniform-size uniform) 1)
+ (not (= (uniform-size uniform) (vector-length x))))
+ (error "vector size mismatch for uniform" uniform-name))
+ (set-uniform-value! shader uniform value))
;; A nested namespace indicates that this must be a struct.
((uniform-namespace? uniform)
(if (shader-struct? value)