summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render/shader.scm99
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))