diff options
| -rw-r--r-- | chickadee/render/shader.scm | 99 |
1 files changed, 52 insertions, 47 deletions
diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm index 6eeb76d..02f0e12 100644 --- a/chickadee/render/shader.scm +++ b/chickadee/render/shader.scm @@ -202,11 +202,12 @@ (scratch-pointer shader-scratch-pointer)) (define-record-type <uniform> - (make-uniform name location type value) + (make-uniform name location type size value) uniform? (name uniform-name) (location uniform-location) (type uniform-type) + (size uniform-size) (value uniform-value %set-uniform-value!)) (define-record-type <attribute> @@ -293,42 +294,49 @@ them into a GPU shader program." ((= type (version-2-0 sampler-2d)) %sampler-2d) (else (error "unsupported OpenGL type" type)))) + (define (parse-name name) + ;; Primitive array uniform names have a suffix of "[0]" that needs + ;; to be removed to produce the actual uniform variable name. + (if (string-suffix? "[0]" name) + (substring name 0 (- (string-length name) 3)) + name)) (define (extract-uniforms id) (let ((total (uniform-count id)) (table (make-hash-table))) (let loop ((i 0) - (texture-unit 0)) - (unless (= i total) - (let ((length-bv (make-u32vector 1)) - (size-bv (make-u32vector 1)) - (type-bv (make-u32vector 1)) - (name-bv (make-bytevector 255))) - (gl-get-active-uniform id i - (bytevector-length name-bv) - (bytevector->pointer length-bv) - (bytevector->pointer size-bv) - (bytevector->pointer type-bv) - (bytevector->pointer name-bv)) - (let* ((name-length (u32vector-ref length-bv 0)) - (name (utf8->string* name-bv name-length)) - (location (gl-get-uniform-location id name)) - (size (u32vector-ref size-bv 0)) - (type (parse-data-type (u32vector-ref type-bv 0))) - (sampler? (eq? type %sampler-2d)) - (default (if sampler? - texture-unit - (shader-data-type-null type)))) - ;; TODO: Handle uniform arrays. - (unless (= size 1) - (error "unsupported uniform size" name size)) - (hash-set! table - name - (make-uniform name location type default)) - (loop (1+ i) - (if sampler? - (1+ texture-unit) - texture-unit)))))) - table)) + (texture-unit 0) + (scratch-size 0)) + (if (< i total) + (let ((length-bv (make-u32vector 1)) + (size-bv (make-u32vector 1)) + (type-bv (make-u32vector 1)) + (name-bv (make-bytevector 255))) + (gl-get-active-uniform id i + (bytevector-length name-bv) + (bytevector->pointer length-bv) + (bytevector->pointer size-bv) + (bytevector->pointer type-bv) + (bytevector->pointer name-bv)) + (let* ((name-length (u32vector-ref length-bv 0)) + (name (utf8->string* name-bv name-length)) + (location (gl-get-uniform-location id name)) + (size (u32vector-ref size-bv 0)) + (type (parse-data-type (u32vector-ref type-bv 0))) + (sampler? (eq? type %sampler-2d)) + (default (if sampler? + texture-unit + (shader-data-type-null type)))) + (hash-set! table + (parse-name name) + (make-uniform name location type size default)) + (loop (1+ i) + (if sampler? + (1+ texture-unit) + texture-unit) + (max scratch-size + (* size + (shader-data-type-size type)))))) + (values table scratch-size))))) (define (attribute-count id) (let ((bv (make-u32vector 1))) (gl-get-programiv id @@ -357,7 +365,6 @@ them into a GPU shader program." (location (gl-get-attrib-location id name))) (unless (= size 1) (error "unsupported attribute size" name size)) - (hash-set! table name (make-attribute name location type)))) (loop (1+ i)))) table)) @@ -365,12 +372,7 @@ them into a GPU shader program." vertex-port)) (fragment-id (make-shader-stage (version-2-0 fragment-shader) fragment-port)) - (id (gl-create-program)) - ;; For now, make the scratch space the size of the largest - ;; primitive data type: mat4. The size of this space will - ;; need to be dynamically determined when support for arrays - ;; and user-defined structs is added. - (scratch (make-bytevector 64))) + (id (gl-create-program))) (gl-attach-shader id vertex-id) (gl-attach-shader id fragment-id) (gl-link-program id) @@ -380,9 +382,13 @@ them into a GPU shader program." (error "failed to link shader" error-log))) (gl-delete-shader vertex-id) (gl-delete-shader fragment-id) - (gpu-guard - (%make-shader id (extract-attributes id) (extract-uniforms id) - scratch (bytevector->pointer scratch))))) + (call-with-values + (lambda () (extract-uniforms id)) + (lambda (uniforms scratch-size) + (let ((scratch (make-bytevector scratch-size))) + (gpu-guard + (%make-shader id (extract-attributes id) uniforms + scratch (bytevector->pointer scratch)))))))) (define (load-shader vertex-source-file fragment-source-file) "Compile the GLSL source code within VERTEX-SOURCE-FILE and @@ -409,12 +415,11 @@ shader program." (or uniform (error "no such uniform" name)))) (define (shader-uniform-set! shader uniform-name x) - "Change the value of UNIFORM to X. This procedure assumes that the -shader where UNIFORM is defined is currently bound in the OpenGL -context. The behavior of this procedure under any other circumstance -is undefined." (let* ((uniform (shader-uniform shader uniform-name)) (type (uniform-type uniform))) + (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. (shader-data-type-serialize type (shader-scratch shader) x) (shader-data-type-apply-uniform type (uniform-location uniform) 1 (shader-scratch-pointer shader)) |