summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-02-09 20:50:05 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-06-08 08:14:41 -0400
commit2e22cadd802c861ffc38634be570010f7122a685 (patch)
tree94f0983abd72ea2f55de62f7ef836e48e1a14717
parent728a6737bb6664d08c52d090ee5b2f3b30eb85c2 (diff)
Add compile-shader.
-rw-r--r--chickadee/graphics/seagull.scm24
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)))))))