diff options
| -rw-r--r-- | chickadee/render/shader.scm | 100 |
1 files changed, 50 insertions, 50 deletions
diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm index 0b0e631..1f97a0d 100644 --- a/chickadee/render/shader.scm +++ b/chickadee/render/shader.scm @@ -71,45 +71,45 @@ ;;; -;;; Data Types +;;; Primitive Shader Data Types ;;; -(define-record-type <shader-data-type> - (%make-shader-data-type name size validator serializer setter null) - shader-data-type? - (name shader-data-type-name) - (size shader-data-type-size) - (validator shader-data-type-validator) - (serializer shader-data-type-serializer) - (setter shader-data-type-setter) - (null shader-data-type-null)) - -(define (display-shader-data-type type port) - (format port "#<shader-data-type name: ~a size: ~d null: ~a>" - (shader-data-type-name type) - (shader-data-type-size type) - (shader-data-type-null type))) - -(set-record-type-printer! <shader-data-type> display-shader-data-type) - -(define* (make-shader-data-type #:key name size validator serializer setter null) - (%make-shader-data-type name size validator serializer setter null)) - -(define (shader-data-type-serialize type bv data) - (let ((serialize (shader-data-type-serializer type))) +(define-record-type <shader-primitive-type> + (%make-shader-primitive-type name size validator serializer setter null) + shader-primitive-type? + (name shader-primitive-type-name) + (size shader-primitive-type-size) + (validator shader-primitive-type-validator) + (serializer shader-primitive-type-serializer) + (setter shader-primitive-type-setter) + (null shader-primitive-type-null)) + +(define (display-shader-primitive-type type port) + (format port "#<shader-primitive-type name: ~a size: ~d null: ~a>" + (shader-primitive-type-name type) + (shader-primitive-type-size type) + (shader-primitive-type-null type))) + +(set-record-type-printer! <shader-primitive-type> display-shader-primitive-type) + +(define* (make-shader-primitive-type #:key name size validator serializer setter null) + (%make-shader-primitive-type name size validator serializer setter null)) + +(define (shader-primitive-type-serialize type bv data) + (let ((serialize (shader-primitive-type-serializer type))) (if (vector? data) - (let ((size (shader-data-type-size type))) + (let ((size (shader-primitive-type-size type))) (let loop ((i 0)) (when (< i (vector-length data)) (serialize bv (* i size) (vector-ref data i)) (loop (+ i 1))))) (serialize bv 0 data)))) -(define (shader-data-type-apply-uniform type location count pointer) - ((shader-data-type-setter type) location count pointer)) +(define (shader-primitive-type-apply-uniform type location count pointer) + ((shader-primitive-type-setter type) location count pointer)) -(define (shader-data-type-validate type data) - (let ((valid? (shader-data-type-validator type))) +(define (shader-primitive-type-validate type data) + (let ((valid? (shader-primitive-type-validator type))) (if (vector? data) (let loop ((i 0)) (if (and (< i (vector-length data)) @@ -118,11 +118,11 @@ #t)) (valid? data)))) -(define-syntax-rule (define-shader-data-type var . args) - (define var (make-shader-data-type . args))) +(define-syntax-rule (define-shader-primitive-type var . args) + (define var (make-shader-primitive-type . args))) ;; Primitive types: -(define-shader-data-type bool +(define-shader-primitive-type bool #:name 'bool #:size 4 #:validator boolean? @@ -132,7 +132,7 @@ #:setter gl-uniform1iv #:null #false) -(define-shader-data-type int +(define-shader-primitive-type int #:name 'int #:size 4 #:validator integer? @@ -142,7 +142,7 @@ #:setter gl-uniform1iv #:null 0) -(define-shader-data-type unsigned-int +(define-shader-primitive-type unsigned-int #:name 'unsigned-int #:size 4 #:validator @@ -154,7 +154,7 @@ #:setter gl-uniform1uiv #:null 0) -(define-shader-data-type float +(define-shader-primitive-type float #:name 'float #:size 4 #:validator number? @@ -164,7 +164,7 @@ #:setter gl-uniform1fv #:null 0.0) -(define-shader-data-type float-vec2 +(define-shader-primitive-type float-vec2 #:name 'float-vec2 #:size 8 ; 8 bytes = 2 floats = 1 vec2 #:validator vec2? @@ -175,7 +175,7 @@ #:setter gl-uniform2fv #:null (vec2 0.0 0.0)) -(define-shader-data-type float-vec3 +(define-shader-primitive-type float-vec3 #:name 'float-vec3 #:size 12 ; 12 bytes = 3 floats = 1 vec3 #:validator vec3? @@ -186,7 +186,7 @@ #:setter gl-uniform3fv #:null (vec3 0.0 0.0 0.0)) -(define-shader-data-type float-vec4 +(define-shader-primitive-type float-vec4 #:name 'float-vec4 #:size 16 ; 16 bytes = 4 floats = 1 vec4 #:validator color? @@ -202,7 +202,7 @@ #:setter gl-uniform4fv #:null (color 0.0 0.0 0.0 0.0)) -(define-shader-data-type mat4 +(define-shader-primitive-type mat4 #:name 'mat4 #:size 64 ; 4 rows x 4 columns = 16 floats x 4 bytes each = 64 bytes #:validator matrix4? @@ -215,7 +215,7 @@ (gl-uniform-matrix4fv location count #f ptr)) #:null (make-identity-matrix4)) -(define-shader-data-type sampler-2d +(define-shader-primitive-type sampler-2d #:name 'sampler-2d #:size 4 #:validator integer? @@ -227,7 +227,7 @@ ;;; -;;; Shader Structs +;;; Compound Shader Data Types ;;; ;; A meta-vtable that has two additional slots: one for the struct @@ -258,7 +258,7 @@ ((_ type size) (define (validate value) (unless (or (and (struct? value) (eq? (struct-vtable value) type)) - (shader-data-type-validate type value)) + (shader-primitive-type-validate type value)) (error "invalid type for shader struct field" field value))) (cond ((eq? type local-field) @@ -285,7 +285,7 @@ ((sub-field _ _ _) (shader-struct-default type sub-field))) (shader-struct-fields type))) - (shader-data-type-null type)))) + (shader-primitive-type-null type)))) (if (= size 1) default (make-vector size default)))))) @@ -314,7 +314,7 @@ name size (if (eq? type local-field) 'local - (shader-data-type-name type)) + (shader-primitive-type-name type)) (struct-ref obj index)) (loop rest)))) (display ">" port))) @@ -625,9 +625,9 @@ them into a GPU shader program." (sampler? texture-unit) ((= size 1) - (shader-data-type-null type)) + (shader-primitive-type-null type)) (else - (make-vector size (shader-data-type-null type))))) + (make-vector size (shader-primitive-type-null type))))) (uniform (make-uniform name location type size default))) (if (struct? name) ;; The complicated path: Parse struct name and @@ -647,7 +647,7 @@ them into a GPU shader program." ;; largest bit of data we send to the shader. (max scratch-size (* size - (shader-data-type-size type)))))) + (shader-primitive-type-size type)))))) (values namespace scratch-size))))) (define (attribute-count id) (let ((bv (make-u32vector 1))) @@ -740,9 +740,9 @@ shader program." (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-data-type-serialize type (shader-scratch shader) value) - (shader-data-type-apply-uniform type (uniform-location uniform) 1 - (shader-scratch-pointer shader)) + (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 nested namespace indicates that this must be a struct. ((uniform-namespace? uniform) |