diff options
Diffstat (limited to 'sly/render/shader.scm')
| -rw-r--r-- | sly/render/shader.scm | 79 |
1 files changed, 38 insertions, 41 deletions
diff --git a/sly/render/shader.scm b/sly/render/shader.scm index 392ebc5..cb3828d 100644 --- a/sly/render/shader.scm +++ b/sly/render/shader.scm @@ -44,13 +44,14 @@ shader-type shader-id make-shader-program + shader-program? load-shader-program vertex-position-location vertex-texture-location shader-program-uniform-location shader-program-attribute-location shader-program-id - shader-program? + shader-program-uniforms shader-program-linked? null-shader-program apply-shader-program @@ -58,6 +59,10 @@ load-default-shader %uniform-setters register-uniform-setter! + uniform? + uniform-name + uniform-gl-name + uniform-default uniform-set! uniforms)) @@ -182,10 +187,12 @@ in the file FILENAME." ;;; (define-record-type <uniform> - (make-uniform name location) + (make-uniform name gl-name location default) uniform? (name uniform-name) - (location uniform-location)) + (gl-name uniform-gl-name) + (location uniform-location) + (default uniform-default)) (define-record-type <attribute> (make-attribute name location) @@ -203,14 +210,13 @@ in the file FILENAME." (define vertex-position-location 0) (define vertex-texture-location 1) -(define (shader-program-uniform-location shader-program uniform-name) - (let ((uniform (find (match-lambda - (($ <uniform> name _) - (string=? uniform-name name))) +(define (shader-program-uniform-location shader-program name) + (let ((uniform (find (lambda (uniform) + (eq? (uniform-name uniform) name)) (shader-program-uniforms shader-program)))) (if uniform (uniform-location uniform) - (error "Uniform not found: " uniform-name)))) + (error "Uniform not found: " name)))) (define (shader-program-attribute-location shader-program attribute-name) (let ((attribute (find (match-lambda @@ -238,11 +244,13 @@ VERTEX-SHADER and FRAGMENT-SHADER." vertex-shader fragment-shader)) (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 build-uniform + (match-lambda + ((name gl-name default) + (let ((location (glGetUniformLocation id gl-name))) + (if (= location -1) + (error "Uniform not found: " gl-name) + (make-uniform name gl-name location default)))))) (define (string->attribute attribute-name) (let ((location (glGetAttribLocation id attribute-name))) @@ -266,7 +274,7 @@ VERTEX-SHADER and FRAGMENT-SHADER." (for-each (lambda (shader) (glDetachShader id (shader-id shader))) shaders) - (let* ((uniforms (map string->uniform uniforms)) + (let* ((uniforms (map build-uniform uniforms)) (attributes (map string->attribute attributes)) (shader-program (%make-shader-program id uniforms attributes))) (shader-program-guardian shader-program) @@ -297,17 +305,6 @@ VERTEX-SHADER and FRAGMENT-SHADER." (glUseProgram 0) return-value)))) -(define load-default-shader - (memoize - (lambda () - (load-shader-program - (string-append %pkgdatadir - "/shaders/default-vertex.glsl") - (string-append %pkgdatadir - "/shaders/default-fragment.glsl") - '("mvp" "color" "use_texture") - '("position" "tex"))))) - ;;; ;;; Uniforms ;;; @@ -377,19 +374,19 @@ within SHADER-PROGRAM." ((uniform-setter-proc setter) location value) (error "Not a valid uniform data type" value)))) -;; Bind values to uniform variables within the current shader program -;; via a let-style syntax. The types of the given values must be -;; accounted for in the %uniform-setters list. This macro simply sets -;; uniform values and does not restore the previous values after -;; evaluating the body of the form. -;; -;; emacs: (put 'uniforms 'scheme-indent-function 1) -(define-syntax uniforms - (syntax-rules () - ((_ () body ...) - (begin body ...)) - ((_ ((name value) ...) body ...) - (begin - (uniform-set! (current-shader-program) 'name value) - ... - body ...)))) +;;; +;;; Built-in Shaders +;;; + +(define load-default-shader + (memoize + (lambda () + (load-shader-program + (string-append %pkgdatadir + "/shaders/default-vertex.glsl") + (string-append %pkgdatadir + "/shaders/default-fragment.glsl") + `((mvp "mvp" ,identity-transform) + (color "color" ,white) + (texture? "use_texture" #f)) + '("position" "tex"))))) |