graphics: shader: Allow user-specified uniform name mapping.

1 files changed, 10 insertions, 6 deletions

diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm
index 73c8136..9cf4f89 100644
--- a/chickadee/graphics/shader.scm
+++ b/chickadee/graphics/shader.scm
@@ -520,7 +520,8 @@
   #:default null-shader
   #:bind bind-shader)
 
-(define (make-shader vertex-port fragment-port)
+(define* (make-shader vertex-port fragment-port #:key
+                      uniform-map)
   "Read GLSL source from VERTEX-PORT and FRAGMENT-PORT and compile
 them into a GPU shader program."
   (define (shader-compiled? id)
@@ -620,14 +621,17 @@ them into a GPU shader program."
                  (cons* #\- (char-downcase c) (loop (+ i 1)))
                  (cons c (loop (+ i 1)))))
            '()))))
-  (define (uniform-name->symbol name)
+  (define (extract-uniform-name str)
     ;; array uniform names have a suffix like "[0]" that needs to be
     ;; removed to produce the actual uniform variable name that our
     ;; shader interface will recognize.
-    (string->symbol
-     (let ((i (string-contains name "[")))
-       (camel->snake
-        (if i (substring name 0 i) name)))))
+    (let ((i (string-contains str "[")))
+      (if i (substring str 0 i) str)))
+  (define (uniform-name->symbol name)
+    (let ((name (extract-uniform-name name)))
+      (if uniform-map
+          (assq-ref uniform-map (string->symbol name))
+          (string->symbol (camel->snake name)))))
   (define (parse-array-index name)
     (let* ((start (string-contains name "["))
            (end (- (string-length name) 1)))