summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/shader.scm106
1 files changed, 55 insertions, 51 deletions
diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm
index 5af2c7e..94c6bfc 100644
--- a/chickadee/graphics/shader.scm
+++ b/chickadee/graphics/shader.scm
@@ -804,64 +804,68 @@ shader program."
(shader-scratch-pointer shader))
(%set-uniform-value! uniform value)))
+(define (shader-uniform-for-each* proc shader thing)
+ (cond
+ ((uniform? thing)
+ (proc thing))
+ ((uniform-namespace? thing)
+ (uniform-namespace-for-each
+ (lambda (key uniform)
+ (shader-uniform-for-each* proc shader uniform))
+ thing))
+ ((uniform-array? thing)
+ (for-range ((i (uniform-array-size thing)))
+ (shader-uniform-for-each* proc shader (uniform-array-namespace-ref thing i))))))
+
(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)
- (for-range ((i (uniform-array-size thing)))
- (traverse (uniform-array-namespace-ref thing i))))))
- (traverse (shader-uniforms shader)))
+ (shader-uniform-for-each* proc shader (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 value)
+ (cond
+ ;; A leaf node of the uniform tree representing a single uniform
+ ;; location as determined by OpenGL.
+ ((uniform? 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 value))))
+ (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)
+ (uniform-namespace-for-each
+ (lambda (key uniform)
+ ;; Samplers are opaque types and you cannot pass them
+ ;; into the shader as uniform values like you can with
+ ;; most other values. In the case of samplers, they are
+ ;; mapped to OpenGL's "texture units", so we need to
+ ;; ignore them here.
+ (unless (sampler? uniform)
+ (%shader-uniform-set shader uniform
+ (shader-struct-ref value key))))
+ uniform)
+ (error "expected shader struct" value)))
+ ;; A nested array namespace indicates that this must be an array
+ ;; of structs.
+ ((uniform-array? uniform)
+ (let ((size (uniform-array-size uniform)))
+ ;; Vector size must match what the shader expects.
+ (if (and (vector? value)
+ (= size (vector-length value)))
+ (for-range ((i size))
+ (%shader-uniform-set shader
+ (uniform-array-namespace-ref uniform i)
+ (vector-ref value i)))
+ (error "vector size mismatch for uniform"
+ (uniform-array-name uniform)))))))
+
(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)
- ;; 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)
- (uniform-namespace-for-each
- (lambda (key uniform)
- ;; Samplers are opaque types and you cannot pass them
- ;; into the shader as uniform values like you can with
- ;; most other values. In the case of samplers, they are
- ;; mapped to OpenGL's "texture units", so we need to
- ;; ignore them here.
- (unless (sampler? uniform)
- (traverse uniform (shader-struct-ref value key))))
- uniform)
- (error "expected shader struct" x)))
- ;; A nested array namespace indicates that this must be an array
- ;; of structs.
- ((uniform-array? uniform)
- (let ((size (uniform-array-size uniform)))
- ;; Vector size must match what the shader expects.
- (if (and (vector? value)
- (= size (vector-length value)))
- (for-range ((i size))
- (traverse (uniform-array-namespace-ref uniform i)
- (vector-ref value i)))
- (error "vector size mismatch for uniform"
- (uniform-array-name uniform)))))))
;; Walk the uniform namespace tree until we get to a leaf node or
;; nodes.
- (traverse (shader-uniform shader uniform-name) x))
+ (%shader-uniform-set shader (shader-uniform shader uniform-name) x))
(define-syntax uniform-apply
(lambda (x)