diff options
Diffstat (limited to 'chickadee/graphics/shader.scm')
| -rw-r--r-- | chickadee/graphics/shader.scm | 94 |
1 files changed, 43 insertions, 51 deletions
diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm index 94c6bfc..f1e930f 100644 --- a/chickadee/graphics/shader.scm +++ b/chickadee/graphics/shader.scm @@ -33,6 +33,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics texture) #:use-module (chickadee utils) #:export (shader-data-type? @@ -501,45 +502,33 @@ (location attribute-location) (type attribute-type)) -(define null-shader (%make-shader 0 (make-hash-table) (make-hash-table) #f #f)) - -(define (bind-shader shader) - (gl-use-program (shader-id shader))) - -(define (free-shader shader) - (gl-delete-program (shader-id shader))) - -(define-graphics-finalizer shader-finalizer - #:predicate shader? - #:free free-shader) - -(define-graphics-state g:shader - current-shader - #:default null-shader - #:bind bind-shader) +(define null-shader (%make-shader gpu-program:null (make-hash-table) (make-hash-table) #f #f)) (define (make-shader vertex-port fragment-port) "Read GLSL source from VERTEX-PORT and FRAGMENT-PORT and compile them into a GPU shader program." (define (shader-compiled? id) (let ((status (make-u32vector 1))) - (gl-get-shaderiv id (version-2-0 compile-status) + (gl-get-shaderiv (gpu-shader-id id) + (version-2-0 compile-status) (bytevector->pointer status)) (= (u32vector-ref status 0) 1))) (define (shader-linked? id) (let ((status (make-u32vector 1))) - (gl-get-programiv id (version-2-0 link-status) + (gl-get-programiv (gpu-program-id id) + (version-2-0 link-status) (bytevector->pointer status)) (= (u32vector-ref status 0) 1))) (define (info-log length-proc log-proc id) (let ((log-length-bv (make-u32vector 1))) - (length-proc id (version-2-0 info-log-length) + (length-proc (gpu-shader-id id) (version-2-0 info-log-length) (bytevector->pointer log-length-bv)) (u32vector-ref log-length-bv 0) ;; Add one byte to account for the null string terminator. (let* ((log-length (u32vector-ref log-length-bv 0)) (log (make-u8vector (1+ log-length)))) - (log-proc id log-length %null-pointer (bytevector->pointer log)) + (log-proc (gpu-shader-id id) log-length %null-pointer + (bytevector->pointer log)) (utf8->string log)))) (define (compilation-error id) (info-log gl-get-shaderiv gl-get-shader-info-log id)) @@ -549,7 +538,8 @@ them into a GPU shader program." ;; Set up preprocessor directives dynamically based on the current ;; OpenGL context's GLSL version so that we can write shaders that ;; are compatible with as many systems as possible. - (let ((glsl-version (graphics-engine-glsl-version))) + (let ((glsl-version (graphics-engine-glsl-version + (current-graphics-engine)))) (cond ((string>= glsl-version "3.3") "#version 330 @@ -566,27 +556,28 @@ them into a GPU shader program." (else (error "incompatible GLSL version" glsl-version))))) (define (make-shader-stage type port) - (let ((id (gl-create-shader type)) - (source (string->utf8 - (string-append (glsl-preprocessor-source) - (get-string-all port))))) - (gl-shader-source id 1 + (let* ((gpu (current-gpu)) + (id (fresh-gpu-shader gpu type)) + (source (string->utf8 + (string-append (glsl-preprocessor-source) + (get-string-all port))))) + (gl-shader-source (gpu-shader-id id) 1 (bytevector->pointer (u64vector (pointer-address (bytevector->pointer source)))) (bytevector->pointer (u32vector (bytevector-length source)))) - (gl-compile-shader id) + (gl-compile-shader (gpu-shader-id id)) (unless (shader-compiled? id) (let ((error-log (compilation-error id))) - (gl-delete-shader id) ; clean up GPU resource. + (free-gpu-shader id) ; clean up GPU resource. (display "shader compilation failed:\n") (display error-log (current-error-port)) (error "failed to compile shader"))) id)) (define (uniform-count id) (let ((bv (make-u32vector 1))) - (gl-get-programiv id + (gl-get-programiv (gpu-program-id id) (arb-shader-objects active-uniforms) (bytevector->pointer bv)) (u32vector-ref bv 0))) @@ -677,7 +668,8 @@ them into a GPU shader program." (size-bv (make-u32vector 1)) (type-bv (make-u32vector 1)) (name-bv (make-bytevector 255))) - (gl-get-active-uniform id i + (gl-get-active-uniform (gpu-program-id id) + i (bytevector-length name-bv) (bytevector->pointer length-bv) (bytevector->pointer size-bv) @@ -685,7 +677,7 @@ them into a GPU shader program." (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)) + (location (gl-get-uniform-location (gpu-program-id id) name)) (size (u32vector-ref size-bv 0)) (type (parse-data-type (u32vector-ref type-bv 0))) (sampler? (or (eq? type sampler-2d) (eq? type sampler-cube))) @@ -719,7 +711,7 @@ them into a GPU shader program." (values namespace scratch-size))))) (define (attribute-count id) (let ((bv (make-u32vector 1))) - (gl-get-programiv id + (gl-get-programiv (gpu-program-id id) (arb-shader-objects active-attributes) (bytevector->pointer bv)) (u32vector-ref bv 0))) @@ -731,7 +723,8 @@ them into a GPU shader program." (size-bv (make-u32vector 1)) (type-bv (make-u32vector 1)) (name-bv (make-bytevector 255))) - (gl-get-active-attrib id i + (gl-get-active-attrib (gpu-program-id id) + i (bytevector-length name-bv) (bytevector->pointer length-bv) (bytevector->pointer size-bv) @@ -741,26 +734,25 @@ them into a GPU shader program." (name (utf8->string* name-bv length)) (size (u32vector-ref size-bv 0)) (type (parse-data-type (u32vector-ref type-bv 0))) - (location (gl-get-attrib-location id name))) + (location (gl-get-attrib-location (gpu-program-id id) name))) (unless (= size 1) (error "unsupported attribute size" name size)) (hash-set! table name (make-attribute name location type))))) table)) (assert-current-graphics-engine) - (let ((vertex-id (make-shader-stage (version-2-0 vertex-shader) - vertex-port)) - (fragment-id (make-shader-stage (version-2-0 fragment-shader) - fragment-port)) - (id (gl-create-program))) - (gl-attach-shader id vertex-id) - (gl-attach-shader id fragment-id) - (gl-link-program id) + (let* ((gpu (current-gpu)) + (vertex-id (make-shader-stage 'vertex vertex-port)) + (fragment-id (make-shader-stage 'fragment fragment-port)) + (id (fresh-gpu-program gpu))) + (gl-attach-shader (gpu-program-id id) (gpu-shader-id vertex-id)) + (gl-attach-shader (gpu-program-id id) (gpu-shader-id fragment-id)) + (gl-link-program (gpu-program-id id)) (unless (shader-linked? id) (let ((error-log (linking-error id))) - (gl-delete-program id) + (free-gpu-program id) (error "failed to link shader" error-log))) - (gl-delete-shader vertex-id) - (gl-delete-shader fragment-id) + (free-gpu-shader vertex-id) + (free-gpu-shader fragment-id) (call-with-values (lambda () (extract-uniforms id)) (lambda (namespace scratch-size) @@ -768,7 +760,6 @@ them into a GPU shader program." (scratch-ptr (bytevector->pointer scratch)) (shader (%make-shader id (extract-attributes id) namespace scratch scratch-ptr))) - (graphics-engine-guard! shader) shader))))) (define (load-shader vertex-source-file fragment-source-file) @@ -878,9 +869,10 @@ shader program." (shader-uniform-set! shader 'sname value) (uniform-apply shader rest))))))) -(define-syntax-rule (shader-apply** shader* vertex-array uniforms exp) - (with-graphics-state! ((g:shader shader*)) - (uniform-apply shader* uniforms) +(define-syntax-rule (shader-apply** shader vertex-array uniforms exp) + (with-graphics-state ((program (shader-id shader))) + (graphics-engine-commit! (current-graphics-engine)) + (uniform-apply shader uniforms) ;; Sampler2D values aren't explicitly passed as uniform values via ;; shader-apply, so we have to bind them to the proper texture units ;; behind the scenes. @@ -888,8 +880,8 @@ shader program." (lambda (uniform) (when (or (eq? (uniform-type uniform) sampler-2d) (eq? (uniform-type uniform) sampler-cube)) - (set-uniform-value! shader* uniform (uniform-value uniform)))) - shader*) + (set-uniform-value! shader uniform (uniform-value uniform)))) + shader) exp)) (define-syntax-rule (shader-apply* shader vertex-array offset count . uniforms) |