diff options
| -rw-r--r-- | chickadee/graphics/shader.scm | 106 |
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) |