diff options
| -rw-r--r-- | sly/mesh.scm | 6 | ||||
| -rw-r--r-- | sly/shader.scm | 136 |
2 files changed, 88 insertions, 54 deletions
diff --git a/sly/mesh.scm b/sly/mesh.scm index cd8f680..1d7d89c 100644 --- a/sly/mesh.scm +++ b/sly/mesh.scm @@ -142,12 +142,8 @@ body ... (glBindVertexArray 0))) -(define (attribute-location shader-program name) - "Retrieve the location for the uniform NAME within SHADER-PROGRAM." - (glGetAttribLocation (shader-program-id shader-program) name)) - (define (vertex-attrib-pointer shader attribute vbo) - (let ((location (attribute-location shader attribute))) + (let ((location (shader-program-attribute-location shader attribute))) (glEnableVertexAttribArray location) (with-vertex-buffer vbo (glVertexAttribPointer location (vertex-buffer-attr-size vbo) diff --git a/sly/shader.scm b/sly/shader.scm index b3e8e39..f12e0bb 100644 --- a/sly/shader.scm +++ b/sly/shader.scm @@ -16,12 +16,13 @@ ;;; <http://www.gnu.org/licenses/>. (define-module (sly shader) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 match) #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-4) #:use-module (srfi srfi-9) - #:use-module (ice-9 rdelim) #:use-module (gl) #:use-module (gl low-level) #:use-module (sly helpers) @@ -44,6 +45,8 @@ shader-id make-shader-program load-shader-program + shader-program-uniform-location + shader-program-attribute-location shader-program-id shader-program? shader-program-linked? @@ -171,58 +174,103 @@ in the file FILENAME." (load-shader 'fragment filename)) ;;; -;;; Programs +;;; Shader Programs ;;; +(define-record-type <uniform> + (make-uniform name location) + uniform? + (name uniform-name) + (location uniform-location)) + +(define-record-type <attribute> + (make-attribute name location) + attribute? + (name attribute-name) + (location attribute-location)) + (define-record-type <shader-program> - (%make-shader-program id) + (%make-shader-program id uniforms attributes) shader-program? - (id shader-program-id)) + (id shader-program-id) + (uniforms shader-program-uniforms) + (attributes shader-program-attributes)) + +(define (shader-program-uniform-location shader-program uniform-name) + (let ((uniform (find (match-lambda + (($ <uniform> name _) + (string=? uniform-name name))) + (shader-program-uniforms shader-program)))) + (if uniform + (uniform-location uniform) + (error "Uniform not found: " uniform-name)))) + +(define (shader-program-attribute-location shader-program attribute-name) + (let ((attribute (find (match-lambda + (($ <attribute> name _) + (string=? attribute-name name))) + (shader-program-attributes shader-program)))) + (if attribute + (attribute-location attribute) + (error "Attribute not found: " attribute-name)))) (define-guardian shader-program-guardian (lambda (shader-program) (false-if-exception (glDeleteProgram (shader-program-id shader-program))))) -(define-status %shader-program-linked? glGetProgramiv link-status) - -(define (shader-program-linked? shader-program) - "Return #t if SHADER-PROGRAM has been successfully linked with -shaders or #f otherwise." - (%shader-program-linked? (shader-program-id shader-program))) - -(define-logger %display-linking-error glGetProgramiv glGetProgramInfoLog) +(define-status shader-program-linked? glGetProgramiv link-status) +(define-logger display-linking-error glGetProgramiv glGetProgramInfoLog) -(define (display-linking-error shader-program) - (%display-linking-error (shader-program-id shader-program))) - -(define (make-shader-program vertex-shader fragment-shader) +(define (make-shader-program vertex-shader fragment-shader uniforms attributes) "Create a new shader program that has been linked with the given VERTEX-SHADER and FRAGMENT-SHADER." (unless (and (vertex-shader? vertex-shader) (fragment-shader? fragment-shader)) (error "Expected a vertex shader and fragment shader" vertex-shader fragment-shader)) - (let* ((id (glCreateProgram)) - (shader-program (%make-shader-program id)) - (shaders (list vertex-shader fragment-shader))) - (shader-program-guardian shader-program) - (for-each (lambda (shader) - (glAttachShader id (shader-id shader))) - shaders) - (glLinkProgram id) - (unless (shader-program-linked? shader-program) - (display "Failed to link shader program:\n") - (display-linking-error shader-program)) - ;; Once the program has been linked, the shaders can be detached. - (for-each (lambda (shader) - (glDetachShader id (shader-id shader))) - shaders) - shader-program)) - -(define (load-shader-program vertex-shader-file-name fragment-shader-file-name) + (let ((id (glCreateProgram)) + (shaders (list vertex-shader fragment-shader))) + (define (string->uniform uniform-name) + (let ((location (glGetUniformLocation id uniform-name))) + (if (= location -1) + (error "Uniform not found: " uniform-name) + (make-uniform uniform-name location)))) + + (define (string->attribute attribute-name) + (let ((location (glGetAttribLocation id attribute-name))) + (if (= location -1) + (error "Attribute not found: " attribute-name) + (make-attribute attribute-name location)))) + + (catch #t + (lambda () + (for-each (lambda (shader) + (glAttachShader id (shader-id shader))) + shaders) + (glLinkProgram id) + (unless (shader-program-linked? id) + (display "Failed to link shader program:\n") + (display-linking-error id)) + ;; Once the program has been linked, the shaders can be detached. + (for-each (lambda (shader) + (glDetachShader id (shader-id shader))) + shaders) + (let* ((uniforms (map string->uniform uniforms)) + (attributes (map string->attribute attributes)) + (shader-program (%make-shader-program id uniforms attributes))) + (shader-program-guardian shader-program) + shader-program)) + throw + (lambda _ + ;; Make sure to delete program in case linking fails. + (glDeleteProgram id))))) + +(define (load-shader-program vertex-shader-file-name fragment-shader-file-name + uniforms attributes) (make-shader-program (load-vertex-shader vertex-shader-file-name) - (load-fragment-shader fragment-shader-file-name))) + (load-fragment-shader fragment-shader-file-name) + uniforms attributes)) (define current-shader-program (make-parameter #f)) @@ -242,7 +290,9 @@ VERTEX-SHADER and FRAGMENT-SHADER." (string-append %pkgdatadir "/shaders/default-vertex.glsl") (string-append %pkgdatadir - "/shaders/default-fragment.glsl"))))) + "/shaders/default-fragment.glsl") + '("mvp" "color") + '("position" "tex"))))) ;;; ;;; Uniforms @@ -303,18 +353,6 @@ location." (color-b c) (color-a c)))) -(define uniform-location - (memoize - (lambda (shader-program name) - "Retrieve the location for the uniform NAME within SHADER-PROGRAM." - (glGetUniformLocation (shader-program-id shader-program) name)))) - -(define attribute-location - (memoize - (lambda (shader-program name) - "Retrieve the location for the uniform NAME within SHADER-PROGRAM." - (glGetAttribLocation (shader-program-id shader-program) name)))) - (define (uniform-set! shader-program name value) "Use the appropriate setter procedure to translate VALUE into OpenGL compatible data and assign it to the location of the uniform NAME @@ -322,7 +360,7 @@ within SHADER-PROGRAM." (let ((setter (find (lambda (setter) ((uniform-setter-predicate setter) value)) %uniform-setters)) - (location (uniform-location shader-program name))) + (location (shader-program-uniform-location shader-program name))) (if setter ((uniform-setter-proc setter) location value) (error "Not a valid uniform data type" value)))) |