diff options
Diffstat (limited to 'chickadee/graphics')
| -rw-r--r-- | chickadee/graphics/seagull.scm | 24 |
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))))))) |