From 6413818c676d3e230284bce14078ab5fdda52994 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 27 Feb 2023 22:12:33 -0500
Subject: Add escape hatch for inserting Scheme values into Seagull code.

---
 chickadee/graphics/seagull.scm | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 6ff764e..567522f 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -3275,6 +3275,14 @@
                (reverse uniforms)
                `(begin ,@body))))))
 
+;; Allow importing Scheme values into Seagull expressions with special
+;; '$' syntax, such as numeric constants or user-defined shader types.
+(define-syntax seagull-quasiquote
+  (syntax-rules ($)
+    ((_ ($ x)) x)
+    ((_ (x ...)) (list (seagull-quasiquote x) ...))
+    ((_ x) (quote x))))
+
 ;; Using syntax-case allows us to compile shaders to their fully typed
 ;; intermediate form at compile time, leaving only GLSL emission for
 ;; runtime.
@@ -3284,7 +3292,9 @@
       ((_ name stage body ...)
        (let*-values (((inputs outputs uniforms body)
                       (partition-globals
-                       (syntax->datum #'(body ...)))))
+                       (syntax->datum
+                        (eval #'(seagull-quasiquote (body ...))
+                              (current-module))))))
          (define-values (compiled global-map max-id)
            (compile-seagull #:stage (syntax->datum #'stage)
                             #:inputs inputs
-- 
cgit v1.2.3