Add compile-shader.

1 files changed, 17 insertions, 7 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 8f1a474..8ddb315 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -39,6 +39,7 @@
 ;;
 ;;; Code:
 (define-module (chickadee graphics seagull)
+  #:use-module (chickadee graphics shader)
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -46,6 +47,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:export (compile-seagull-module
+            compile-shader
+            link-seagull-modules
             define-vertex-shader
             define-fragment-shader
             seagull-module?
@@ -57,8 +60,7 @@
             seagull-module-uniforms
             seagull-module-source
             seagull-module-compiled
-            seagull-module-global-map
-            link-seagull-modules))
+            seagull-module-global-map))
 
 ;; The Seagull compiler is designed as a series of source-to-source
 ;; program transformations in which each transformation pass results
@@ -67,8 +69,6 @@
 
 ;; TODO:
 ;; - Loops
-;; - Shader stage linking
-;; - Input/uniform mapping for invoking shaders from Scheme
 ;; - Scheme shader type -> GLSL struct translation
 
 
@@ -2637,7 +2637,7 @@
          (('uniform type-desc name)
           (loop rest inputs outputs (cons spec uniforms))))))))
 
-(define-syntax-rule (define-shader name stage ((qualifier type var) ...) source)
+(define-syntax-rule (define-shader-stage name stage ((qualifier type var) ...) source)
   (define name
     (let ((top-level-defs (group-by-qualifier
                            (list (list 'qualifier 'type 'var) ...))))
@@ -2648,10 +2648,10 @@
                               #:uniforms (assq-ref top-level-defs 'uniforms)))))
 
 (define-syntax-rule (define-vertex-shader name specs source)
-  (define-shader name vertex specs source))
+  (define-shader-stage name vertex specs source))
 
 (define-syntax-rule (define-fragment-shader name specs source)
-  (define-shader name fragment specs source))
+  (define-shader-stage name fragment specs source))
 
 (define (vertex-outputs-match-fragment-inputs? vertex fragment)
   (let ((fragment-inputs (seagull-module-inputs fragment)))
@@ -2799,3 +2799,13 @@
     (display fragment-glsl)
     (newline)
     (values vertex-glsl fragment-glsl uniform-map)))
+
+(define (compile-shader vertex fragment)
+  (let-values (((glsl:vertex glsl:fragment uniform-map)
+                (link-seagull-modules vertex fragment)))
+    (call-with-input-string glsl:vertex
+      (lambda (vertex-port)
+        (call-with-input-string glsl:fragment
+          (lambda (fragment-port)
+            (make-shader vertex-port fragment-port
+                         #:uniform-map uniform-map)))))))